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