home *** CD-ROM | disk | FTP | other *** search
/ Gold Fish 2 / goldfish_vol2_cd1.bin / files / dev / obero / oberon-a / source / fpe / fpedlg.mod < prev    next >
Text File  |  1994-08-21  |  26KB  |  905 lines
  1. (***************************************************************************
  2.  
  3.      $RCSfile: FPEDlg.mod $
  4.   Description: Displays and handles the main dialog for the FPE utility.
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 1.9 $
  8.       $Author: fjc $
  9.         $Date: 1994/08/08 16:14:57 $
  10.  
  11.   Copyright © 1993-1994, Frank Copeland.
  12.   This file is part of FPE.
  13.   See FPE.doc for conditions of use and distribution.
  14.  
  15.   Log entries are at the end of the file.
  16.  
  17. ***************************************************************************)
  18.  
  19. MODULE FPEDlg;
  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.   Errors, E := Exec, EU := ExecUtil, Dos, I := Intuition, ASL,
  31.   IU := IntuiUtil, Ev := Events, ARPUtil, ASLUtil, ISup := IntuiSup,
  32.   ISU := IntuiSupUtil, ISE := ISupEvents, Str := Strings, Data,
  33.   Tpl := FPETpl, SD := StringDialog, TD := ToolDlg, SYS := SYSTEM;
  34.  
  35.  
  36. (* ===== Dialog Window ===== *)
  37.  
  38. CONST
  39.  
  40. (* Gadget IDs *)
  41.  
  42.   ModuleID      = 0;
  43.  
  44.   FilesID       = ModuleID + 1;
  45.   LastFilesID   = ModuleID + Data.NumFiles;
  46.  
  47.   ButtonsID     = LastFilesID + 1;
  48.   LastButtonsID = LastFilesID + Data.NumTools;
  49.  
  50. (* Menu data indexes *)
  51.  
  52.   FPEIdx                   = 0;
  53.     AboutItemIdx             = 1;
  54.     QuitItemIdx              = 2;
  55.  
  56.   ProgramIdx               = 3;
  57.     CreateDirIdx             = 4;
  58.     OpenItemIdx              = 5;
  59.     AddModuleItemIdx         = 6;
  60.     RemoveModuleItemIdx      = 7;
  61.     SaveItemIdx              = 8;
  62.  
  63.   SetupIdx                 = 9;
  64.     LoadItemIdx              = 10;
  65.       LoadDefaultIdx           = 11;
  66.       LoadAltIdx               = 12;
  67.       LoadSelectIdx            = 13;
  68.     SaveSetupItemIdx         = 14;
  69.       SaveDefaultIdx           = 15;
  70.       SaveAltIdx               = 16;
  71.       SaveSelectIdx            = 17;
  72.     ButtonsItemIdx           = 18;
  73.       FirstButtonsSubItemIdx   = ButtonsItemIdx + 1;
  74.       LastButtonsSubItemIdx    = ButtonsItemIdx + Data.NumTools;
  75.     FilesItemIdx             = LastButtonsSubItemIdx + 1;
  76.       FirstFilesSubItemIdx     = FilesItemIdx + 1;
  77.       LastFilesSubItemIdx      = FilesItemIdx + Data.NumFiles;
  78.  
  79.   NumMenus = LastFilesSubItemIdx + 1;
  80.  
  81. (* Menu IDs *)
  82.  
  83.   FPEID               = 0;
  84.     AboutItemID         = 0;
  85.     QuitItemID          = 1;
  86.  
  87.   ProgramID           = 1;
  88.     CreateDirID         = 0;
  89.     OpenItemID          = 1;
  90.     AddModuleItemID     = 2;
  91.     RemoveModuleItemID  = 3;
  92.     SaveItemID          = 4;
  93.  
  94.   SetupID             = 2;
  95.     LoadItemID          = 0;
  96.       LoadDefaultID       = 0;
  97.       LoadAltID           = 1;
  98.       LoadSelectID        = 2;
  99.     SaveSetupItemID     = 1;
  100.       SaveDefaultID       = 0;
  101.       SaveAltID           = 1;
  102.       SaveSelectID        = 2;
  103.     ButtonsItemID       = 2;
  104.     FilesItemID         = 3;
  105.  
  106. VAR
  107.  
  108.   renderInfo         : ISup.RenderInfoPtr;
  109.   newWindow          : I.NewWindow;
  110.   window             : I.WindowPtr;
  111.   programNameBuffer  : ARRAY Data.FileChars + 1 OF CHAR;
  112.   template           : Tpl.Template;
  113.   gadgetList         : ISup.GadgetList;
  114.   menuData           : ARRAY NumMenus + 1 OF ISup.MenuData;
  115.   menuList           : ISup.MenuList;
  116.  
  117.  
  118. CONST
  119.   WindowTitle = "FPE 1.6 (26 Jul 1994)";
  120.   ScreenTitle = "Frank's Programming Environment";
  121.  
  122.  
  123. (* ===== Dialog Handler ===== *)
  124.  
  125. TYPE
  126.  
  127.   Handler = POINTER TO HandlerRec;
  128.   HandlerRec = RECORD (ISE.ISupPortRec) END;
  129.  
  130. CONST
  131.   IDCMPFlags = Tpl.GadgetIDCMPFlags + {I.idcmpCloseWindow, I.idcmpMenuPick};
  132.  
  133. VAR
  134.   setupDir  : Data.Path;
  135.   setupFile : Data.FileName;
  136.   handler   : Handler;
  137.  
  138. (* ===== Miscellaneous ===== *)
  139.  
  140. CONST
  141.  
  142.   OutOfMemory = "FPE : Out of memory";
  143.  
  144.  
  145. (*------------------------------------------------------------------------*)
  146. (* Local procedures *)
  147.  
  148.  
  149. PROCEDURE* Cleanup ();
  150.  
  151. BEGIN (* Cleanup *)
  152.   IF menuList # NIL   THEN ISup.base.FreeMenu (menuList) END;
  153.   IF gadgetList # NIL THEN ISup.base.FreeGadgets (gadgetList) END;
  154.   IF renderInfo # NIL THEN ISup.base.FreeRenderInfo (renderInfo) END;
  155.   Tpl.Cleanup (template);
  156. END Cleanup;
  157.  
  158.  
  159. (*------------------------------------------------------------------------*)
  160. (* ===== Dialog window procedures ===== *)
  161.  
  162.  
  163. (*------------------------------------*)
  164. PROCEDURE Init * ();
  165.  
  166.   PROCEDURE InitGadgets ();
  167.  
  168.     VAR index, result : INTEGER;
  169.  
  170.   BEGIN (* InitGadgets *)
  171.     index := 0;
  172.     WHILE index < Data.NumFiles DO
  173.       template.GadgetData.g1 [index].text :=
  174.         SYS.ADR (Data.extensions [index]);
  175.       INC (index);
  176.     END; (* WHILE *)
  177.  
  178.     index := 0;
  179.     WHILE index < Data.NumTools DO
  180.       template.GadgetData.g2 [index].text  :=
  181.         SYS.ADR (Data.tools [index].title);
  182.       INC (index)
  183.     END; (* WHILE *)
  184.  
  185.     template.TextData[1].text := SYS.ADR(programNameBuffer);
  186.  
  187.     renderInfo :=
  188.       ISup.base.GetRenderInfo (NIL, Tpl.RenderInfoFlags);
  189.     Errors.Assert (renderInfo # NIL, "FPE : failed to get render info");
  190.  
  191.     gadgetList :=
  192.       ISup.base.CreateGadgets
  193.         (renderInfo, template.GadgetData.g0, 0, 0, NIL);
  194.     Errors.Assert (gadgetList # NIL, "FPE : failed to create gadgets");
  195.   END InitGadgets;
  196.  
  197.   PROCEDURE InitMenus ();
  198.  
  199.     CONST
  200.       On = {}; Off = {ISup.mdDisabled};
  201.  
  202.     VAR index : INTEGER;
  203.  
  204.   BEGIN (* InitMenus *)
  205.     menuData [FPEIdx].type := ISup.title;
  206.     menuData [FPEIdx].flags := On;
  207.     menuData [FPEIdx].name := SYS.ADR("FPE");
  208.  
  209.       menuData [AboutItemIdx].type := ISup.item;
  210.       menuData [AboutItemIdx].flags := On;
  211.       menuData [AboutItemIdx].name := SYS.ADR("About ...");
  212.  
  213.       menuData [QuitItemIdx].type := ISup.item;
  214.       menuData [QuitItemIdx].flags := On;
  215.       menuData [QuitItemIdx].name := SYS.ADR("Quit");
  216.       menuData [QuitItemIdx].commandKey := SYS.ADR("Q");
  217.  
  218.     menuData [ProgramIdx].type := ISup.title;
  219.     menuData [ProgramIdx].flags := On;
  220.     menuData [ProgramIdx].name := SYS.ADR("Project");
  221.  
  222.       menuData [CreateDirIdx].type := ISup.item;
  223.       menuData [CreateDirIdx].flags := On;
  224.       menuData [CreateDirIdx].name := SYS.ADR("Create Directory ...");
  225.  
  226.       menuData [OpenItemIdx].type := ISup.item;
  227.       menuData [OpenItemIdx].flags := On;
  228.       menuData [OpenItemIdx].name := SYS.ADR("Select Project ...");
  229.  
  230.       menuData [AddModuleItemIdx].type := ISup.item;
  231.       menuData [AddModuleItemIdx].flags := On;
  232.       menuData [AddModuleItemIdx].name := SYS.ADR("Add Module ...");
  233.  
  234.       menuData [RemoveModuleItemIdx].type := ISup.item;
  235.       menuData [RemoveModuleItemIdx].flags := On;
  236.       menuData [RemoveModuleItemIdx].name := SYS.ADR("Remove Module ...");
  237.  
  238.       menuData [SaveItemIdx].type := ISup.item;
  239.       menuData [SaveItemIdx].flags := On;
  240.       menuData [SaveItemIdx].name := SYS.ADR("Save Module List");
  241.  
  242.     menuData [SetupIdx].type := ISup.title;
  243.     menuData [SetupIdx].flags := On;
  244.     menuData [SetupIdx].name := SYS.ADR("Setup");
  245.  
  246.       menuData [LoadItemIdx].type := ISup.item;
  247.       menuData [LoadItemIdx].flags := On;
  248.       menuData [LoadItemIdx].name := SYS.ADR("Load Setup");
  249.  
  250.         menuData [LoadDefaultIdx].type := ISup.subItem;
  251.         menuData [LoadDefaultIdx].flags := On;
  252.         menuData [LoadDefaultIdx].name := SYS.ADR ("Default Setup");
  253.  
  254.         menuData [LoadAltIdx].type := ISup.subItem;
  255.         menuData [LoadAltIdx].flags := On;
  256.         menuData [LoadAltIdx].name := SYS.ADR ("Alternate Setup");
  257.  
  258.         menuData [LoadSelectIdx].type := ISup.subItem;
  259.         menuData [LoadSelectIdx].flags := On;
  260.         menuData [LoadSelectIdx].name := SYS.ADR ("Select Setup ...");
  261.  
  262.       menuData [SaveSetupItemIdx].type := ISup.item;
  263.       menuData [SaveSetupItemIdx].flags := On;
  264.       menuData [SaveSetupItemIdx].name := SYS.ADR("Save Setup");
  265.  
  266.         menuData [SaveDefaultIdx].type := ISup.subItem;
  267.         menuData [SaveDefaultIdx].flags := On;
  268.         menuData [SaveDefaultIdx].name := SYS.ADR ("Default Setup");
  269.  
  270.         menuData [SaveAltIdx].type := ISup.subItem;
  271.         menuData [SaveAltIdx].flags := On;
  272.         menuData [SaveAltIdx].name := SYS.ADR ("Alternate Setup");
  273.  
  274.         menuData [SaveSelectIdx].type := ISup.subItem;
  275.         menuData [SaveSelectIdx].flags := On;
  276.         menuData [SaveSelectIdx].name := SYS.ADR ("Select Setup ...");
  277.  
  278.       menuData [ButtonsItemIdx].type := ISup.item;
  279.       menuData [ButtonsItemIdx].flags := On;
  280.       menuData [ButtonsItemIdx].name := SYS.ADR("Edit Tool Button");
  281.  
  282.         index := 0;
  283.         WHILE index < Data.NumTools DO
  284.           menuData [index + FirstButtonsSubItemIdx].type := ISup.subItem;
  285.           menuData [index + FirstButtonsSubItemIdx].flags := On;
  286.           menuData [index + FirstButtonsSubItemIdx].name := SYS.ADR (Data.tools [index].title);
  287.           INC( index );
  288.         END; (* WHILE *)
  289.  
  290.       menuData [FilesItemIdx].type := ISup.item;
  291.       menuData [FilesItemIdx].flags := On;
  292.       menuData [FilesItemIdx].name := SYS.ADR("Edit File Extension");
  293.  
  294.         index := 0;
  295.         WHILE index < Data.NumFiles DO
  296.           menuData [index + FirstFilesSubItemIdx].type := ISup.subItem;
  297.           menuData [index + FirstFilesSubItemIdx].flags := On;
  298.           menuData [index + FirstFilesSubItemIdx].name := SYS.ADR (Data.extensions [index]);
  299.           INC( index );
  300.         END; (* WHILE *)
  301.  
  302.     menuData [NumMenus].type := ISup.dataEnd;
  303.   END InitMenus;
  304.  
  305.   PROCEDURE InitWindow ();
  306.  
  307.   BEGIN (* InitWindow *)
  308.     window := NIL;
  309.     newWindow.leftEdge   := Tpl.LeftEdge;
  310.     newWindow.topEdge    := Tpl.TopEdge;
  311.     newWindow.width      := Tpl.Width;
  312.     newWindow.height     := Tpl.Height;
  313.     newWindow.blockPen   := 1;
  314.     newWindow.idcmpFlags := {};
  315.     newWindow.flags      := Tpl.WindowFlags;
  316.     newWindow.title      := SYS.ADR(WindowTitle);
  317.     newWindow.type       := {I.wbenchScreen};
  318.     newWindow.minWidth   := 80;   newWindow.minHeight := 30;
  319.     newWindow.maxWidth   := 1024; newWindow.maxHeight := 1024;
  320.   END InitWindow;
  321.  
  322. BEGIN (* Init *)
  323.   Tpl.Init (template);
  324.   SYS.SETCLEANUP (Cleanup);
  325.   InitGadgets ();
  326.   InitMenus();
  327.   InitWindow();
  328. END Init;
  329.  
  330.  
  331. (*------------------------------------*)
  332. PROCEDURE KillModuleList ();
  333.  
  334.   CONST
  335.     Disable = {ISup.gdDisabled}; NoFlags = {};
  336.  
  337.   VAR ignore : LONGINT;
  338.  
  339. BEGIN (* KillModuleList *)
  340.   ignore := ISup.base.SetGadgetAttributes
  341.     (gadgetList, ModuleID, Disable, Disable, ISup.useCurrentValue, 0, NIL);
  342. END KillModuleList;
  343.  
  344.  
  345. (*------------------------------------*)
  346. PROCEDURE RefreshModuleList ();
  347.  
  348.   CONST
  349.     Disable = {ISup.gdDisabled}; NoFlags = {};
  350.  
  351.   VAR ignore : LONGINT;
  352.  
  353. BEGIN (* RefreshModuleList *)
  354.   IF EU.ListLength (Data.moduleList) = 0 THEN
  355.     ignore := ISup.base.SetGadgetAttributes
  356.       ( gadgetList, ModuleID, Disable, Disable, ISup.useCurrentValue, 0,
  357.         NIL);
  358.   ELSE
  359.     ignore := ISup.base.SetGadgetAttributes
  360.       ( gadgetList, ModuleID, Disable, NoFlags, ISup.useCurrentValue,
  361.         Data.currentModuleNo, SYS.ADR (Data.moduleList));
  362.   END
  363. END RefreshModuleList;
  364.  
  365.  
  366. (*------------------------------------*)
  367. PROCEDURE Display ();
  368.  
  369.   VAR index, left, top, width, height : INTEGER;
  370.  
  371. BEGIN (* Display *)
  372.   left := window.borderLeft; top := window.borderTop;
  373.   width := window.width - left - window.borderRight;
  374.   height := window.height - top - window.borderBottom;
  375.   ISup.base.ClearWindow (renderInfo, window, left, top, width, height, {});
  376.   ISup.base.DisplayGadgets (window, gadgetList);
  377.   ISup.base.DisplayTextsPtr
  378.     (renderInfo, window, template.TextData, 0, 0, NIL);
  379.   ISup.base.DisplayBordersPtr
  380.     (renderInfo, window, template.BorderData, 0, 0);
  381.  
  382.   index := 0;
  383.   WHILE index < Data.NumFiles DO
  384.     ISU.SelectGadget
  385.       (gadgetList, FilesID + index, index IN Data.currentFiles);
  386.     INC (index)
  387.   END; (* WHILE *)
  388.  
  389.   index := 0;
  390.   WHILE index < Data.NumTools DO
  391.     ISU.DisableGadget
  392.       (gadgetList, ButtonsID + index, ~Data.tools [index].isActive);
  393.     INC (index);
  394.   END; (* WHILE *)
  395.   RefreshModuleList ();
  396. END Display;
  397.  
  398.  
  399. (*------------------------------------*)
  400. PROCEDURE * Close ();
  401.  
  402.   VAR ignore : I.WindowPtr;
  403.  
  404. BEGIN (* Close *)
  405.   IF gadgetList # NIL THEN ignore := ISup.base.RemoveGadgets (gadgetList) END;
  406.   IF menuList # NIL THEN ignore := ISup.base.RemoveMenu (menuList) END;
  407.   IF window # NIL THEN ISup.base.CloseWindow (window, E.LFALSE); window := NIL END
  408. END Close;
  409.  
  410.  
  411. (*------------------------------------*)
  412. PROCEDURE Open * ();
  413.  
  414. BEGIN (* Open *)
  415.   window :=
  416.     ISup.base.OpenWindow (renderInfo, newWindow, Tpl.OpenWindowFlags);
  417.   Errors.Assert (window # NIL, "FPE - IOpenWindow() failed");
  418.   SYS.SETCLEANUP (Close);
  419.  
  420.   I.base.SetWindowTitles
  421.     (window, SYS.ADR (WindowTitle), SYS.ADR (ScreenTitle));
  422.  
  423.   menuList :=
  424.     ISup.base.CreateMenuA (renderInfo, window, menuData, NIL, NIL);
  425.   Errors.Assert (menuList # NIL, "FPE - ICreateMenu() failed");
  426.   ISup.base.AttachMenu (window, menuList);
  427.  
  428.   Display ();
  429. END Open;
  430.  
  431.  
  432. (*------------------------------------*)
  433. (* $D- disable copying of open arrays *)
  434. PROCEDURE ShowMessage ( message : ARRAY OF CHAR );
  435.  
  436. BEGIN (* ShowMessage *)
  437.   ISU.DoNotice (window, SYS.ADR("*** FPE Message ***"), message)
  438. END ShowMessage;
  439.  
  440.  
  441. (*------------------------------------*)
  442. PROCEDURE RefreshProgramName ();
  443.  
  444. BEGIN (* RefreshProgramName *)
  445.   programNameBuffer := "                              ";
  446.   Str.OverWrite (programNameBuffer, Data.programName, 0);
  447.   ISup.base.DisplayTextsPtr
  448.     (renderInfo, window, template.TextData, 0, 0, NIL);
  449. END RefreshProgramName;
  450.  
  451.  
  452. (*------------------------------------*)
  453. PROCEDURE RefreshWindow ();
  454.  
  455.   CONST Flags = {ISup.cwNormalColor};
  456.  
  457. BEGIN (* RefreshWindow *)
  458.   ISup.base.RefreshGadgets (gadgetList);
  459.   ISup.base.DisplayTextsPtr
  460.     (renderInfo, window, template.TextData, 0, 0, NIL);
  461.   ISup.base.DisplayBordersPtr
  462.     (renderInfo, window, template.BorderData, 0, 0);
  463. END RefreshWindow;
  464.  
  465.  
  466. (*------------------------------------*)
  467. PROCEDURE ResetGadgets ();
  468.  
  469.   VAR  window : I.WindowPtr;
  470.  
  471. BEGIN (* ResetGadgets *)
  472.   window := ISup.base.RemoveGadgets (gadgetList);
  473.   ISup.base.FreeGadgets (gadgetList);
  474.  
  475.   gadgetList :=
  476.     ISup.base.CreateGadgets
  477.       (renderInfo, template.GadgetData.g0, 0, 0, NIL);
  478.   Errors.Assert (gadgetList # NIL, "FPE : failed to reset gadgets");
  479.  
  480.   Display ();
  481. END ResetGadgets;
  482.  
  483.  
  484. (*------------------------------------------------------------------------*)
  485. (* ===== Dialog handler procedures ===== *)
  486.  
  487.  
  488. (*------------------------------------*)
  489. (* $D- disable copying of open arrays *)
  490. PROCEDURE DoLoadProgram (program : ARRAY OF CHAR);
  491.  
  492.   VAR message : ARRAY 60 OF CHAR;
  493.  
  494. BEGIN (* DoLoadProgram *)
  495.   ISup.base.ChangeMousePointerPtr (window, NIL, E.LFALSE);
  496.   KillModuleList ();
  497.   IF ~Data.LoadProgram (program) THEN
  498.     message := "Could not find ";
  499.     Str.Append (message, program);
  500.     Str.Append (message, ".prg");
  501.     ShowMessage (message);
  502.     IF program [0] = 0X THEN
  503.       IF ~Data.ScanModules () THEN
  504.         ShowMessage ("Error scanning for modules");
  505.       END; (* IF *)
  506.     ELSE
  507.       Data.MakeModule (program);
  508.     END; (* IF *)
  509.   END; (* IF *)
  510.   RefreshProgramName ();
  511.   RefreshModuleList ();
  512.   ISup.base.RestoreMousePointer (window);
  513. END DoLoadProgram;
  514.  
  515.  
  516. (*------------------------------------*)
  517. PROCEDURE (handler : Handler) HandleISup
  518.   ( msg : I.IntuiMessagePtr)
  519.   : INTEGER;
  520.  
  521.   VAR gadget : LONGINT; value  : LONGINT;
  522.  
  523. BEGIN (* HandleISup *)
  524.   gadget := msg.code; value := SYS.VAL (LONGINT, msg.iAddress);
  525.   ISup.base.ReplyMsg (msg);
  526.  
  527.   CASE gadget OF
  528.     ModuleID :
  529.       Data.currentModule :=
  530.         SYS.VAL (Data.ModuleNodePtr, EU.NodeAt (Data.moduleList, value));
  531.       Data.currentModuleNo := value
  532.     |
  533.     FilesID .. LastFilesID :
  534.       IF value # 0 THEN
  535.         INCL (Data.currentFiles, gadget - FilesID);
  536.       ELSE
  537.         EXCL (Data.currentFiles, gadget - FilesID);
  538.       END
  539.     |
  540.     ButtonsID .. LastButtonsID :
  541.       Data.DoTool (SHORT (gadget) - ButtonsID)
  542.     |
  543.   ELSE
  544.   END; (* CASE gadget *)
  545.  
  546.   RETURN Ev.Continue;
  547. END HandleISup;
  548.  
  549.  
  550. (*------------------------------------*)
  551. PROCEDURE* HandleClosewindow
  552.   ( ip : Ev.IdcmpPort;
  553.     msg : I.IntuiMessagePtr )
  554.   : INTEGER;
  555.  
  556. BEGIN (* HandleClosewindow *)
  557.   E.base.ReplyMsg (msg);
  558.   RETURN Ev.StopAll;
  559. END HandleClosewindow;
  560.  
  561.  
  562. (*------------------------------------*)
  563. PROCEDURE* HandleMenuPick
  564.   ( ip : Ev.IdcmpPort;
  565.     msg : I.IntuiMessagePtr )
  566.   : INTEGER;
  567.  
  568.   VAR
  569.     menuNumber, result : INTEGER; window : I.WindowPtr;
  570.     menuChoice : IU.Choice;
  571.  
  572.   (*------------------------------------*)
  573.   PROCEDURE RequestFile
  574.     ( hail : ARRAY OF CHAR;
  575.       VAR file, dir : ARRAY OF CHAR )
  576.     : BOOLEAN;
  577.  
  578.   (* $D- *)
  579.   BEGIN (* RequestFile *)
  580.     IF ASL.base # NIL THEN
  581.       RETURN ASLUtil.RequestFile (window, hail, file, dir)
  582.     ELSE
  583.       RETURN ARPUtil.RequestFile (window, hail, file, dir)
  584.     END
  585.   END RequestFile;
  586.  
  587.   (*------------------------------------*)
  588.   PROCEDURE DoAbout ();
  589.  
  590.     VAR ignore : BOOLEAN;
  591.  
  592.     BEGIN (* DoAbout *)
  593.       ignore :=
  594.         ISup.base.AutoRequest
  595.           ( window, SYS.ADR("About FPE"),
  596.             "FPE 1.6 (26 Jul 1994)\\n"
  597.             "Frank's Programming Environment\\n"
  598.             "--oOo--\\n"
  599.             "Copyright © 1993-1994 Frank Copeland\\n"
  600.             "Written using Oberon-A\\n"
  601.             "and intuisup.library\\n\\n"
  602.             "see FPE.doc for conditions of use",
  603.             NIL, SYS.ADR("Continue"), {}, {},
  604.             { ISup.arBackFill, ISup.arMovePointerNeg,
  605.               ISup.arDrawRaster, ISup.arTextCenter },
  606.             NIL)
  607.     END DoAbout;
  608.  
  609.   (*------------------------------------*)
  610.   PROCEDURE DoCreateDir ();
  611.  
  612.     VAR
  613.       strDlg : SD.StrDlg; dirName : ARRAY 32 OF CHAR;
  614.       newDir : Dos.FileLockPtr; msg : ARRAY 60 OF CHAR;
  615.  
  616.     BEGIN (* DoCreateDir *)
  617.       NEW (strDlg);
  618.       IF strDlg # NIL THEN
  619.         SD.InitStrDlg
  620.           ( strDlg, renderInfo, "Create Directory", "Enter directory name",
  621.             31, 31);
  622.         dirName := "";
  623.         IF SD.Activate (strDlg, window, dirName) THEN
  624.           newDir := Dos.base.CreateDir (dirName);
  625.           IF newDir # NIL THEN
  626.             Dos.base.UnLock (newDir)
  627.           ELSE
  628.             msg := "Could not create directory : ";
  629.             Str.Append (msg, dirName);
  630.             ShowMessage (msg);
  631.           END
  632.         END;
  633.         SYS.DISPOSE (strDlg)
  634.       ELSE ShowMessage (OutOfMemory)
  635.       END
  636.     END DoCreateDir;
  637.  
  638.   (*------------------------------------*)
  639.   PROCEDURE DoOpen;
  640.  
  641.     VAR tempFile : Data.FileName; tempDir : Data.Path;
  642.  
  643.     BEGIN (* DoOpen *)
  644.       tempFile := ""; tempDir := Data.currentPath;
  645.       IF RequestFile ("Select a project", tempFile, tempDir)
  646.       THEN
  647.         Data.ChangeDirectory (tempDir);
  648.         DoLoadProgram (tempFile)
  649.       END;
  650.     END DoOpen;
  651.  
  652.   (*------------------------------------*)
  653.   PROCEDURE DoSave ();
  654.  
  655.     VAR msg : ARRAY 60 OF CHAR;
  656.  
  657.     BEGIN (* DoSave *)
  658.       ISup.base.ChangeMousePointerPtr (window, NIL, E.LFALSE);
  659.       IF ~Data.SaveProgram() THEN
  660.         msg := "Could not save ";
  661.         Str.Append (msg, Data.programName);
  662.         Str.Append (msg, ".prg");
  663.         ShowMessage (msg);
  664.       END; (* IF *)
  665.       ISup.base.RestoreMousePointer (window);
  666.     END DoSave;
  667.  
  668.   (*------------------------------------*)
  669.   PROCEDURE DoAddModule ();
  670.  
  671.     VAR strDlg : SD.StrDlg; module : Data.FileName;
  672.  
  673.     BEGIN (* DoAddModule *)
  674.       NEW (strDlg);
  675.       IF strDlg # NIL THEN
  676.         SD.InitStrDlg
  677.           ( strDlg, renderInfo, "Add Module",
  678.             "Enter a module name", Data.FileChars, Data.FileChars);
  679.         module := "";
  680.         IF SD.Activate (strDlg, window, module) THEN
  681.           Data.MakeModule (module);
  682.           RefreshModuleList ()
  683.         END;
  684.         SYS.DISPOSE (strDlg)
  685.       ELSE
  686.         ShowMessage (OutOfMemory)
  687.       END
  688.     END DoAddModule;
  689.  
  690.   (*------------------------------------*)
  691.   PROCEDURE DoRemoveModule ();
  692.  
  693.     BEGIN (* DoRemoveModule *)
  694.       IF
  695.         ISU.DoRequest
  696.           ( window, SYS.ADR("Remove the current module?"),
  697.             "  Are you sure about this?  ")
  698.       THEN
  699.         Data.RemoveModule();
  700.         RefreshModuleList ()
  701.       END; (* IF *)
  702.     END DoRemoveModule;
  703.  
  704.   (*------------------------------------*)
  705.   PROCEDURE DoSetupFiles ( file : INTEGER );
  706.  
  707.     VAR strDlg : SD.StrDlg; extension : Data.Extension;
  708.  
  709.     BEGIN (* DoSetupFiles *)
  710.       NEW (strDlg);
  711.       IF strDlg # NIL THEN
  712.         SD.InitStrDlg
  713.           ( strDlg, renderInfo, "Setup Files", "Enter extension",
  714.             Data.ExtensionChars, Data.ExtensionChars);
  715.         extension := Data.extensions [file];
  716.         IF SD.Activate (strDlg, window, extension) THEN
  717.           Data.extensions [file] := extension; ResetGadgets ()
  718.         END;
  719.         SYS.DISPOSE (strDlg)
  720.       ELSE
  721.         ShowMessage (OutOfMemory)
  722.       END
  723.     END DoSetupFiles;
  724.  
  725.   (*------------------------------------*)
  726.   PROCEDURE DoSetupButtons (toolNo : INTEGER);
  727.  
  728.     CONST DisableFlag = {ISup.gdDisabled}; NoFlag = {};
  729.  
  730.     VAR ignore : LONGINT; toolDialog : TD.Dialog;
  731.  
  732.   BEGIN (* DoSetupButtons *)
  733.     TD.MakeDialog (toolDialog);
  734.     TD.Activate (toolDialog, Data.tools [toolNo], window);
  735.     IF toolDialog.accepted THEN
  736.       ISU.DisableGadget
  737.         ( gadgetList, ButtonsID + toolNo,
  738.           ~Data.tools [toolNo].isActive )
  739.     END;
  740.     TD.FreeDialog (toolDialog);
  741.   END DoSetupButtons;
  742.  
  743.  
  744.   (*------------------------------------*)
  745.   PROCEDURE DoSaveSetup ();
  746.  
  747.     VAR tempFile : Data.FileName; tempDir : Data.Path;
  748.  
  749.   BEGIN (* DoSaveSetup *)
  750.     tempFile := setupFile; tempDir := setupDir;
  751.     IF
  752.       RequestFile ("Save setup to ...", tempFile, tempDir)
  753.     THEN
  754.       setupFile := tempFile; setupDir := tempDir;
  755.       Data.SaveSetup (tempDir, tempFile)
  756.     END; (* IF *)
  757.   END DoSaveSetup;
  758.  
  759.  
  760.   (*------------------------------------*)
  761.   PROCEDURE DoLoadSetup ();
  762.  
  763.     VAR tempFile : Data.FileName; tempDir : Data.Path;
  764.  
  765.   BEGIN (* DoLoadSetup *)
  766.     tempFile := setupFile; tempDir := setupDir;
  767.     IF
  768.       RequestFile ("Load setup from ...", tempFile, tempDir)
  769.     THEN
  770.       setupFile := tempFile; setupDir := tempDir;
  771.       Data.LoadSetup (tempDir, tempFile); ResetGadgets ()
  772.     END;
  773.   END DoLoadSetup;
  774.  
  775. BEGIN (* HandleMenuPick *)
  776.   result := Ev.Continue;
  777.  
  778.   menuNumber := msg.code;
  779.   window := msg.idcmpWindow;
  780.   E.base.ReplyMsg (msg);
  781.  
  782.   WHILE menuNumber # I.menuNull DO
  783.     IU.GetMenuChoice (menuNumber, window.menuStrip^, menuChoice);
  784.  
  785.     CASE menuChoice.menuChosen OF
  786.       FPEID :
  787.         CASE menuChoice.itemChosen OF
  788.           AboutItemID : DoAbout();
  789.           |
  790.           QuitItemID  : result := Ev.StopAll;
  791.           |
  792.         END; (* CASE menuChoice.itemChosen *)
  793.       |
  794.       ProgramID :
  795.         CASE menuChoice.itemChosen OF
  796.           CreateDirID        : DoCreateDir()
  797.           |
  798.           OpenItemID         : DoOpen();
  799.           |
  800.           AddModuleItemID    : DoAddModule();
  801.           |
  802.           RemoveModuleItemID : DoRemoveModule();
  803.           |
  804.           SaveItemID         : DoSave();
  805.           |
  806.         END; (* CASE menuChoice.itemChosen *)
  807.       |
  808.       SetupID :
  809.         CASE menuChoice.itemChosen OF
  810.           SaveSetupItemID :
  811.             CASE menuChoice.subItemChosen OF
  812.               SaveDefaultID : Data.SaveDefSetup (TRUE);
  813.               |
  814.               SaveAltID : Data.SaveDefSetup (FALSE);
  815.               |
  816.               SaveSelectID : DoSaveSetup ();
  817.               |
  818.             END; (* CASE menuChoice.subItemChosen *)
  819.           |
  820.           LoadItemID      :
  821.             CASE menuChoice.subItemChosen OF
  822.               LoadDefaultID :
  823.                 Data.LoadDefSetup (TRUE); ResetGadgets ()
  824.               |
  825.               LoadAltID :
  826.                 Data.LoadDefSetup (FALSE); ResetGadgets ()
  827.               |
  828.               LoadSelectID : DoLoadSetup ();
  829.               |
  830.             END; (* CASE menuChoice.subItemChosen *)
  831.           |
  832.           ButtonsItemID   :
  833.             DoSetupButtons (menuChoice.subItemChosen)
  834.           |
  835.           FilesItemID     :
  836.             DoSetupFiles (menuChoice.subItemChosen)
  837.           |
  838.         END; (* CASE menuChoice.itemChosen *)
  839.       |
  840.     END; (* CASE menuChoice.menuChosen *)
  841.  
  842.     menuNumber := menuChoice.pointer.nextSelect;
  843.   END; (* WHILE *)
  844.  
  845.   RETURN result;
  846. END HandleMenuPick;
  847.  
  848.  
  849. (*------------------------------------*)
  850. PROCEDURE Start * ();
  851.  
  852. BEGIN (* Start *)
  853.   NEW (handler); ASSERT (handler # NIL, 132);
  854.   handler.Init();
  855.   handler.Handle [I.idcmpCloseWindow] := HandleClosewindow;
  856.   handler.Handle [I.idcmpMenuPick] := HandleMenuPick;
  857.   setupDir := "FPE:S";
  858.   setupFile := "Default.fpe";
  859.  
  860.   I.base.OldModifyIDCMP (window, IDCMPFlags);
  861.   Ev.AttachPort (handler, window.userPort);
  862.   DoLoadProgram (Data.programName);
  863.   Ev.SimpleLoop (handler);
  864.   Ev.DetachPort (handler)
  865. END Start;
  866.  
  867. END FPEDlg.
  868.  
  869. (***************************************************************************
  870.  
  871.   $Log: FPEDlg.mod $
  872.   Revision 1.9  1994/08/08  16:14:57  fjc
  873.   Release 1.4
  874.  
  875.   Revision 1.8  1994/06/21  22:09:15  fjc
  876.   - Added code to conditionally call asl.library instead of
  877.     arp.library.
  878.  
  879.   Revision 1.7  1994/06/17  17:26:27  fjc
  880.   - Updated for release
  881.  
  882.   Revision 1.6  1994/06/09  13:36:47  fjc
  883.   - Incorporated changes in Amiga interface.
  884.   - Bumped version strings.
  885.  
  886.   Revision 1.5  1994/06/04  23:49:52  fjc
  887.   - Changed to use new Amiga interface
  888.  
  889.   Revision 1.4  1994/05/19  23:45:35  fjc
  890.   - Added "Program-Create Directory" menu item
  891.  
  892.   Revision 1.3  1994/05/12  21:26:09  fjc
  893.   - Prepared for release
  894.  
  895.   Revision 1.2  1994/01/24  14:33:33  fjc
  896.   Changed to conform with changes in Module Handlers:
  897.     Handler procedures now reply to any messages they handle
  898.   Modified About requester
  899.  
  900.   Revision 1.1  1994/01/15  17:32:38  fjc
  901.   Start of revision control
  902.  
  903. ***************************************************************************)
  904.  
  905.