Club Amiga de Montreal - CAM/CAM_CD_1.iso/files/337.lha/Helper_v.07/gads.mod

Modula Implementation | 1990-01-26 | 19.0 KB | 545 lines

IMPLEMENTATION MODULE Gads;

(*======================================================================*)
(*                        Helper version v0.07                          *)
(*======================================================================*)
(*           Copyright © 1989 Mike Cargal, All Rights Reserved          *)
(*======================================================================*)
(*      Version: 0.07           Author : Mike Cargal                    *)
(*      Date   : 20-Jun-89      Changes: Original                       *)
(*======================================================================*)

FROM SYSTEM         IMPORT ADR, STRPTR, BYTE, ADDRESS, TSIZE;
FROM EasyWindows    IMPORT CreateWindow;
FROM EasyIDCMP      IMPORT ProcTable, ProcessEvents;
FROM EasyGadgets    IMPORT currentList, AddBorders, AddDropShadow,
                           listFailed, DisposeList, StartList,
                           AddBoolGadget, nextShadowFrontPen,
                           nextIntuiFrontPen, currentGadget,
                           AddStrGadget, nextBoolActivation,
                           nextID, nextIntuiDrawMode, nextIntuiBackPen,
                           nextFlags, nextIntuiTopEdge;
FROM Intuition      IMPORT WindowFlags, IDCMPFlags, WindowPtr,
                           WindowFlagSet, IDCMPFlagSet, IntuiMessage,
                           CloseWindow, GadgetPtr, ActivateWindow,
                           RefreshGadgets, ActivationFlags,
                           RefreshGList, MoveWindow, Screen,
                           GadgetFlagSet, GadgetFlags, Gadget,
                           ActivationFlagSet, ActivateGadget,
                           WBenchScreen, GetScreenData;
FROM DOS            IMPORT Open, Close, Read, Write, FileLock,
                           FileHandle, ModeReadWrite, ModeNewFile;
FROM ArpMisc        IMPORT FileRequester, FileRequest, FRFunction,
                           FRFuncFlags, FRFuncFlagSet,
                           CloseWindowSafely, ArpAllocFreq,
                           FileRequesterPtr;
FROM ArpDOS         IMPORT TackOn;
FROM Rasters        IMPORT Jam2;
FROM Strings        IMPORT AppendSubStr, AssignStr, CompareStr, Equal;
                (*  IMPORT Debug; *)
(*$O-,$R-*)
TYPE

  Configuration =
    RECORD
      Vsn      : ARRAY [0..13] OF CHAR; (* Version ID *)
      ScreenX,
      ScreenY  : INTEGER;               (* Helper window coordinates *)
      Gads     : GadArray;              (* Helper Gadget configuration *)
    END;

VAR
  wp           : WindowPtr;
  Config       : Configuration;
  GadList      : GadgetPtr;
  fr           : FileRequesterPtr;

(*******************************************************************)

PROCEDURE GetFile(text, Dir : STRPTR) : STRPTR;

  (*-------------------------------------------------------------\
   |                                                             |
   |  Use Arp File requester to get file name.                   |
   |       text - Title to appear at top of requester            |
   |       Dir  - Directory in which requester should initiate.  |
   |              NIL = Use Current Directory of Process.        |
   |                                                             |
   |    Returns - STRPTR to full path name of requested file.    |
   |                                                             |
   \-------------------------------------------------------------*)

VAR
  FileName : STRPTR;

BEGIN

  WITH fr^ DO
    frHail      := text;
    frFile^     := '';
    frWindow    := WindowPtr(NIL);
    frFuncFlags := FRFuncFlagSet{DoColor};
    frFunction  := FRFunction(NIL);
    AssignStr(frDir^,Dir^);
  END;

  FileName := FileRequest(fr);
  TackOn(fr^.frDir,FileName);
  RETURN(fr^.frDir);

END GetFile;

(*******************************************************************)

(*$L+*)
PROCEDURE HandleCloseWindow(VAR im : IntuiMessage) : INTEGER;

  (*-------------------------------------------------------------\
   |                                                             |
   |  Handle Close Window IDCMP message for EasyIDCMP.           |
   |                                                             |
   |    I have nothing special to do, so just return non 0       |
   |      to let EasyIDCMP know I'm through.                     |
   |                                                             |
   \-------------------------------------------------------------*)

BEGIN
  RETURN(1)
END HandleCloseWindow;
(*$L-*)

