home *** CD-ROM | disk | FTP | other *** search
- (* SMPrefs. Creates a data file which is stored
- * in S: which holds the description of gadgets required on the menu.
- * Lee Kindness Jan '94 HSP source.
- * v1.00
- *)
-
- Program SMPrefs(input, output);
-
- Uses Exec, Intuition, utility, gadtools, graphics, DiskFont,
- ASL, AmigaDOS, LSKExtras, Amiga, IFFParse, DOS, ReqTools;
-
- (*$I SMEditor.h *)
- (*$I Config.PAS *)
- (*$I List.PAS *)
- (*$I Window.PAS *)
-
-
- (* ===================================================================== *)
-
- Procedure Close_Window;
-
- Begin
- CloseWindow(TheWindow); (* close window and free gadgets and *)
- FreeGadgets(gads[G_NI]); (* visualinfo *)
- FreeVisualInfo(vi);
- End;
-
- (* ===================================================================== *)
-
- Procedure GetTitles;
- VAR
- buffer: Pointer;
- values: argarray;
- ret : Long;
- tags : array [0..4] of tTagItem;
-
- begin
- wl := rtLockWindow(TheWindow);
- tags[0].ti_Tag := RT_Window;
- tags[0].ti_Data := LONG(TheWindow);
- tags[1].ti_Tag := RTGS_TextFmt;
- tags[1].ti_Data := LONG(CStrConstPtr('Enter the text to be displayed'+#10+' on the screen titlebar.'));
- tags[2].ti_Tag := RTGS_FLAGS;
- tags[2].ti_Data := GSREQF_CENTERTEXT;
- tags[3].ti_Tag := TAG_END;
-
- buffer := @CD.cd_ScrTit[1];
- ret:=rtGetStringA (buffer, 127, 'SMPrefs', NIL, @tags);
- values[0]:=LongInt(buffer);
- if ret <> 0 then
- CD.cd_ScrTit := retrievestr(Pointer(values[0])) + #0;
-
- buffer := @CD.cd_WinTit[1];
- tags[1].ti_Data := LONG(CStrConstPtr('Enter the text to be displayed'+#10+' on the window titlebar.'));
- ret:=rtGetStringA (buffer, 127, 'SMPrefs', NIL, @tags);
- values[0] := LongInt(buffer);
- if ret <> 0 then
- CD.cd_WinTit := retrievestr(Pointer(values[0])) + #0;
- tl := rtUnLockWindow(TheWindow, pointer(wl));
- end;
-
- (* ===================================================================== *)
-
- Procedure GetPal;
-
- CONST
- MyPens : Array[0..8] of Word = ($FFFF); (* Get default *)
-
- VAR
- result : Long;
- tags : array [0..10] of tTagItem;
- TheScreen : pScreen;
- win : pWindow;
- ok : boolean;
- MyTextFont : pTextFont;
-
- begin
- wl := rtLockWindow(TheWindow);
-
- DiskFontBase := Openlibrary('diskfont.library',36);
- If DiskFontBase <> NIL Then begin
- MyTextFont := OpenDiskFont(@CD.cd_Font);
- CloseLibrary(pLibrary(DiskFontBase));
- end;
-
- tags[0].ti_Tag := SA_Type;
- tags[0].ti_Data := CUSTOMSCREEN;
- tags[1].ti_Tag := SA_Title;
- tags[1].ti_Data := LONG(CStrConstPtr('Change the palette'));
- tags[2].ti_Tag := SA_OverScan;
- tags[2].ti_Data := OSCAN_TEXT;
- tags[3].ti_Tag := SA_Depth;
- tags[3].ti_Data := 2;
- tags[4].ti_Tag := SA_Font;
- tags[4].ti_Data := LONG(@CD.cd_Font);
- tags[5].ti_Tag := SA_DisplayID;
- tags[5].ti_Data := CD.cd_ModeID;
- tags[6].ti_Tag := SA_Width;
- tags[6].ti_Data := STDSCREENWIDTH;
- tags[7].ti_Tag := SA_Height;
- tags[7].ti_Data := STDSCREENHEIGHT;
- tags[8].ti_Tag := SA_Pens;
- tags[8].ti_Data := LONG(@MyPens);
- tags[9].ti_Tag := SA_Colors;
- tags[9].ti_Data := LONG(NIL);
- tags[10].ti_Tag := TAG_END;
-
- TheScreen := OpenScreenTagList(NIL, @tags);
- IF TheScreen <> NIL then begin
- LoadRGB4(@TheScreen^.ViewPort, @CD.cd_Pal[0], 4);
- tags[0].ti_Tag := RT_Screen;
- tags[0].ti_Data := LONG(TheScreen);
- tags[1].ti_Tag := TAG_END;
-
- result := rtPaletteRequestA ('Change palette', NIL, @tags);
- if result <> -1 then begin
- CD.cd_Pal[0] := GetRGB4(TheScreen^.ViewPort.ColorMap,0);
- CD.cd_Pal[1] := GetRGB4(TheScreen^.ViewPort.ColorMap,1);
- CD.cd_Pal[2] := GetRGB4(TheScreen^.ViewPort.ColorMap,2);
- CD.cd_Pal[3] := GetRGB4(TheScreen^.ViewPort.ColorMap,3);
- end;
- ok := CloseScreen(TheScreen);
- end;
- tl := rtUnLockWindow(TheWindow, pointer(wl));
- end;
-
-
-
- (* ===================================================================== *)
-
- Function GetSCRID : LongInt; (* Use Reqtools to get ModeID *)
- VAR
- scrnreq: prtScreenModeRequester;
- Value : Longint;
- ret : longint;
- mytag : Array[0..3] of tTagItem;
-
- Begin
- wl := rtLockWindow(TheWindow);
- scrnreq := Pointer(rtAllocRequestA (RT_SCREENMODEREQ, NIL));
- if (scrnreq<>NIL) then begin
- scrnreq^.DisplayID := CD.cd_ModeID;
- mytag[0].ti_Tag:=RTSC_Flags;
- mytag[0].ti_Data:= 0;
- mytag[1].ti_Tag:=RT_UnderScore;
- mytag[1].ti_Data:=LongInt('_');
- mytag[2].ti_Tag := RT_Window;
- mytag[2].ti_Data := LONG(TheWindow);
- mytag[3].ti_Tag:=TAG_END;
-
- ret:=rtScreenModeRequestA ( scrnreq, 'Pick a screenmode', @mytag);
- value :=LongInt(scrnreq^.DisplayID);
- end ;
- ret:=rtFreeRequest (scrnreq);
- GetSCRID := value;
- tl := rtUnLockWindow(TheWindow, pointer(wl));
- end;
-
- (* ===================================================================== *)
-
- Procedure HandleIDCMP;
-
- Type
- strarray = Array[1..3] Of string;
- Tag2 = Array[0..8] Of tTagItem;
-
- Const
- exitflag : Boolean = False;
- small : Boolean = False;
- NumStrs : shortint = 3;
-
- Var
- dummy, dum, ret : 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, cnt : Longint;
- tmpstr : string;
- fr : pFontRequester;
- lr, sr, cr : pFileRequester;
- cfile : PathStr;
- cdir : DirStr;
-
- Procedure TxtInGads(curnode : pMyNode);
-
- begin
- Tags[0].ti_Tag := GTST_String;
- Tags[0].ti_Data := LONG(@currentnode^.LSK_Name[1]);
- Tags[1].ti_Tag := TAG_END;
- GT_SetGadgetAttrsA(gads[G_S_TXT], TheWindow, NIL, @Tags);
-
- Tags[0].ti_Tag := GTST_String;
- Tags[0].ti_Data := LONG(@currentnode^.LSK_Cmd[1]);
- Tags[1].ti_Tag := TAG_END;
- GT_SetGadgetAttrsA(gads[G_S_CMD], TheWindow, NIL, @Tags);
-
- Tags[0].ti_Tag := GTST_String;
- Tags[0].ti_Data := LONG(@currentnode^.LSK_Key[1]);
- Tags[1].ti_Tag := TAG_END;
- GT_SetGadgetAttrsA(gads[G_S_KEY], TheWindow, NIL, @Tags);
- end;
-
- Begin
- Tags[0].ti_Tag := ASL_Hail;
- Tags[0].ti_Data := LONG(CstrConstPtrAR(@RememberKey, 'Pick a font'));
- Tags[1].ti_Tag := ASL_FontName;
- Tags[1].ti_Data := LONG(CD.cd_Font.ta_Name);
- Tags[2].ti_Tag := ASL_FontHeight;
- Tags[2].ti_Data := long(CD.cd_Font.ta_YSize);
- Tags[3].ti_Tag := ASL_MinHeight;
- Tags[3].ti_Data := 6;
- Tags[4].ti_Tag := ASL_MaxHeight;
- Tags[4].ti_Data := 30;
- Tags[5].ti_Tag := ASL_FuncFlags;
- Tags[5].ti_Data := FONF_STYLES;
- Tags[6].ti_Tag := ASL_Window;
- Tags[6].ti_Data := long(TheWindow);
- Tags[7].ti_Tag := ASL_FontStyles;
- Tags[7].ti_Data := long(CD.cd_Font.ta_Style);
- Tags[8].ti_Tag := TAG_DONE;
-
-
- fr := AllocASLRequest(ASL_FontRequest, @Tags[0]);
-
- Tags[0].ti_Tag := ASL_Hail;
- Tags[0].ti_Data := LONG(CstrConstPtrAR(@RememberKey, 'Locate the prefs file'));
- Tags[1].ti_Tag := ASL_File;
- Tags[1].ti_Data := LONG(@PREFSNAME[1]);
- Tags[2].ti_Tag := ASL_Dir;
- Tags[2].ti_Data := long(@PREFSDIRH[1]);
- Tags[3].ti_Tag := ASL_Window;
- Tags[3].ti_Data := long(TheWindow);
- Tags[4].ti_Tag := ASL_FuncFlags;
- Tags[4].ti_Data := 0;
- Tags[5].ti_Tag := ASL_Pattern;
- Tags[5].ti_Data := LONG(CstrConstPtrAR(@RememberKey, '#?.prefs'));
- Tags[6].ti_Tag := TAG_DONE;
-
- lr := AllocASLRequest(ASL_FileRequest, @Tags[0]);
-
- Tags[0].ti_Tag := ASL_Hail;
- Tags[0].ti_Data := LONG(CstrConstPtrAR(@RememberKey, 'Pick Command'));
- Tags[1].ti_Tag := ASL_Window;
- Tags[1].ti_Data := long(TheWindow);
- Tags[2].ti_Tag := ASL_FuncFlags;
- Tags[2].ti_Data := 0;
- Tags[3].ti_Tag := ASL_Pattern;
- Tags[3].ti_Data := LONG(CstrConstPtrAR(@RememberKey, '~(#?.info)'));
- Tags[4].ti_Tag := ASL_Dir;
- Tags[4].ti_Data := long(CstrConstPtrAR(@RememberKey, 'SYS:'));
- Tags[5].ti_Tag := TAG_DONE;
-
- cr := AllocASLRequest(ASL_FileRequest, @Tags[0]);
-
- Tags[0].ti_Tag := ASL_Hail;
- Tags[0].ti_Data := LONG(CstrConstPtrAR(@RememberKey, 'Save prefs file as'));
- Tags[1].ti_Tag := ASL_File;
- Tags[1].ti_Data := LONG(@PREFSNAME[1]);
- Tags[2].ti_Tag := ASL_Dir;
- Tags[2].ti_Data := long(@PREFSDIRH[1]);
- Tags[3].ti_Tag := ASL_Window;
- Tags[3].ti_Data := long(TheWindow);
- Tags[4].ti_Tag := ASL_FuncFlags;
- Tags[4].ti_Data := FILF_SAVE;
- Tags[5].ti_Tag := ASL_Pattern;
- Tags[5].ti_Data := LONG(CstrConstPtrAR(@RememberKey, '#?.prefs'));
- Tags[6].ti_Tag := TAG_DONE;
-
- sr := AllocASLRequest(ASL_FileRequest, @Tags[0]);
-
- 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
- Case gadcode^.GadgetID Of
- G_B_TOP : Begin
- if currentnode <> NIL then begin
- DetachObjectList;
- Remove(pNode(CurrentNode));
- AddHead(CurrentList,pNode(CurrentNode));
- CurrentTop := 0;
- CurrentOrd := 0;
- (* Attach object list *)
- AttachObjectList;
- TxtInGads(currentnode);
- RefreshWin;
- end;
- End;
- G_B_UP : Begin
- pred := pMyNode(Currentnode^.LSK_Node.ln_Pred);
- if (CurrentNode <> NIL) and (pred <> NIL) then begin
- DetachObjectList;
- (* Move node one position up *)
- pred := pMyNode(pred^.LSK_Node.ln_Pred);
- Remove(pNode(CurrentNode));
- Insert_(CurrentList,pNode(CurrentNode),pNode(pred));
- CurrentOrd := CurrentOrd - 1;
- if currentord < 0 then currentord := 0;
- if currentord < 0 then currentord := 0;
- if (CurrentOrd>ListViewRows-(ListViewRows div 2)) then
- currenttop := CurrentOrd+(ListViewRows div 2)-ListViewRows
- else currenttop := 0;
- AttachObjectList;
- TxtInGads(currentnode);
- RefreshWin;
- end;
- End;
- G_B_DOWN : Begin
- succ := pMyNode(currentnode^.LSK_Node.ln_Succ);
- if (CurrentNode <> NIL) and (succ <> NIL) then begin
- DetachObjectList;
- Remove(pNode(CurrentNode));
- Insert_(CurrentList,pNode(CurrentNode),pNode(succ));
- Currentord := currentord + 1;
- i := 0;
- tmpnode := pMyNode(currentlist^.lh_Head);
- While tmpnode <> NIL do begin
- i := i + 1;
- tmpnode := pMyNode(tmpnode^.LSK_Node.ln_Succ);
- end;
- i := i-2;
- if currentord > i then currentord := i;
- if currentord < 0 then currentord := 0;
- if (CurrentOrd>ListViewRows-(ListViewRows div 2)) then
- currenttop := CurrentOrd+(ListViewRows div 2)-ListViewRows
- else currenttop := 0;
- AttachObjectList;
- TxtInGads(currentnode);
- end;
- End;
- G_B_BOTTOM : Begin
- if currentnode <> NIL then begin
- DetachObjectList;
- Remove(pNode(CurrentNode));
- AddTail(CurrentList,pNode(CurrentNode));
- tmpnode := pMyNode(currentlist^.lh_Head);
- i := 0;
- while tmpnode <> NIL do begin
- tmpnode := pMyNode(tmpnode^.LSK_Node.ln_Succ);
- i := i + 1;
- end;
- CurrentOrd := i - 1;
- if (CurrentOrd>ListViewRows-(ListViewRows div 2)) then
- currenttop := CurrentOrd+(ListViewRows div 2)-ListViewRows
- else currenttop := 0;
- AttachObjectList;
- TxtInGads(currentnode);
- end;
- end;
-
- G_B_SORT : SortGadgetFunc;
-
- G_B_NEW : Begin
- DetachObjectList;
- tmpnode := Add_Name('New Gadget');
- CurrentNode := tmpnode;
- CurrentOrd := 0;
- currenttop := 0;
- DisableObjectGadgets(False_);
- TxtInGads(currentnode);
- AttachObjectList;
- CD.cd_Down := calcdown(CD.cd_Across);
- end;
-
- G_B_REMOVE : Begin
- DetachObjectList;
- DisableObjectGadgets(TRUE_);
- Remove(pNode(CurrentNode));
- CurrentNode := NIL;
- if (CurrentOrd>ListViewRows) then
- currenttop := CurrentOrd-ListViewRows+1
- else currenttop := 0;
- CurrentOrd := -1;
- AttachObjectList;
- CD.cd_Down := calcdown(CD.cd_Across);
- end;
-
- G_B_COPY : Begin
- if (CurrentNode <> NIL) then begin
- DetachObjectList;
- newnode := AllocRemember(@RememberKey, sizeof(tMyNode), MEMF_CLEAR);
- newnode^ := CurrentNode^;
- (* Correct pointers *)
- newnode^.LSK_Node.ln_Name := @newnode^.LSK_Name[1];
- if newnode <> NIL then begin
- Insert_(CurrentList,pNode(newnode),pNode(CurrentNode));
- CurrentNode := newnode;
- CurrentOrd := CurrentOrd + 1;
- if (CurrentOrd>ListViewRows) then
- currenttop := CurrentOrd-ListViewRows+1
- else currenttop := 0;
- end;
- AttachObjectList;
- CD.cd_Down := calcdown(CD.cd_Across);
- end;
- end;
-
- G_B_SAVE : Begin
- wl := rtLockWindow(TheWindow);
- DetachObjectList;
- IF NOT WriteConfigFile(PREFSDIRH+PREFSNAME) then DisplayBeep(NIL);
- AttachObjectList;
- tl := rtUnLockWindow(TheWindow, pointer(wl));
- exitflag := True;
- end;
-
- G_B_SAVEAS : Begin
- wl := rtLockWindow(TheWindow);
- if AslRequest(sr, NIL) then begin
- DetachObjectList;
- cdir := retrievestr(sr^.rf_Dir);
-
- (* have to bo this because FExpand & ChDir an' a' them
- hang the machine *)
-
- if not (cdir[length(cdir)] = ':') then
- if not (cdir[length(cdir)] = '/') then
- cdir := cdir + '/';
- cfile := retrievestr(sr^.rf_file);
- filename := cdir + cfile;
-
- IF NOT WriteConfigFile(filename) then DisplayBeep(NIL);
- AttachObjectList;
- end;
- tl := rtUnLockWindow(TheWindow, pointer(wl));
- end;
-
- G_B_LOAD : Begin
- wl := rtLockWindow(TheWindow);
- if AslRequest(lr, NIL) then begin
- DetachObjectList;
- cdir := retrievestr(lr^.rf_Dir);
-
- (* have to bo this because FExpand & ChDir an' a' them
- hang the machine *)
-
- cnt := 0;
- for i := 1 to length(cdir) do
- if cdir[i] = ':' then inc(cnt);
- CASE cnt of
- 0 : cdir := cdir + ':';
- 1 : if not (cdir[length(cdir)] = ':') then
- cdir := cdir + '/';
- end;
- cfile := retrievestr(lr^.rf_file);
- filename := cdir + cfile;
- OKRes := ReadConfigFile(filename);
- if NOT OKRes then begin
- (* Start a' fresh *)
- CurrentList := AllocRemember(@RememberKey, sizeof(tList), MEMF_CLEAR);
- if currentlist = NIL then ErrExit('Failed to allocate list memory'#0, 0);
- NewList(CurrentList);
- end ;
- CurrentNode := NIL;
- CurrentTop := 0;
- CurrentOrd := -1;
- DisableObjectGadgets(TRUE_);
- AttachObjectList;
- UpDateFont;
- UpDateAcDown;
- end;
- tl := rtUnLockWindow(TheWindow, pointer(wl));
- end;
-
- G_B_CANCEL : exitflag := True;
-
- G_S_TXT : Begin
- if currentnode <> NIL then begin
- DetachObjectList;
- remove(pNode(currentnode));
- currentnode^.LSK_Name := RetrieveStr(strinfo^.Buffer)+#0;
- Insert_(CurrentList,pNode(currentnode),pNode(currentnode^.LSK_Node.ln_Pred));
- AttachObjectList;
- end;
- OKRes := ActivateGadget(Gads[G_S_CMD], TheWindow, NIL);
- end;
-
- G_S_CMD : Begin
- if currentnode <> NIL then begin
- DetachObjectList;
- remove(pNode(currentnode));
- currentnode^.LSK_Cmd := RetrieveStr(strinfo^.Buffer)+#0;
- Insert_(CurrentList,pNode(currentnode),pNode(currentnode^.LSK_Node.ln_Pred));
- AttachObjectList;
- end;
- OKRes := ActivateGadget(Gads[G_S_KEY], TheWindow, NIL);
- end;
-
- G_S_KEY : Begin
- if currentnode <> NIL then begin
- DetachObjectList;
- remove(pNode(currentnode));
- tmpStr := RetrieveStr(strinfo^.Buffer);
- currentnode^.LSK_Key := UpCase(tmpstr[1]);
- Insert_(CurrentList,pNode(currentnode),pNode(currentnode^.LSK_Node.ln_Pred));
- AttachObjectList;
- end;
- OKRes := ActivateGadget(Gads[G_S_TXT], TheWindow, NIL);
- end;
-
- G_LV : Begin
- detachobjectList;
- CurrentOrd := msgCode;
- if currentord < 0 then currentord := 0;
- if (CurrentOrd>ListViewRows-(ListViewRows div 2)) then
- currenttop := CurrentOrd+(ListViewRows div 2)-ListViewRows
- else currenttop := 0;
- CurrentNode := pMyNode(CurrentList^.lh_Head);
- For i := 1 to currentord do
- CurrentNode := pMyNode(CurrentNode^.LSK_Node.ln_Succ);
-
- DisableObjectGadgets(False_);
- TxtInGads(currentnode);
- attachobjectList;
- end;
-
- G_IK_ACROS : Begin
- CD.cd_Across := Strinfo^.Longint_;
- if CD.cd_Across <= 0 then begin
- CD.cd_Across := 1;
- DisplayBeep(NIL);
- Tags[0].ti_Tag := GTIN_Number;
- Tags[0].ti_Data := CD.cd_Across;
- Tags[1].ti_Tag := TAG_DONE;
- GT_SetGadgetAttrsA(gads[G_IK_ACROS], TheWindow, NIL, @Tags);
- end;
- CD.cd_Down := calcdown(CD.cd_Across);
- end;
-
- G_B_FONT : begin
- wl := rtLockWindow(TheWindow);
- if AslRequest(fr, NIL) then begin
- CD.cd_Font := fr^.fo_Attr;
- end;
- UpDateFont;
- tl := rtUnLockWindow(TheWindow, pointer(wl));
- end;
-
- G_S_SCRID : CD.cd_ModeID := GetSCRID;
-
- G_B_PALREQ : GetPal;
-
- G_B_TITREQ : GetTitles;
-
- G_B_INFO : begin
- wl := rtLockWindow(TheWindow);
- OKRes := ThirdGenAn(TheWindow^.LeftEdge+6, TheWindow^.TopEdge+sizes[TBS]);
- tl := rtUnLockWindow(TheWindow, pointer(wl));
- end;
-
- G_B_CMDREQ : Begin
- wl := rtLockWindow(TheWindow);
- if AslRequest(cr, NIL) then begin
- cdir := retrievestr(cr^.rf_Dir);
-
- (* have to bo this because FExpand & ChDir an' a' them
- hang the machine *)
-
- if not (cdir[length(cdir)] = ':') then
- if not (cdir[length(cdir)] = '/') then
- cdir := cdir + '/';
- cfile := retrievestr(cr^.rf_file);
- filename := cdir + cfile;
- filename := FExpand(filename);
- Tags[0].ti_Tag := GTST_String;
- Tags[0].ti_Data := LONG(CstrConstPtrAR(@RememberKey, filename));
- Tags[1].ti_Tag := TAG_END;
- GT_SetGadgetAttrsA(gads[G_S_CMD], TheWindow, NIL, @Tags);
- CurrentNode^.LSK_Cmd := filename+#0;
- end;
- tl := rtUnLockWindow(TheWindow, pointer(wl));
- end;
-
- End; (*case*)
- end;
- End; (*case*)
-
- Until message = NIL;
- End; (*while*)
- FreeAslRequest(fr);
- FreeAslRequest(lr);
- FreeAslRequest(sr);
- End;
-
- (* ===================================================================== *)
-
- (*
- * Main Procedure
- *)
-
- Procedure main;
-
- Begin
- IntuitionBase := pIntuitionBase(OpenLibrary('intuition.library',34));
- if IntuitionBase = NIL then halt(122);
- If IntuitionBase^.LibNode.lib_Version > 36 Then begin
- UtilityBase := Openlibrary('utility.library',36);
- If UtilityBase <> NIL Then begin
- GadToolsBase := Openlibrary('gadtools.library',36);
- If GadToolsBase <> NIL Then begin
- AslBase := Openlibrary('asl.library',36);
- If AslBase <> NIL Then begin
- ReqToolsBase := pReqToolsBase(OpenLibrary(REQTOOLSNAME,REQTOOLSVERSION));
- If ReqToolsBase <> NIL Then begin
- GfxBase := pGfxBase(OpenLibrary('graphics.library',34));
- If ReqToolsBase <> NIL Then begin
-
- CurrentList := AllocRemember(@RememberKey, sizeof(tList), MEMF_CLEAR);
- if currentlist = NIL then ErrExit('Failed to allocate list memory'#0, 0);
-
- CD.cd_Font.ta_Name := CstrConstPtrAR(@RememberKey, 'topaz.font');
- CD.cd_Font.ta_YSize := 8;
- CD.cd_Font.ta_Style := FS_NORMAL;
- CD.cd_Font.ta_Flags := FPF_ROMFONT;
- CD.cd_ModeID := DEFAULT_MONITOR_ID | HIRES_KEY;
- CD.cd_Across := 1;
- CD.cd_Down := 1;
- CD.cd_ScrTit := 'Startup-Menu ©Lee Kindness'#0;
- CD.cd_WinTit := 'Pick One...'#0;
- CD.cd_Pal[0] := $AAA;
- CD.cd_Pal[1] := $000;
- CD.cd_Pal[2] := $FFF;
- CD.cd_Pal[3] := $CB4;
-
- if NOT ReadConfigFile(PREFSDIRH+PREFSNAME) then
- newlist(currentlist);
- CurrentNode := NIL;
-
- Open_Window;
- UpDateAcDown;
- HandleIDCMP;
- Close_window;
- FreeRemember(@RememberKey, True);
- CloseLibrary (pLibrary(GfxBase));
- end else ErrExit('graphics library v36 (2.0) required'#0, 122);
- CloseLibrary (pLibrary(ReqToolsBase));
- end else ErrExit('Reqtools library v36 (2.0) required'#0, 122);
- CloseLibrary(pLibrary(AslBase));
- end else ErrExit('asl library v36 (2.0) required'#0, 122);
- CloseLibrary(pLibrary(GadToolsBase));
- end else ErrExit('GadTools library v36 (2.0) required'#0, 122);
- CloseLibrary(pLibrary(UtilityBase));
- end else ErrExit('Utility library v36 (2.0) required'#0, 122);
- CloseLibrary(pLibrary(IntuitionBase));
- end else ErrExit('Intuition library v36 (2.0) required - Upgrade'#0, 122);
- end;
-
- (* ===================================================================== *)
- begin main end.
- (* ===================================================================== *)