home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 4 / FreshFish_May-June1994.bin / new / amigalibdisks / d996 / startup-menu / source / sm / main.pas next >
Pascal/Delphi Source File  |  1994-04-05  |  7KB  |  201 lines
  1. (* Startup-Menu . Menu on start-up
  2.  * Use SMPrefs to create Prefs file.
  3.  * Lee Kindness Jan '94 HSP source.
  4.  * v1.00
  5.  *)
  6.   
  7. Program SMPrefs(input, output);
  8.  
  9. Uses Exec, Intuition, utility, Amiga, gadtools, graphics, 
  10.         LSKExtras, DOS, DiskFont;
  11.  
  12. (*$I SM.h       *) 
  13. (*$I Config.PAS *)
  14. (*$I Window.PAS *)
  15.        
  16. (* ===================================================================== *)
  17.  
  18. Procedure Close_Window;
  19.  
  20. VAR OK : Boolean;
  21.  
  22. Begin
  23.    CloseWindow(TheWindow);       (* close window and free gadgets and *)
  24.    FreeGadgets(glist);           (* visualinfo                        *)
  25.    FreeVisualInfo(vi);
  26.    OK := CloseScreen(TheScreen);
  27. End;
  28.  
  29. (* ===================================================================== *)
  30.  
  31. Function HandleIDCMP : ShortInt;
  32.  
  33. Type
  34.     strarray = Array[1..3] Of string;
  35.     Tag2     = Array[0..6] Of tTagItem;
  36.     
  37. Const
  38.    exitflag : Boolean  = False;
  39.    small    : Boolean  = False;
  40.    NumStrs  : shortint = 3;
  41.    rc : shortint = 10;
  42.    
  43. Var 
  44.     dummy, dum : longint;           (* the main loop of the program. *)
  45.     Tags       : tag2;              (* monitors IDCMP messages and   *)
  46.    message    : pIntuiMessage;     (* responds as appropriate       *)
  47.    MsgClass   : LongInt;
  48.    MsgCode    : Word;
  49.    gadcode    : pGadget;
  50.    StrInfo    : pStringInfo;
  51.    tempint    : Array[1..4] Of longint;
  52.    OKRes      : boolean;
  53.     i          : byte;
  54.     tmpstr     : string;
  55.     found      : boolean;
  56.     node       : pMyNode;
  57.     
  58.  
  59. begin
  60.    tempint[4] := TheWindow^.Height;
  61.    While Not exitflag Do Begin
  62.       dummy    := Wait(BitMask(TheWindow^.UserPort^.MP_SIGBIT));
  63.       Repeat
  64.           message  := GT_GetIMsg(TheWindow^.userPort);
  65.           MsgClass := message^.Class;
  66.           MsgCode  := message^.Code;
  67.           GadCode  := pGadget(message^.IAddress);
  68.           StrInfo  := gadcode^.SpecialInfo;
  69.              GT_ReplyIMsg(message);
  70.           Case MsgClass Of
  71.           
  72.              IDCMP_REFRESHWINDOW : RefreshWin;
  73.              
  74.              IDCMP_MOUSEBUTTONS : Begin
  75.                   Case MsgCode Of
  76.                       MENUUP : Begin
  77.                           tempint[1] := TheWindow^.LeftEdge;
  78.                               tempint[2] := TheWindow^.TopEdge;
  79.                               tempint[3] := TheWindow^.Width;
  80.                               If Small Then Begin
  81.                               ChangeWindowBox(TheWindow, tempint[1], tempint[2], tempint[3], Tempint[4]);
  82.                               Small := False;
  83.                           End Else Begin
  84.                               ChangeWindowBox(TheWindow, tempint[1], tempint[2], tempint[3], Sizes[TBS]);
  85.                               Small := True;
  86.                           End;
  87.                       End;
  88.                   End;
  89.               End;
  90.                  
  91.              IDCMP_GADGETUP : Begin
  92.                  If RetrieveStr(GadCode^.UserData) <> 'None' then begin
  93.                      DisableWindow(TheWindow, @DummyReq, waitpointer);
  94.                      DOS.exec(RetrieveStr(GadCode^.UserData),'');
  95.                      exitflag := true;
  96.                      rc := 0;
  97.                      EnableWindow(TheWindow, @DummyReq, WindowIDCMP);
  98.                  end;
  99.             end;
  100.             
  101.             IDCMP_VANILLAKEY : begin
  102.                 node := pMyNode(CurrentList^.lh_Head);
  103.                 found := false;
  104.                 While (pMyNode(node^.LSK_Node.ln_Succ) <> NIL) 
  105.                                         AND (NOT Found) do begin
  106.                  if UpCase(chr(msgcode)) = node^.LSK_Key then
  107.                      found := true
  108.                  else node := pMyNode(node^.LSK_Node.ln_Succ);
  109.                 end;
  110.                 If found then begin
  111.                     DisableWindow(TheWindow, @DummyReq, waitpointer);
  112.                     DOS.exec(node^.LSK_Cmd,'');
  113.                     exitflag := true;
  114.                     rc := 0;
  115.                     EnableWindow(TheWindow, @DummyReq, WindowIDCMP);
  116.                 end else DisplayBeep(TheScreen);  
  117.             end; 
  118.             
  119.          End; (*case*)
  120.  
  121.       Until message = NIL;
  122.    End; (*while*)
  123.    HandleIdcmp := rc;
  124. End;
  125.  
  126. (* ===================================================================== *)
  127.  
  128. (* 
  129.  * Main Procedure 
  130.  *)
  131.  
  132. Procedure main;
  133.  
  134. VAR
  135.     rc : shortint;
  136.     FileName : String;
  137.     ok : boolean;
  138.  
  139. Begin
  140.   IntuitionBase := pIntuitionBase(OpenLibrary('intuition.library',34));
  141.   if IntuitionBase = NIL then halt(122);
  142.    If IntuitionBase^.LibNode.lib_Version > 36 Then begin
  143.     GadToolsBase  := Openlibrary('gadtools.library',36); 
  144.     If GadToolsBase <> NIL Then begin
  145.      GfxBase  := pGfxBase(Openlibrary('graphics.library',36)); 
  146.      If GfxBase <> NIL Then begin
  147.       DiskFontBase  := Openlibrary('diskfont.library',36); 
  148.       If DiskFontBase <> NIL Then begin
  149.       
  150.         CurrentList := AllocRemember(@RememberKey, sizeof(tList), MEMF_CLEAR);
  151.        if currentlist = NIL then ErrExit('Failed to allocate list memory'#0, 10);
  152.          waitpointer := AllocRemember(@RememberKey, sizeof(tPointerArray), MEMF_CHIP);
  153.        if waitpointer = NIL then ErrExit('Failed to allocate pointer memory'#0, 10);
  154.        WaitPointer^[0]  := $0000; WaitPointer^[1] := $0000;
  155.  
  156.         WaitPointer^[2]  := $0400; WaitPointer^[3]  := $07c0;
  157.         WaitPointer^[4]  := $0000; WaitPointer^[5]  := $07c0;
  158.         WaitPointer^[6]  := $0100; WaitPointer^[7]  := $0380;
  159.         WaitPointer^[8]  := $0000; WaitPointer^[9]  := $07e0;
  160.         WaitPointer^[10] := $07c0; WaitPointer^[11] := $1ff8;
  161.         WaitPointer^[12] := $1ff0; WaitPointer^[13] := $3fec;
  162.         WaitPointer^[14] := $3ff8; WaitPointer^[15] := $7fde;
  163.         WaitPointer^[16] := $3ff8; WaitPointer^[17] := $7fbe;
  164.         WaitPointer^[18] := $7ffc; WaitPointer^[19] := $ff7f;
  165.         WaitPointer^[20] := $7efc; WaitPointer^[21] := $ffff;
  166.          WaitPointer^[22] := $7ffc; WaitPointer^[23] := $ffff;
  167.          WaitPointer^[24] := $3ff8; WaitPointer^[25] := $7ffe;
  168.          WaitPointer^[26] := $3ff8; WaitPointer^[27] := $7ffe;
  169.          WaitPointer^[28] := $1ff0; WaitPointer^[29] := $3ffc;
  170.          WaitPointer^[30] := $07c0; WaitPointer^[31] := $1ff8;
  171.          WaitPointer^[32] := $0000; WaitPointer^[33] := $07e0;
  172.  
  173.          WaitPointer^[34] := $0000; WaitPointer^[35] := $0000;
  174.          OK := false;
  175.          If ParamCount >= 1 then begin
  176.              IF NOT ReadConfigFile(paramstr(1)) then begin
  177.                  ok := ReadConfigFile(PREFSDIRH+PREFSNAME);
  178.              end else ok := true;
  179.          end else ok := ReadConfigFile(PREFSDIRH+PREFSNAME);
  180.          InitRequester(@DummyReq);
  181.         if OK then begin     
  182.          Open_Window;
  183.          rc := HandleIDCMP;
  184.          Close_window;
  185.           FreeRemember(@RememberKey, True);
  186.         end else ErrorExit('** Startup-Menu Error **'#0, 'Preference file not found or invalid! - Use SMPrefs'#0);
  187.  
  188.         CloseLibrary(pLibrary(DiskFontBase));
  189.       end else ErrExit('Disk Font library v36 (2.0) required'#0, 122);
  190.        CloseLibrary(pLibrary(GfxBase));
  191.      end else ErrExit('Graphics library v36 (2.0) required'#0, 122);
  192.       CloseLibrary(pLibrary(GadToolsBase));
  193.     end else ErrExit('GadTools library v36 (2.0) required'#0, 122);
  194.    CloseLibrary(pLibrary(IntuitionBase));
  195.   end else    ErrExit('Intuition library v36 (2.0) required'#0, 122);
  196.   halt(rc);
  197. end;
  198.  
  199. (* ===================================================================== *)  
  200. begin main end.
  201. (* ===================================================================== *)