(*******************************************************************)

PROCEDURE HandleGadgetUp(VAR im : IntuiMessage;
                             gp : GadgetPtr)       : INTEGER;

  (*-------------------------------------------------------------\
   |                                                             |
   |  Gadgets are numbered:    0  1  2                           |
   |                           3  4  5                           |
   |                           6  7  8...                        |
   |                                                             |
   |   Therefore line is GadgetID DIV 3 and the type Gadget is   |
   |     GadgetID MOD 3                                          |
   |                                                             |
   |     0 - String gadget for button label.  Change Gads.Label  |
   |           and activate command string gadget.               |
   |                                                             |
   |     1 - String gadget for command to execute.  Change       |
   |           Gads.Command.                                     |
   |                                                             |
   |     2 - Append File boolean gadget. Set Gads.AppendFile     |
   |           according to Gadget selected flag.                |
   |                                                             |
   |                                                             |
   \-------------------------------------------------------------*)

VAR
  Activated : BOOLEAN;
  i         : CARDINAL;

BEGIN

  i := gp^.GadgetID DIV 3;

  CASE (gp^.GadgetID MOD 3) OF
    0 : AssignStr(Config.Gads[i].Label,gp^.SpecialInfoS^.Buffer^);
        Activated := ActivateGadget(gp^.NextGadget,wp,NIL)

  | 1 : AssignStr(Config.Gads[i].Command,gp^.SpecialInfoS^.Buffer^);
        AppendSubStr(Config.Gads[i].Command," ")

  | 2 : Config.Gads[i].AppendFile := Selected IN gp^.Flags;

  END;

  RETURN(0);

END HandleGadgetUp;

(*******************************************************************)

PROCEDURE AddDefineGadgets();

  (*-------------------------------------------------------------\
   |                                                             |
   |  Set up gadgets to allow user definition of Helper buttons  |
   |    and their responses.                                     |
   |                                                             |
   \-------------------------------------------------------------*)

VAR
  i : INTEGER;

BEGIN

  StartList;

(*
  nextIntuiFrontPen  := 3;
  nextShadowFrontPen := 1;
*)
  nextIntuiTopEdge   := 0;
  nextBoolActivation := ActivationFlagSet{RelVerify,ToggleSelect};

  FOR i := 0 TO 11 DO
    EXCL(nextFlags,Selected);
    AddStrGadget(10,i*12+15,60,8,6,Config.Gads[i].Label);
    AddBorders;
    AddStrGadget(85,i*12+15,285,8,100,Config.Gads[i].Command);
    AddBorders;

    IF Config.Gads[i].AppendFile THEN
      INCL(nextFlags,Selected)
    ELSE
      EXCL(nextFlags,Selected)
    END;

    AddBoolGadget(385,i*12+15,100,8,"Append File");
    AddBorders;

  END;

END AddDefineGadgets;

(*******************************************************************)

PROCEDURE AddHelperGadgets();

  (*-------------------------------------------------------------\
   |                                                             |
   |  Add Helper button gadgets to Helper window.                |
   |                                                             |
   \-------------------------------------------------------------*)

VAR
  i : INTEGER;

BEGIN

  StartList;
  nextIntuiDrawMode  := Jam2;
  nextIntuiBackPen   := 0;
(*
  nextIntuiFrontPen  := 3;
  nextShadowFrontPen := 1;
*)
  FOR i := 0 TO 11 DO
    AddBoolGadget((i MOD 3)*70+8,
                  (i DIV 3)*20+16,
                  55, 14,
                  Config.Gads[i].Label);
    AddBorders;
    AddDropShadow;
  END;

END AddHelperGadgets;

(*******************************************************************)

PROCEDURE LoadGads(wp : WindowPtr);

  (*-------------------------------------------------------------\
   |                                                             |
   |  Present user with File requester to select configuration   |
   |   file, and then load user configuration from selected      |
   |   file.  Configuration file is verified against version     |
   |   number of Helper so that non-configuration files and      |
   |   incompatible configuration files will be rejected.        |
   |                                                             |
   |  Return success or failure of Configuration load.           |
   |                                                             |
   |  NOTE: file requester goes initially to S: since            |
   |   requesting configuration file.                            |
   |                                                             |
   \-------------------------------------------------------------*)

VAR
  TempConfig     : Configuration;
  MyFileHandle   : FileHandle;
  Length         : LONGINT;

