home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 230.lha / SPY / Sources / IntuiCommon.Mod < prev    next >
Text File  |  1989-04-08  |  11KB  |  358 lines
  1. IMPLEMENTATION MODULE IntuiCommon;
  2.  
  3.               (* * * * * * * * * * * * * * * * * * * * * * *)
  4.               (* Common Intuition-related routines.        *)
  5.           (* Originally written for the TDI package,   *)
  6.           (* but was quickly modified for the Oxxi     *)
  7.           (* compiler.                                 *)
  8.               (*                                           *)
  9.           (* (c) Copyright 1987 by Steve Faiwiszewski. *)
  10.           (* This program may be freely distributed,   *)
  11.           (* but it is not to be sold.                 *)
  12.           (* Please leave this notice intact.          *)
  13.               (* * * * * * * * * * * * * * * * * * * * * * *)
  14.  
  15. FROM Termination IMPORT AddTerminator;
  16. FROM Conversions IMPORT ConvStringToNumber;
  17. FROM Strings    IMPORT StringLength;
  18. FROM Rasters    IMPORT DrawModeSet;
  19. FROM Views    IMPORT ViewModesSet, Hires, Lace, LoadRGB4;
  20. FROM Intuition  IMPORT Border, BorderPtr, Gadget, GadgetPtr,
  21.                GadgetFlagsSet, CustomScreen,
  22.                 GadgetActivationSet, WBenchScreen,
  23.                GadgetMutualExcludeSet,
  24.                GadgetTypeSet, IDCMPFlagsSet,
  25.                WindowPtr, ScreenPtr, NewWindow,
  26.                NewScreen, ShowTitle,
  27.                WindowFlagsSet, OpenWindow, OpenScreen,
  28.                        Requester, IntuiText, MenuEnabled,
  29.                MenuItemMutualExcludeSet, HighComp,
  30.                        IntuiTextPtr, Menu, MenuPtr, MenuItem,
  31.                        MenuItemPtr, MenuFlagsSet, CommSeq,
  32.                        MenuItemFlagsSet, ItemText, ItemEnabled,
  33.                RememberPtr, AllocRemember,
  34.                FreeRemember, InitRequester;
  35. FROM Memory     IMPORT MemReqSet, MemChip, MemPublic;
  36. FROM SYSTEM     IMPORT BYTE, ADDRESS, ADR, TSIZE;
  37.  
  38.  
  39. PROCEDURE ReleaseAllocations;
  40. BEGIN
  41.     FreeRemember(RKey, TRUE);
  42. END ReleaseAllocations;
  43.  
  44. PROCEDURE InitMenuRec (VAR Amenu : Menu;
  45.                        left, top, width, height : INTEGER;
  46.                        text : ADDRESS) : MenuPtr;
  47. (* Initialize a menu record.        *)
  48. BEGIN
  49.     WITH Amenu DO
  50.       NextMenu := NIL;
  51.       LeftEdge := left;   TopEdge := top;
  52.       Width := width;     Height := height;
  53.       Flags := MenuFlagsSet{MenuEnabled};
  54.       MenuName := text;
  55.       FirstItem := NIL
  56.     END;
  57.     RETURN (ADR(Amenu))
  58. END InitMenuRec;
  59.  
  60. PROCEDURE InitItemRec (VAR mi : MenuItem;
  61.                        left, top,
  62.                width, height : INTEGER;
  63.                        Cmd : CHAR;
  64.                ItemFillPtr : ADDRESS) : MenuItemPtr;
  65. (* Initialize an item record.       *)
  66. BEGIN
  67.     WITH mi DO
  68.     NextItem := NIL;
  69.     LeftEdge := left;
  70.     TopEdge := top;
  71.     Width := width;
  72.     Height := height;
  73.     Flags :=
  74.         MenuItemFlagsSet{ItemText, ItemEnabled} + HighComp;
  75.     MutualExclude :=  MenuItemMutualExcludeSet{};
  76.     ItemFill := ItemFillPtr;
  77.     SelectFill := NIL;
  78.     Command := BYTE(Cmd);
  79.     IF Cmd <> 0C THEN
  80.         Flags := Flags + MenuItemFlagsSet{CommSeq}
  81.     END;
  82.     SubItem := NIL;
  83.     NextSelect := 0;
  84.     END;
  85.     RETURN(ADR(mi))
  86. END InitItemRec;
  87.  
  88. PROCEDURE InitTextRec (VAR it : IntuiText;
  89.                        left, top : INTEGER;
  90.                        front, back : BYTE;
  91.                Mode : DrawModeSet;
  92.                        text : ADDRESS) : IntuiTextPtr;
  93. (* Initialize menu text record.     *)
  94. BEGIN
  95.     WITH it DO
  96.     FrontPen := front;
  97.         BackPen := back;
  98.     LeftEdge := left;
  99.     TopEdge := top;
  100.     DrawMode := Mode;
  101.     ITextFont := NIL;
  102.     IText := text;
  103.     NextText := NIL
  104.     END;
  105.     RETURN(ADR(it));
  106. END InitTextRec;
  107.  
  108. PROCEDURE InitBorder(VAR border : Border;
  109.                      Left, Top : INTEGER;
  110.                      Front, Back,
  111.                      count : BYTE;
  112.              Mode : DrawModeSet;
  113.                      Coords : ADDRESS;
  114.                      Next : BorderPtr);
  115. BEGIN
  116.     WITH border DO
  117.     LeftEdge := Left;
  118.     TopEdge := Top;
  119.     FrontPen := Front;
  120.     BackPen := Back;
  121.     DrawMode := Mode;
  122.     Count := count;
  123.     XY := Coords;
  124.     NextBorder := Next;
  125.     END;
  126. END InitBorder;
  127.  
  128.                      
  129. PROCEDURE InitGadget(VAR gadget : Gadget;
  130.                       Left, Top : INTEGER;
  131.                       width, height : INTEGER;
  132.                       flags : GadgetFlagsSet;
  133.                       Activate : GadgetActivationSet;
  134.                       Type : GadgetTypeSet;
  135.                       Render : ADDRESS;
  136.                       Select : ADDRESS;
  137.                       Special: ADDRESS;
  138.                       ID     : CARDINAL;
  139.                       User   : ADDRESS;
  140.                       Text   : IntuiTextPtr) : GadgetPtr;
  141. BEGIN                 
  142.     WITH gadget DO
  143.     NextGadget := NIL;
  144.     LeftEdge := Left;
  145.     TopEdge := Top;
  146.     Width := width; Height := height;
  147.     Flags := flags;
  148.     Activation := Activate;
  149.     GadgetType := Type;
  150.     GadgetRender := Render;
  151.     SelectRender := Select;
  152.     GadgetText := Text;
  153.     MutualExclude := GadgetMutualExcludeSet{};
  154.     SpecialInfo := Special;
  155.     GadgetID := ID; UserData := User
  156.     END;
  157.     RETURN(ADR(gadget));
  158. END InitGadget;
  159.  
  160. PROCEDURE InitReq(VAR requester : Requester;
  161.                   Left, Top : INTEGER;
  162.                   width, height : INTEGER;
  163.                   gadget : GadgetPtr;
  164.                   border : BorderPtr;
  165.                   Text   : IntuiTextPtr;
  166.                   Fill   : BYTE);
  167. BEGIN             
  168.     InitRequester(requester);
  169.     WITH requester DO
  170.     LeftEdge := Left;
  171.     TopEdge := Top;
  172.     Width := width;
  173.     Height := height;
  174.     ReqGadget := gadget;
  175.     ReqText := Text;
  176.     ReqBorder := border;
  177.         BackFill := Fill;
  178.     END;
  179. END InitReq;
  180.  
  181. PROCEDURE InitCoordEntry(VAR coords : ARRAY OF CoordinateType;
  182.                          offset : CARDINAL;
  183.                          left, top : INTEGER);
  184. BEGIN
  185.     WITH coords[offset] DO Left := left; Top := top  END;
  186. END InitCoordEntry;
  187.  
  188. PROCEDURE SetUpSimpleBorder(VAR Coords: ARRAY OF CoordinateType;
  189.                 GadWidth, GadHeight : CARDINAL;
  190.                 VAR border : Border;
  191.                 Left, Top : INTEGER;
  192.                 Front, Back,
  193.                 count : BYTE;
  194.                 Mode : DrawModeSet;
  195.                 NextBorder : BorderPtr);
  196. BEGIN
  197.     InitCoordEntry(Coords,0,0,0);
  198.     InitCoordEntry(Coords,1,GadWidth+1,0);
  199.     InitCoordEntry(Coords,2,GadWidth+1,GadHeight+1);
  200.     InitCoordEntry(Coords,3,0,GadHeight+1);
  201.     InitCoordEntry(Coords,4,0,0);
  202.     InitBorder(border,Left,Top,Front,Back,count,Mode,
  203.         ADR(Coords),NIL);
  204. END SetUpSimpleBorder;
  205.  
  206. PROCEDURE AllocateStandardBorder(Width, Height : CARDINAL;
  207.                          Front, Back : BYTE;
  208.              Mode : DrawModeSet): BorderPtr;
  209. VAR
  210.     BorderP : BorderPtr;
  211.     CoordPtr: POINTER TO StandardCoordType;
  212. BEGIN
  213.     CoordPtr := AllocRemember(RKey, TSIZE(StandardCoordType),
  214.                      MemReqSet{});
  215.     BorderP := AllocRemember(RKey, TSIZE(Border), MemReqSet{});
  216.     SetUpSimpleBorder(CoordPtr^,Width,Height,
  217.                  BorderP^,-1,-1,Front,Back,BYTE(5),Mode,NIL);
  218.     RETURN(BorderP);             
  219. END AllocateStandardBorder;                      
  220.  
  221. PROCEDURE AllocateReqBorder(Width, Height : CARDINAL;
  222.                          Front, Back : BYTE;
  223.              Mode : DrawModeSet): BorderPtr;
  224. VAR
  225.     BorderP : BorderPtr;
  226.     CoordPtr: POINTER TO StandardCoordType;
  227. BEGIN
  228.     CoordPtr := AllocRemember(RKey, TSIZE(StandardCoordType), 
  229.                      MemReqSet{});
  230.     BorderP := AllocRemember(RKey, TSIZE(Border), MemReqSet{});
  231.     SetUpSimpleBorder(CoordPtr^,Width-2,Height-2,
  232.                  BorderP^,0,0,Front,Back,BYTE(5),Mode,NIL);
  233.     RETURN(BorderP);             
  234. END AllocateReqBorder;                   
  235.  
  236. PROCEDURE AddGadgetToList(VAR GadList : GadgetPtr;
  237.                           Left, Top : INTEGER;
  238.                           width, height : INTEGER;
  239.                           flags : GadgetFlagsSet;
  240.                           Activate : GadgetActivationSet;
  241.                           Type : GadgetTypeSet;
  242.                           Render : ADDRESS;
  243.                           Select : ADDRESS;
  244.                           Special: ADDRESS;
  245.                           ID     : CARDINAL;
  246.                           User   : ADDRESS;
  247.                           Text   : IntuiTextPtr) : GadgetPtr;
  248. VAR
  249.     GadP, tmp : GadgetPtr;
  250. BEGIN
  251.     GadP := AllocRemember(RKey, TSIZE(Gadget), MemReqSet{});
  252.     tmp := InitGadget(GadP^, Left, Top, width, height, flags,
  253.          Activate, Type, Render, Select, Special, ID,
  254.          User, Text);
  255.     GadP^.NextGadget := GadList;
  256.     GadList := GadP;
  257.     RETURN(GadP);                
  258. END AddGadgetToList;
  259.  
  260. PROCEDURE OpenSimpleScreen(width,height,depth : CARDINAL;
  261.                        modeset : ViewModesSet;
  262.                Title : ADDRESS) : ScreenPtr;
  263. VAR
  264.     newScr      : NewScreen;
  265.     MyScreen    : ScreenPtr;
  266. BEGIN
  267.     WITH newScr DO
  268.         LeftEdge := 0;
  269.         TopEdge := 0;
  270.         Width := width;
  271.         Height := height;
  272.         Depth := depth;
  273.         DetailPen := BYTE(0);
  274.         BlockPen := BYTE(1);
  275.     ViewModes := modeset;
  276.         IF width > 320 THEN
  277.             INCL(ViewModes,Hires)
  278.         END;
  279.     IF height > 200 THEN
  280.         INCL(ViewModes,Lace)
  281.     END;
  282.         Font := NIL;
  283.         DefaultTitle := Title;
  284.         Gadgets := NIL;
  285.         CustomBitMap := NIL;
  286.     Type := CustomScreen;
  287.     END;
  288.     MyScreen := (OpenScreen(newScr));
  289.     IF Title = NIL THEN
  290.         ShowTitle(MyScreen^,FALSE);
  291.     END;
  292.     RETURN MyScreen
  293. END OpenSimpleScreen;
  294.  
  295. PROCEDURE OpenSimpleWindow(width,height,left,top : CARDINAL;
  296.             title : ADDRESS;
  297.             flags : WindowFlagsSet;
  298.             idcmpflags : IDCMPFlagsSet;
  299.             gadget : GadgetPtr;
  300.             screen : ScreenPtr) : WindowPtr;
  301. VAR
  302.     MyNewWindow : NewWindow;
  303. BEGIN
  304.     WITH MyNewWindow DO
  305.         LeftEdge := left;
  306.         TopEdge := top;
  307.         Height := height;
  308.         Width := width;
  309.         DetailPen := BYTE (0);
  310.         BlockPen := BYTE (1);
  311.         Title := title;
  312.         Flags := flags;
  313.         IDCMPFlags := idcmpflags;
  314.         CheckMark := NIL;
  315.         FirstGadget := gadget;
  316.     IF screen <> NIL THEN
  317.         Type := CustomScreen;
  318.         Screen := screen;
  319.     ELSE
  320.         Type := WBenchScreen;
  321.     END;
  322.         BitMap := NIL;
  323.         MinWidth := 0; MinHeight := 0;
  324.         MaxWidth := 0; MaxHeight := 0;
  325.     END;
  326.     (* Now open the window *)
  327.     RETURN OpenWindow(MyNewWindow);
  328. END OpenSimpleWindow;
  329.  
  330. PROCEDURE SetScreenColors(screen : ScreenPtr;
  331.               data : ARRAY OF CHAR);
  332. VAR
  333.     size,
  334.     i,j   : CARDINAL;
  335.     table : ARRAY[0..31] OF CARDINAL;
  336.     str      : ARRAY[0..3] OF CHAR;
  337.     succ  : BOOLEAN;
  338.     temp  : LONGCARD;
  339. BEGIN
  340.     i := StringLength(data);
  341.     size := i DIV 4;
  342.     IF (i MOD 4) <> 0 THEN INC(size) END;
  343.     FOR i := 0 TO size - 1 DO
  344.     FOR j := 0 TO 2 DO
  345.        str[j] := data[(i*4)+j];
  346.     END;
  347.     str[3] := 0C;
  348.     succ := ConvStringToNumber(str,temp,FALSE,16);
  349.     table[i] := temp;
  350.     END;
  351.     LoadRGB4(screen^.ViewPort,ADR(table),size);
  352. END SetScreenColors;
  353.  
  354. BEGIN
  355.     RKey := NIL;
  356.     AddTerminator(ReleaseAllocations);
  357. END IntuiCommon.
  358.