home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD2.bin / bbs / dev / oberon-a-1.4ß.lha / Oberon-A / source / FPE / StringDialog.mod < prev    next >
Text File  |  1994-08-08  |  9KB  |  337 lines
  1. (***************************************************************************
  2.  
  3.      $RCSfile: StringDialog.mod $
  4.   Description: Defines and implements a simple string dialog.
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 1.7 $
  8.       $Author: fjc $
  9.         $Date: 1994/08/08 16:13:41 $
  10.  
  11.   Copyright © 1994, Frank Copeland.
  12.   This file is part of the Oberon-A Library.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.  
  15.   Log entries are at the end of the file.
  16.  
  17. ***************************************************************************)
  18.  
  19. MODULE StringDialog;
  20.  
  21. (*
  22. ** $C= CaseChk       $I= IndexChk  $L+ LongAdr   $N- NilChk
  23. ** $P= PortableCode  $R= RangeChk  $S= StackChk  $T= TypeChk
  24. ** $V= OvflChk       $Z= ZeroVars
  25. **
  26. ** Compiler NIL checking is replaced by ASSERTs at the appropriate places.
  27. *)
  28.  
  29. IMPORT
  30.   E := Exec, G := Graphics, I := Intuition, IU := IntuiUtil, Events,
  31.   ISup := IntuiSup, ISE := ISupEvents, U := Util, SYS := SYSTEM;
  32.  
  33. CONST
  34.  
  35.   NumGadgets = 3;
  36.   NumTexts   = 1;
  37.  
  38. TYPE
  39.  
  40.   StrDlg * = POINTER TO StrDlgRec;
  41.   StrDlgRec = RECORD (ISE.ISupDialogRec)
  42.     g0         : ISup.InputData;
  43.     g1         : ISup.ButtonData;
  44.     g2         : ISup.ButtonData;
  45.     gDataEnd   : LONGINT;
  46.     t0         : ISup.TextData;
  47.     tDataEnd   : INTEGER;
  48.     textBuffer : ARRAY 256 OF CHAR;
  49.     result     : BOOLEAN;
  50.   END; (* StrDlgRec *)
  51.  
  52.   StrDlgPort = POINTER TO StrDlgPortRec;
  53.   StrDlgPortRec = RECORD (ISE.ISupPortRec)
  54.     strDlg : StrDlg;
  55.   END;
  56.  
  57. CONST
  58.  
  59.   AcceptText = "_Accept";
  60.   CancelText = "_Cancel";
  61.  
  62.   StringGadgetID = 0;
  63.   AcceptButtonID = 1;
  64.   CancelButtonID = 2;
  65.  
  66. (* ----- Support procedures ----- *)
  67.  
  68.  
  69. (*------------------------------------*)
  70. (* $D- disable copying of open arrays *)
  71. PROCEDURE CalcTextBox
  72.   ( renderInfo : ISup.RenderInfoPtr;
  73.     text       : ARRAY OF CHAR;
  74.     font       : G.TextAttrPtr;
  75.     VAR width, height : INTEGER );
  76.  
  77. BEGIN (* CalcTextBox *)
  78.   IF font = NIL THEN font := SYS.ADR(renderInfo.textAttr) END;
  79.   IU.CalcTextBox (text, font, width, height);
  80. END CalcTextBox;
  81.  
  82.  
  83. (*------------------------------------*)
  84. (* $D- disable copying of open arrays *)
  85. PROCEDURE CalcTextButtonBox
  86.   ( renderInfo    : ISup.RenderInfoPtr;
  87.     text          : ARRAY OF CHAR;
  88.     font          : G.TextAttrPtr;
  89.   VAR width, height : INTEGER );
  90.  
  91.   CONST
  92.     extraWidth  = 10;
  93.     extraHeight =  6;
  94.   VAR
  95.     tempWidth, tempHeight : INTEGER;
  96.  
  97. BEGIN (* CalcTextButtonBox *)
  98.   CalcTextBox (renderInfo, text, font, tempWidth, tempHeight);
  99.   INC (tempWidth, extraWidth);
  100.   INC (tempHeight, extraHeight);
  101.   IF tempWidth > width THEN
  102.     width := tempWidth;
  103.   END;
  104.   IF tempHeight > height THEN
  105.     height := tempHeight;
  106.   END
  107. END CalcTextButtonBox;
  108.  
  109.  
  110. (*------------------------------------*)
  111. PROCEDURE CalcInputGadgetBox
  112.   ( renderInfo        : ISup.RenderInfoPtr;
  113.     visibleChars      : INTEGER;
  114.     VAR width, height : INTEGER );
  115.  
  116.   CONST
  117.     extraWidth  = 12;
  118.     extraHeight = 6;
  119.   VAR
  120.     tempWidth, tempHeight : INTEGER;
  121.  
  122. BEGIN (* CalcInputGadgetBox *)
  123.   CalcTextBox (renderInfo, "0", NIL, tempWidth, tempHeight);
  124.   tempWidth := tempWidth * visibleChars;
  125.   INC (tempWidth, extraWidth);
  126.   INC (tempHeight, extraHeight);
  127.   IF tempWidth > width THEN
  128.     width := tempWidth;
  129.   END;
  130.   IF tempHeight > height THEN
  131.     height := tempHeight;
  132.   END
  133. END CalcInputGadgetBox;
  134.  
  135.  
  136. (*------------------------------------*)
  137. PROCEDURE (sdp : StrDlgPort) HandleISup
  138.   (msg : I.IntuiMessagePtr) : INTEGER;
  139.  
  140.   VAR result : INTEGER; str : E.STRPTR;
  141.  
  142. BEGIN (* HandleISup *)
  143.   CASE msg.code OF
  144.     StringGadgetID :
  145.       str := msg.iAddress;
  146.       COPY (str^, sdp.strDlg.textBuffer);
  147.       result := Events.Continue
  148.     |
  149.     AcceptButtonID :
  150.       sdp.strDlg.result := (sdp.strDlg.textBuffer # "");
  151.       result := Events.Stop
  152.     |
  153.     CancelButtonID :
  154.       sdp.strDlg.result := FALSE;
  155.       result := Events.Stop
  156.     |
  157.   END;
  158.   ISup.base.ReplyMsg (msg);
  159.   RETURN result;
  160. END HandleISup;
  161.  
  162.  
  163. (*------------------------------------------------------------------------*)
  164. (* Exported procedures *)
  165.  
  166. (*------------------------------------*)
  167. PROCEDURE InitStrDlg *
  168.   ( dialog        : StrDlg;
  169.     renderInfo    : ISup.RenderInfoPtr;
  170.     title, prompt : ARRAY OF CHAR;
  171.     visibleChars,
  172.     maxChars      : INTEGER );
  173.  
  174.   CONST
  175.     HSpace = 8; VSpace = 4;
  176.  
  177.   VAR
  178.     textWidth, textHeight, stringWidth, stringHeight, buttonWidth,
  179.     buttonHeight, dialogWidth, dialogHeight
  180.       : INTEGER;
  181.     sdp : StrDlgPort;
  182.  
  183.   (*------------------------------------*)
  184.   PROCEDURE CalcStrDlg ();
  185.  
  186.   BEGIN (* CalcStrDlg *)
  187.     CalcTextBox (renderInfo, prompt, NIL, textWidth, textHeight);
  188.     stringWidth := 0; stringHeight := 0;
  189.     CalcInputGadgetBox (
  190.       renderInfo, visibleChars, stringWidth, stringHeight);
  191.     buttonWidth := 0; buttonHeight := 0;
  192.     CalcTextButtonBox (
  193.       renderInfo, AcceptText, NIL, buttonWidth, buttonHeight);
  194.     CalcTextButtonBox (
  195.       renderInfo, CancelText, NIL, buttonWidth, buttonHeight);
  196.     dialogWidth :=
  197.       U.MaxInt
  198.         ( U.MaxInt (textWidth, stringWidth), (buttonWidth * 2) + HSpace )
  199.       + (2 * HSpace);
  200.     dialogHeight := textHeight + stringHeight + buttonHeight + (4 * VSpace);
  201.   END CalcStrDlg;
  202.  
  203.   (*------------------------------------*)
  204.   PROCEDURE InitTexts (dialog : StrDlg);
  205.  
  206.   BEGIN (* InitTexts *)
  207.     dialog.t0.type     := ISup.text;
  208.     dialog.t0.flags    := {ISup.tdCenter};
  209.     dialog.t0.leftEdge := 0;
  210.     dialog.t0.topEdge  := VSpace;
  211.     dialog.t0.text     := SYS.ADR (prompt);
  212.     dialog.t0.textAttr := NIL;
  213.     dialog.tDataEnd    := ISup.dataEnd;
  214.   END InitTexts;
  215.  
  216.   (*------------------------------------*)
  217.   PROCEDURE InitGadgets (dialog : StrDlg);
  218.  
  219.     CONST
  220.       StringGadgetFlags = {ISup.gdMovePointer};
  221.       ButtonFlags = {ISup.gdHotKey};
  222.  
  223.     VAR halfWidth : INTEGER;
  224.  
  225.   BEGIN (* InitGadgets *)
  226.     dialog.g0.type := ISup.string;
  227.     dialog.g0.flags := StringGadgetFlags;
  228.     dialog.g0.leftEdge := (dialogWidth - stringWidth) DIV 2;
  229.     dialog.g0.topEdge := textHeight + (2 * VSpace);
  230.     dialog.g0.width := stringWidth;
  231.     dialog.g0.height := stringHeight;
  232.     dialog.g0.text := NIL;
  233.     dialog.g0.textAttr := NIL;
  234.     dialog.g0.len := maxChars;
  235.     dialog.g0.activateNext := 0;
  236.     dialog.g0.activatePrev := 0;
  237.     dialog.g0.default := NIL;
  238.  
  239.     halfWidth := dialogWidth DIV 2;
  240.  
  241.     dialog.g1.type := ISup.button;
  242.     dialog.g1.flags := ButtonFlags;
  243.     dialog.g1.leftEdge := (halfWidth - buttonWidth) DIV 2;
  244.     dialog.g1.topEdge := dialog.g0.topEdge + stringHeight + VSpace;
  245.     dialog.g1.width := buttonWidth;
  246.     dialog.g1.height := buttonHeight;
  247.     dialog.g1.text := SYS.ADR(AcceptText);
  248.     dialog.g1.textAttr := NIL;
  249.     dialog.g1.selected := 0;
  250.     dialog.g1.normalRender := NIL;
  251.     dialog.g1.selectRender := NIL;
  252.  
  253.     dialog.g2.type := ISup.button;
  254.     dialog.g2.flags := ButtonFlags;
  255.     dialog.g2.leftEdge := dialog.g1.leftEdge + halfWidth;
  256.     dialog.g2.topEdge := dialog.g1.topEdge;
  257.     dialog.g2.width := buttonWidth;
  258.     dialog.g2.height := buttonHeight;
  259.     dialog.g2.text := SYS.ADR(CancelText);
  260.     dialog.g2.textAttr := NIL;
  261.     dialog.g2.selected := 0;
  262.     dialog.g2.normalRender := NIL;
  263.     dialog.g2.selectRender := NIL;
  264.  
  265.     dialog.gDataEnd := ISup.dataEnd;
  266.   END InitGadgets;
  267.  
  268. (* $D- disable copying of open arrays *)
  269. BEGIN (* InitStrDlg *)
  270.   ASSERT (dialog # NIL, 137);
  271.   CalcStrDlg ();
  272.   dialog.title := SYS.ADR (title);
  273.   dialog.width := dialogWidth;
  274.   dialog.height := dialogHeight;
  275.   dialog.flags := {ISup.rdInnerWindow};
  276.   dialog.texts := SYS.ADR (dialog.t0);
  277.   dialog.gadgets := SYS.ADR (dialog.g0);
  278.   InitTexts (dialog);
  279.   InitGadgets (dialog);
  280.   dialog.result := FALSE;
  281.   NEW (sdp); ASSERT (sdp # NIL, 137);
  282.   sdp.Init(); sdp.strDlg := dialog;
  283.   dialog.iSupPort := sdp
  284. END InitStrDlg;
  285.  
  286.  
  287. (*------------------------------------*)
  288. PROCEDURE Activate *
  289.   ( dialog     : StrDlg;
  290.     window     : I.WindowPtr;
  291.     VAR buffer : ARRAY OF CHAR )
  292.   : BOOLEAN;
  293.  
  294. BEGIN (* Activate *)
  295.   ASSERT (dialog # NIL, 137);
  296.   dialog.g0.default := SYS.ADR (buffer);
  297.   dialog.textBuffer := ""; dialog.result := FALSE;
  298.   IF ISE.Activate (dialog, window) THEN
  299.     IF dialog.result THEN COPY (dialog.textBuffer, buffer) END
  300.   END;
  301.   RETURN dialog.result
  302. END Activate;
  303.  
  304. END StringDialog.
  305.  
  306. (***************