BEGIN

  MyFileHandle := Open(GetFile(ADR(" <*> Load Helper Buttons <*> "),
                               ADR("S:")),
                       ModeReadWrite);
  IF MyFileHandle # NIL THEN
    Length := Read(MyFileHandle,ADR(TempConfig),TSIZE(Configuration));
    Close(MyFileHandle);

    IF CompareStr(Version,TempConfig.Vsn) = Equal THEN
      Config := TempConfig;
      RefreshGadgets(GadList,wp,NIL);
      MoveWindow(wp,
                 Config.ScreenX-wp^.LeftEdge,
                 Config.ScreenY-wp^.TopEdge)
    END;
  END;

END LoadGads;

(*******************************************************************)

PROCEDURE SaveGads(wp : WindowPtr);

  (*-------------------------------------------------------------\
   |                                                             |
   |  Present user with File requester (inititially in S:) to    |
   |   select configuration file. Save current configuration     |
   |   to selected file.                                         |
   |                                                             |
   \-------------------------------------------------------------*)

VAR
  MyFileHandle : FileHandle;
  Length       : LONGINT;

BEGIN

  Config.ScreenX := wp^.LeftEdge;
  Config.ScreenY := wp^.TopEdge;

  MyFileHandle := Open(GetFile(ADR(" <*> Save Helper Buttons <*> "),
                               ADR("S:")),
                       ModeNewFile);
  IF MyFileHandle # NIL THEN
    Length := Write(MyFileHandle,ADR(Config),TSIZE(Configuration));
    Close(MyFileHandle)
  END;

END SaveGads;

(*******************************************************************)

PROCEDURE SaveDefaults(wp : WindowPtr);

  (*-------------------------------------------------------------\
   |                                                             |
   |  Save current configuration to default configuration file   |
   |   (S:Helper.cnf).  This file will be read automatically     |
   |   when Helper is started up to obtain users default         |
   |   configuration.                                            |
   |                                                             |
   \-------------------------------------------------------------*)

VAR
  MyFileHandle : FileHandle;
  Length       : LONGINT;

BEGIN

  Config.ScreenX := wp^.LeftEdge;
  Config.ScreenY := wp^.TopEdge;
  MyFileHandle := Open(DefConfig,ModeNewFile);
  IF MyFileHandle # NIL THEN
    Length := Write(MyFileHandle,ADR(Config),TSIZE(Configuration));
    Close(MyFileHandle)
  END;

END SaveDefaults;

(*******************************************************************)

PROCEDURE ChangeGads(Helperwp : WindowPtr);

  (*-------------------------------------------------------------\
   |                                                             |
   |  Open Window with Helper button definition gadgets.         |
   |                                                             |
   |  Use EasyIDCMP to respond to user gadget selection and      |
   |    modify user configuration.                               |
   |                                                             |
   \-------------------------------------------------------------*)

VAR
  MyProcTable  : ProcTable;
  dummy        : INTEGER;

BEGIN

  AddDefineGadgets;

  IF NOT listFailed THEN
    wp := CreateWindow(70,15,500,165,
                       ' <*> Helper Define <*>  ©1989, Mike Cargal',
                       IDCMPFlagSet{GadgetUp,
                                    CloseWindowFlag},
                       WindowFlagSet{WindowDrag,
                                     WindowDepth,
                                     WindowClose,
                                     WindowActive},
                       NIL,currentList);
    IF wp # NIL THEN
      WITH MyProcTable DO
        WaitForEvent := TRUE;
        CloseWindow  := HandleCloseWindow;
        GadgetUp     := HandleGadgetUp;
      END;
      dummy := ProcessEvents(wp,MyProcTable);
      CloseWindowSafely(wp,NIL);
      DisposeList(currentList);
      RefreshGadgets(GadList,Helperwp,NIL)
    END;
  END;
END ChangeGads;

(*******************************************************************)

PROCEDURE AddGad(i       : CARDINAL;
                 cmd     : ARRAY OF CHAR;
                 lb      : ARRAY OF CHAR;
                 append  : BOOLEAN);

  (*-------------------------------------------------------------\
   |                                                             |
   |   Add Helper "default defaults" to Gads structure.          |
   |                                                             |
   |      i      - Array member                                  |
   |      cmd    - command to issue in response to button        |
   |      lb     - Label to place on Helper button               |
   |      append - BOOLEAN indicator of whether or not           |
   |                 to present file requester to append         |
   |                 file name                                   |
   |                                                             |
   \-------------------------------------------------------------*)

