home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Frozen Fish 1: Amiga
/
FrozenFish-Apr94.iso
/
bbs
/
alib
/
d9xx
/
d996
/
startup-menu.lha
/
Startup-Menu
/
Source
/
SM
/
main.PAS
next >
Wrap
Pascal/Delphi Source File
|
1994-04-05
|
7KB
|
201 lines
(* Startup-Menu . Menu on start-up
* Use SMPrefs to create Prefs file.
* Lee Kindness Jan '94 HSP source.
* v1.00
*)
Program SMPrefs(input, output);
Uses Exec, Intuition, utility, Amiga, gadtools, graphics,
LSKExtras, DOS, DiskFont;
(*$I SM.h *)
(*$I Config.PAS *)
(*$I Window.PAS *)
(* ===================================================================== *)
Procedure Close_Window;
VAR OK : Boolean;
Begin
CloseWindow(TheWindow); (* close window and free gadgets and *)
FreeGadgets(glist); (* visualinfo *)
FreeVisualInfo(vi);
OK := CloseScreen(TheScreen);
End;
(* ===================================================================== *)
Function HandleIDCMP : ShortInt;
Type
strarray = Array[1..3] Of string;
Tag2 = Array[0..6] Of tTagItem;
Const
exitflag : Boolean = False;
small : Boolean = False;
NumStrs : shortint = 3;
rc : shortint = 10;
Var
dummy, dum : longint; (* the main loop of the program. *)
Tags : tag2; (* monitors IDCMP messages and *)
message : pIntuiMessage; (* responds as appropriate *)
MsgClass : LongInt;
MsgCode : Word;
gadcode : pGadget;
StrInfo : pStringInfo;
tempint : Array[1..4] Of longint;
OKRes : boolean;
i : byte;
tmpstr : string;
found : boolean;
node : pMyNode;
begin
tempint[4] := TheWindow^.Height;
While Not exitflag Do Begin
dummy := Wait(BitMask(TheWindow^.UserPort^.MP_SIGBIT));
Repeat
message := GT_GetIMsg(TheWindow^.userPort);
MsgClass := message^.Class;
MsgCode := message^.Code;
GadCode := pGadget(message^.IAddress);
StrInfo := gadcode^.SpecialInfo;
GT_ReplyIMsg(message);
Case MsgClass Of
IDCMP_REFRESHWINDOW : RefreshWin;
IDCMP_MOUSEBUTTONS : Begin
Case MsgCode Of
MENUUP : Begin
tempint[1] := TheWindow^.LeftEdge;
tempint[2] := TheWindow^.TopEdge;
tempint[3] := TheWindow^.Width;
If Small Then Begin
ChangeWindowBox(TheWindow, tempint[1], tempint[2], tempint[3], Tempint[4]);
Small := False;
End Else Begin
ChangeWindowBox(TheWindow, tempint[1], tempint[2], tempint[3], Sizes[TBS]);
Small := True;
End;
End;
End;
End;
IDCMP_GADGETUP : Begin
If RetrieveStr(GadCode^.UserData) <> 'None' then begin
DisableWindow(TheWindow, @DummyReq, waitpointer);
DOS.exec(RetrieveStr(GadCode^.UserData),'');
exitflag := true;
rc := 0;
EnableWindow(TheWindow, @DummyReq, WindowIDCMP);
end;
end;
IDCMP_VANILLAKEY : begin
node := pMyNode(CurrentList^.lh_Head);
found := false;
While (pMyNode(node^.LSK_Node.ln_Succ) <> NIL)
AND (NOT Found) do begin
if UpCase(chr(msgcode)) = node^.LSK_Key then
found := true
else node := pMyNode(node^.LSK_Node.ln_Succ);
end;
If found then begin
DisableWindow(TheWindow, @DummyReq, waitpointer);
DOS.exec(node^.LSK_Cmd,'');
exitflag := true;
rc := 0;
EnableWindow(TheWindow, @DummyReq, WindowIDCMP);
end else DisplayBeep(TheScreen);
end;
End; (*case*)
Until message = NIL;
End; (*while*)
HandleIdcmp := rc;
End;
(* ===================================================================== *)
(*
* Main Procedure
*)
Procedure main;
VAR
rc : shortint;
FileName : String;
ok : boolean;
Begin
IntuitionBase := pIntuitionBase(OpenLibrary('intuition.library',34));
if IntuitionBase = NIL then halt(122);
If IntuitionBase^.LibNode.lib_Version > 36 Then begin
GadToolsBase := Openlibrary('gadtools.library',36);
If GadToolsBase <> NIL Then begin
GfxBase := pGfxBase(Openlibrary('graphics.library',36));
If GfxBase <> NIL Then begin
DiskFontBase := Openlibrary('diskfont.library',36);
If DiskFontBase <> NIL Then begin
CurrentList := AllocRemember(@RememberKey, sizeof(tList), MEMF_CLEAR);
if currentlist = NIL then ErrExit('Failed to allocate list memory'#0, 10);
waitpointer := AllocRemember(@RememberKey, sizeof(tPointerArray), MEMF_CHIP);
if waitpointer = NIL then ErrExit('Failed to allocate pointer memory'#0, 10);
WaitPointer^[0] := $0000; WaitPointer^[1] := $0000;
WaitPointer^[2] := $0400; WaitPointer^[3] := $07c0;
WaitPointer^[4] := $0000; WaitPointer^[5] := $07c0;
WaitPointer^[6] := $0100; WaitPointer^[7] := $0380;
WaitPointer^[8] := $0000; WaitPointer^[9] := $07e0;
WaitPointer^[10] := $07c0; WaitPointer^[11] := $1ff8;
WaitPointer^[12] := $1ff0; WaitPointer^[13] := $3fec;
WaitPointer^[14] := $3ff8; WaitPointer^[15] := $7fde;
WaitPointer^[16] := $3ff8; WaitPointer^[17] := $7fbe;
WaitPointer^[18] := $7ffc; WaitPointer^[19] := $ff7f;
WaitPointer^[20] := $7efc; WaitPointer^[21] := $ffff;
WaitPointer^[22] := $7ffc; WaitPointer^[23] := $ffff;
WaitPointer^[24] := $3ff8; WaitPointer^[25] := $7ffe;
WaitPointer^[26] := $3ff8; WaitPointer^[27] := $7ffe;
WaitPointer^[28] := $1ff0; WaitPointer^[29] := $3ffc;
WaitPointer^[30] := $07c0; WaitPointer^[31] := $1ff8;
WaitPointer^[32] := $0000; WaitPointer^[33] := $07e0;
WaitPointer^[34] := $0000; WaitPointer^[35] := $0000;
OK := false;
If ParamCount >= 1 then begin
IF NOT ReadConfigFile(paramstr(1)) then begin
ok := ReadConfigFile(PREFSDIRH+PREFSNAME);
end else ok := true;
end else ok := ReadConfigFile(PREFSDIRH+PREFSNAME);
InitRequester(@DummyReq);
if OK then begin
Open_Window;
rc := HandleIDCMP;
Close_window;
FreeRemember(@RememberKey, True);
end else ErrorExit('** Startup-Menu Error **'#0, 'Preference file not found or invalid! - Use SMPrefs'#0);
CloseLibrary(pLibrary(DiskFontBase));
end else ErrExit('Disk Font library v36 (2.0) required'#0, 122);
CloseLibrary(pLibrary(GfxBase));
end else ErrExit('Graphics library v36 (2.0) required'#0, 122);
CloseLibrary(pLibrary(GadToolsBase));
end else ErrExit('GadTools library v36 (2.0) required'#0, 122);
CloseLibrary(pLibrary(IntuitionBase));
end else ErrExit('Intuition library v36 (2.0) required'#0, 122);
halt(rc);
end;
(* ===================================================================== *)
begin main end.
(* ===================================================================== *)