home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 4 / FreshFish_May-June1994.bin / new / amigalibdisks / d996 / startup-menu / source / smprefs / main.pas < prev    next >
Pascal/Delphi Source File  |  1994-04-05  |  24KB  |  683 lines
  1. (* SMPrefs. Creates a data file which is stored
  2.  * in S: which holds the description of gadgets required on the menu.
  3.  * Lee Kindness Jan '94 HSP source.
  4.  * v1.00
  5.  *)
  6.   
  7. Program SMPrefs(input, output);
  8.  
  9. Uses Exec, Intuition, utility, gadtools, graphics, DiskFont, 
  10.         ASL, AmigaDOS, LSKExtras, Amiga, IFFParse, DOS, ReqTools;
  11.  
  12. (*$I SMEditor.h *)
  13. (*$I Config.PAS *)
  14. (*$I List.PAS   *)
  15. (*$I Window.PAS *)
  16.        
  17.  
  18. (* ===================================================================== *)
  19.  
  20. Procedure Close_Window;
  21.  
  22. Begin
  23.    CloseWindow(TheWindow);       (* close window and free gadgets and *)
  24.    FreeGadgets(gads[G_NI]);      (* visualinfo                        *)
  25.    FreeVisualInfo(vi);
  26. End;
  27.  
  28. (* ===================================================================== *)
  29.  
  30. Procedure GetTitles;
  31. VAR
  32.     buffer: Pointer;
  33.     values: argarray;
  34.     ret   : Long;
  35.     tags  : array [0..4] of tTagItem;
  36.     
  37. begin
  38.     wl := rtLockWindow(TheWindow);
  39.     tags[0].ti_Tag  := RT_Window;
  40.     tags[0].ti_Data := LONG(TheWindow);
  41.     tags[1].ti_Tag  := RTGS_TextFmt;
  42.     tags[1].ti_Data := LONG(CStrConstPtr('Enter the text to be displayed'+#10+' on the screen titlebar.'));
  43.     tags[2].ti_Tag  := RTGS_FLAGS;
  44.     tags[2].ti_Data := GSREQF_CENTERTEXT;
  45.     tags[3].ti_Tag  := TAG_END;
  46.     
  47.     buffer := @CD.cd_ScrTit[1];
  48.     ret:=rtGetStringA (buffer, 127, 'SMPrefs', NIL, @tags);
  49.     values[0]:=LongInt(buffer);
  50.     if ret <> 0 then
  51.         CD.cd_ScrTit := retrievestr(Pointer(values[0])) + #0;
  52.     
  53.     buffer := @CD.cd_WinTit[1];
  54.     tags[1].ti_Data := LONG(CStrConstPtr('Enter the text to be displayed'+#10+' on the window titlebar.'));
  55.     ret:=rtGetStringA (buffer, 127, 'SMPrefs', NIL, @tags);
  56.     values[0] := LongInt(buffer);
  57.     if ret <> 0 then 
  58.         CD.cd_WinTit := retrievestr(Pointer(values[0])) + #0;
  59.     tl := rtUnLockWindow(TheWindow, pointer(wl));
  60. end;
  61.  
  62. (* ===================================================================== *)
  63.  
  64. Procedure GetPal;
  65.  
  66. CONST
  67.     MyPens : Array[0..8] of Word = ($FFFF); (* Get default *)
  68.     
  69. VAR
  70.     result : Long;
  71.     tags : array [0..10] of tTagItem;
  72.     TheScreen : pScreen;
  73.     win : pWindow;
  74.     ok : boolean;
  75.     MyTextFont : pTextFont;
  76.     
  77. begin
  78.     wl := rtLockWindow(TheWindow);
  79.     
  80.     DiskFontBase  := Openlibrary('diskfont.library',36); 
  81.    If DiskFontBase <> NIL Then begin
  82.         MyTextFont := OpenDiskFont(@CD.cd_Font);
  83.         CloseLibrary(pLibrary(DiskFontBase));
  84.     end;
  85.     
  86.     tags[0].ti_Tag  := SA_Type;
  87.    tags[0].ti_Data := CUSTOMSCREEN;
  88.    tags[1].ti_Tag  := SA_Title;
  89.    tags[1].ti_Data := LONG(CStrConstPtr('Change the palette'));
  90.    tags[2].ti_Tag  := SA_OverScan;
  91.    tags[2].ti_Data := OSCAN_TEXT;
  92.    tags[3].ti_Tag  := SA_Depth;
  93.    tags[3].ti_Data := 2;
  94.    tags[4].ti_Tag  := SA_Font;
  95.    tags[4].ti_Data := LONG(@CD.cd_Font);
  96.    tags[5].ti_Tag  := SA_DisplayID;
  97.    tags[5].ti_Data := CD.cd_ModeID; 
  98.    tags[6].ti_Tag  := SA_Width;
  99.    tags[6].ti_Data := STDSCREENWIDTH;
  100.    tags[7].ti_Tag  := SA_Height;
  101.    tags[7].ti_Data := STDSCREENHEIGHT;
  102.    tags[8].ti_Tag  := SA_Pens;
  103.    tags[8].ti_Data := LONG(@MyPens);
  104.    tags[9].ti_Tag  := SA_Colors;
  105.    tags[9].ti_Data := LONG(NIL);
  106.    tags[10].ti_Tag  := TAG_END;
  107.    
  108.    TheScreen := OpenScreenTagList(NIL, @tags);
  109.    IF TheScreen <> NIL then begin
  110.        LoadRGB4(@TheScreen^.ViewPort, @CD.cd_Pal[0], 4);
  111.        tags[0].ti_Tag  := RT_Screen;
  112.         tags[0].ti_Data := LONG(TheScreen);
  113.         tags[1].ti_Tag  := TAG_END;
  114.             
  115.         result := rtPaletteRequestA ('Change palette', NIL, @tags);
  116.         if result <> -1 then begin
  117.             CD.cd_Pal[0] := GetRGB4(TheScreen^.ViewPort.ColorMap,0);
  118.             CD.cd_Pal[1] := GetRGB4(TheScreen^.ViewPort.ColorMap,1);
  119.             CD.cd_Pal[2] := GetRGB4(TheScreen^.ViewPort.ColorMap,2);
  120.             CD.cd_Pal[3] := GetRGB4(TheScreen^.ViewPort.ColorMap,3);
  121.         end;
  122.         ok := CloseScreen(TheScreen);
  123.    end;
  124.    tl := rtUnLockWindow(TheWindow, pointer(wl));
  125. end;
  126.  
  127.  
  128.         
  129. (* ===================================================================== *)
  130.  
  131. Function GetSCRID : LongInt;      (* Use Reqtools to get ModeID *)
  132. VAR
  133.     scrnreq: prtScreenModeRequester;
  134.     Value : Longint;
  135.     ret : longint;
  136.     mytag : Array[0..3] of tTagItem;
  137.     
  138. Begin
  139.     wl := rtLockWindow(TheWindow);
  140.     scrnreq := Pointer(rtAllocRequestA (RT_SCREENMODEREQ, NIL));
  141.     if (scrnreq<>NIL) then begin
  142.         scrnreq^.DisplayID := CD.cd_ModeID;
  143.         mytag[0].ti_Tag:=RTSC_Flags;
  144.         mytag[0].ti_Data:= 0;
  145.         mytag[1].ti_Tag:=RT_UnderScore;
  146.         mytag[1].ti_Data:=LongInt('_');
  147.         mytag[2].ti_Tag := RT_Window;
  148.         mytag[2].ti_Data := LONG(TheWindow);
  149.         mytag[3].ti_Tag:=TAG_END;
  150.  
  151.         ret:=rtScreenModeRequestA ( scrnreq, 'Pick a screenmode', @mytag);
  152.         value :=LongInt(scrnreq^.DisplayID);
  153.     end ;
  154.     ret:=rtFreeRequest (scrnreq);
  155.     GetSCRID := value;
  156.     tl := rtUnLockWindow(TheWindow, pointer(wl));
  157. end;            
  158.  
  159. (* ===================================================================== *)
  160.  
  161. Procedure HandleIDCMP;
  162.  
  163. Type
  164.     strarray = Array[1..3] Of string;
  165.     Tag2     = Array[0..8] Of tTagItem;
  166.     
  167. Const
  168.    exitflag : Boolean  = False; 
  169.    small    : Boolean  = False;
  170.    NumStrs  : shortint = 3;
  171.    
  172. Var 
  173.     dummy, dum, ret : longint;      (* the main loop of the program. *)
  174.     Tags       : tag2;              (* monitors IDCMP messages and   *)
  175.    message    : pIntuiMessage;     (* responds as appropriate       *)
  176.    MsgClass   : LongInt;
  177.    MsgCode    : Word;
  178.    gadcode    : pGadget;
  179.    StrInfo    : pStringInfo;
  180.    tempint    : Array[1..4] Of longint;
  181.    OKRes      : boolean;
  182.     i, cnt     : Longint;
  183.     tmpstr     : string;
  184.     fr         : pFontRequester;
  185.     lr, sr, cr : pFileRequester;
  186.     cfile      : PathStr;
  187.     cdir       : DirStr;
  188.  
  189. Procedure TxtInGads(curnode : pMyNode);
  190.  
  191. begin
  192.     Tags[0].ti_Tag  := GTST_String;
  193.     Tags[0].ti_Data := LONG(@currentnode^.LSK_Name[1]);
  194.     Tags[1].ti_Tag  := TAG_END;
  195.     GT_SetGadgetAttrsA(gads[G_S_TXT], TheWindow, NIL, @Tags);
  196.  
  197.     Tags[0].ti_Tag  := GTST_String;
  198.     Tags[0].ti_Data := LONG(@currentnode^.LSK_Cmd[1]);
  199.     Tags[1].ti_Tag  := TAG_END;
  200.     GT_SetGadgetAttrsA(gads[G_S_CMD], TheWindow, NIL, @Tags);
  201.  
  202.     Tags[0].ti_Tag  := GTST_String;
  203.     Tags[0].ti_Data := LONG(@currentnode^.LSK_Key[1]);
  204.     Tags[1].ti_Tag  := TAG_END;
  205.     GT_SetGadgetAttrsA(gads[G_S_KEY], TheWindow, NIL, @Tags);
  206. end;
  207.  
  208. Begin
  209.     Tags[0].ti_Tag  := ASL_Hail;
  210.     Tags[0].ti_Data := LONG(CstrConstPtrAR(@RememberKey, 'Pick a font'));
  211.       Tags[1].ti_Tag  := ASL_FontName;
  212.     Tags[1].ti_Data := LONG(CD.cd_Font.ta_Name);
  213.     Tags[2].ti_Tag  := ASL_FontHeight;
  214.     Tags[2].ti_Data := long(CD.cd_Font.ta_YSize);
  215.     Tags[3].ti_Tag  := ASL_MinHeight;
  216.     Tags[3].ti_Data := 6;
  217.     Tags[4].ti_Tag  := ASL_MaxHeight;
  218.     Tags[4].ti_Data := 30;
  219.     Tags[5].ti_Tag  := ASL_FuncFlags;
  220.     Tags[5].ti_Data := FONF_STYLES;
  221.     Tags[6].ti_Tag  := ASL_Window;
  222.     Tags[6].ti_Data := long(TheWindow);
  223.     Tags[7].ti_Tag  := ASL_FontStyles;
  224.     Tags[7].ti_Data := long(CD.cd_Font.ta_Style);
  225.     Tags[8].ti_Tag  := TAG_DONE;
  226.  
  227.  
  228.     fr := AllocASLRequest(ASL_FontRequest, @Tags[0]);
  229.     
  230.     Tags[0].ti_Tag  := ASL_Hail;
  231.     Tags[0].ti_Data := LONG(CstrConstPtrAR(@RememberKey, 'Locate the prefs file'));
  232.     Tags[1].ti_Tag  := ASL_File;
  233.     Tags[1].ti_Data := LONG(@PREFSNAME[1]);
  234.     Tags[2].ti_Tag  := ASL_Dir;
  235.     Tags[2].ti_Data := long(@PREFSDIRH[1]);
  236.     Tags[3].ti_Tag  := ASL_Window;
  237.     Tags[3].ti_Data := long(TheWindow);
  238.     Tags[4].ti_Tag  := ASL_FuncFlags;
  239.     Tags[4].ti_Data := 0;
  240.     Tags[5].ti_Tag  := ASL_Pattern;
  241.     Tags[5].ti_Data := LONG(CstrConstPtrAR(@RememberKey, '#?.prefs'));
  242.     Tags[6].ti_Tag  := TAG_DONE;
  243.  
  244.     lr := AllocASLRequest(ASL_FileRequest, @Tags[0]);
  245.  
  246.     Tags[0].ti_Tag  := ASL_Hail;
  247.     Tags[0].ti_Data := LONG(CstrConstPtrAR(@RememberKey, 'Pick Command'));
  248.     Tags[1].ti_Tag  := ASL_Window;
  249.     Tags[1].ti_Data := long(TheWindow);
  250.     Tags[2].ti_Tag  := ASL_FuncFlags;
  251.     Tags[2].ti_Data := 0;
  252.     Tags[3].ti_Tag  := ASL_Pattern;
  253.     Tags[3].ti_Data := LONG(CstrConstPtrAR(@RememberKey, '~(#?.info)'));
  254.     Tags[4].ti_Tag  := ASL_Dir;
  255.     Tags[4].ti_Data := long(CstrConstPtrAR(@RememberKey, 'SYS:'));
  256.     Tags[5].ti_Tag  := TAG_DONE;
  257.  
  258.     cr := AllocASLRequest(ASL_FileRequest, @Tags[0]);
  259.     
  260.     Tags[0].ti_Tag  := ASL_Hail;
  261.     Tags[0].ti_Data := LONG(CstrConstPtrAR(@RememberKey, 'Save prefs file as'));
  262.     Tags[1].ti_Tag  := ASL_File;
  263.     Tags[1].ti_Data := LONG(@PREFSNAME[1]);
  264.     Tags[2].ti_Tag  := ASL_Dir;
  265.     Tags[2].ti_Data := long(@PREFSDIRH[1]);
  266.     Tags[3].ti_Tag  := ASL_Window;
  267.     Tags[3].ti_Data := long(TheWindow);
  268.     Tags[4].ti_Tag  := ASL_FuncFlags;
  269.     Tags[4].ti_Data := FILF_SAVE;
  270.     Tags[5].ti_Tag  := ASL_Pattern;
  271.     Tags[5].ti_Data := LONG(CstrConstPtrAR(@R