BEGIN

  AssignStr(Config.Gads[i].Command,cmd);
  AssignStr(Config.Gads[i].Label,lb);
  Config.Gads[i].AppendFile := append;

END AddGad;

(*******************************************************************)

PROCEDURE OpenHelperWindow() : WindowPtr;

  (*-------------------------------------------------------------\
   |                                                             |
   |   Open Helper Gadget window returning pointer to main       |
   |     main program.                                           |
   |                                                             |
   |   Set up gadgets, Open window AND return WindowPtr if       |
   |     successful.                                             |
   |                                                             |
   \-------------------------------------------------------------*)

VAR
  wp         : WindowPtr;
  ScreenData : Screen;

BEGIN

  (* Verify that window position from config is valid for current screen *)

  IF GetScreenData(ADR(ScreenData),TSIZE(Screen),WBenchScreen,NIL) THEN
    IF Config.ScreenX + 220 > ScreenData.Width THEN
      Config.ScreenX := ScreenData.Width - 220
    END;
    IF Config.ScreenY + 100 > ScreenData.Height THEN
      Config.ScreenY := ScreenData.Height - 100
    END;
  END;

  wp := NIL;
  AddHelperGadgets;
  IF NOT listFailed THEN
    GadList := currentList;

    wp := CreateWindow(Config.ScreenX,Config.ScreenY,220,100,
                       Version,
                       IDCMPFlagSet{GadgetUp,
                                    CloseWindowFlag,
                                    MenuPick},
                       WindowFlagSet{WindowDrag,
                                     WindowDepth,
                                     WindowClose},
                       NIL,GadList);
  END;
  RETURN(wp)
END OpenHelperWindow;

(*******************************************************************)

PROCEDURE CloseHelperWindow(wp : WindowPtr);
  (*-------------------------------------------------------------\
   |                                                             |
   |   Close Helper gadget window and free memory allocated      |
   |     for gadgets.                                            |
   |                                                             |
   \-------------------------------------------------------------*)

BEGIN

  CloseWindowSafely(wp,NIL);
  DisposeList(GadList);

END CloseHelperWindow;

(*******************************************************************)

PROCEDURE InitGads() : GadPtr;

  (*-------------------------------------------------------------\
   |                                                             |
   |  Attempt to open S:Helper.cnf to read in user's default     |
   |    configuration.                                           |
   |                                                             |
   |  If default configuration file is not located, then         |
   |    assign "default default" values to Helper buttons        |
   |                                                             |
   \-------------------------------------------------------------*)

CONST
  AddFile = TRUE;
  NoFile  = FALSE;

VAR
  MyFileHandle : FileHandle;
  Length       : LONGINT;
  TempConfig   : Configuration;
  HaveConfig   : BOOLEAN;

BEGIN

  HaveConfig := FALSE;
  MyFileHandle := Open(DefConfig,ModeReadWrite);
  IF MyFileHandle # NIL THEN
    Length := Read(MyFileHandle,ADR(TempConfig),TSIZE(Configuration));
    IF CompareStr(TempConfig.Vsn,Version) = Equal THEN
      Config := TempConfig;
      HaveConfig := TRUE;
    END;
    Close(MyFileHandle);
  END;
  IF NOT HaveConfig THEN
    Config.Vsn     := Version;
    Config.ScreenX := 420;
    Config.ScreenY := 11;
    AddGad( 0,'CD '       ,'  CD  ',AddFile);
    AddGad( 1,'CD / '     ,'Parent',NoFile );
    AddGad( 2,'Dir '      ,' Dir  ',NoFile );
    AddGad( 3,'Run '      ,' Run  ',AddFile);
    AddGad( 4,'Ed '       ,' Edit ',AddFile);
    AddGad( 5,'Avail '    ,'Avail ',NoFile );
    AddGad( 6,'Delete '   ,'Delete',AddFile);
    AddGad( 7,'Type '     ,' Type ',AddFile);
    AddGad( 8,'Type >PRT:','Print ',AddFile);
    AddGad( 9,''          ,' Exec ',AddFile);
    AddGad(10,'Date '     ,' Date ',NoFile );
    AddGad(11,'EndCLI '   ,'EndCLI',NoFile );
  END;
  RETURN(ADR(Config.Gads));
END InitGads;

(*********************************************************************)

BEGIN

  fr        := ArpAllocFreq();
  DefConfig := ADR("s:helper.cnf");

END Gads.