home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 079.lha / SpiroGraph / IntuiCommon.Mod < prev    next >
Encoding:
Modula Implementation  |  1986-11-20  |  8.0 KB  |  234 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 Rasters   IMPORT DrawModeSet;
  16. FROM Intuition  IMPORT Border, BorderPtr, Gadget, GadgetPtr, GadgetFlagsSet,
  17.                 GadgetActivationSet, GadgetMutualExcludeSet,
  18.                GadgetTypeSet,
  19.                        Requester, IntuiText, MenuItemMutualExcludeSet,
  20.                        IntuiTextPtr, Menu, MenuPtr, MenuItem, 
  21.                        MenuItemPtr, MenuFlagsSet, CommSeq, MenuEnabled,
  22.                        MenuItemFlagsSet, ItemText, ItemEnabled, HighComp,
  23.                RememberPtr, AllocRemember, FreeRemember, InitRequester;
  24. FROM Memory IMPORT MemReqSet, MemChip, MemPublic;
  25. FROM SYSTEM     IMPORT BYTE, ADDRESS, ADR, TSIZE;
  26.  
  27.  
  28. PROCEDURE ReleaseAllocations;
  29. BEGIN
  30.     FreeRemember(RKey, TRUE);
  31. END ReleaseAllocations;
  32.  
  33. PROCEDURE InitMenuRec (VAR Amenu : Menu;
  34.                        left, top, width, height : INTEGER;
  35.                        text : ADDRESS) : MenuPtr;
  36. (* Initialize a menu record.        *)
  37. BEGIN
  38.     WITH Amenu DO
  39.       NextMenu := NIL;
  40.       LeftEdge := left;   TopEdge := top;
  41.       Width := width;     Height := height;
  42.       Flags := MenuFlagsSet{MenuEnabled};
  43.       MenuName := text;
  44.       FirstItem := NIL
  45.     END;
  46.     RETURN (ADR(Amenu))
  47. END InitMenuRec;
  48.  
  49. PROCEDURE InitItemRec (VAR mi : MenuItem;
  50.                        left, top, width, height : INTEGER;
  51.                        Cmd : CHAR;  ItemFillPtr : ADDRESS) : MenuItemPtr;
  52. (* Initialize an item record.       *)
  53. BEGIN
  54.     WITH mi DO
  55.       NextItem := NIL;
  56.       LeftEdge := left;   TopEdge := top;
  57.       Width := width;     Height := height;
  58.       Flags := MenuItemFlagsSet{ItemText, ItemEnabled} + HighComp;
  59.       MutualExclude :=  MenuItemMutualExcludeSet{};
  60.       ItemFill := ItemFillPtr;
  61.       SelectFill := NIL;
  62.       Command := BYTE(Cmd);
  63.       IF Cmd <> 0C THEN Flags := Flags + MenuItemFlagsSet{CommSeq} END;
  64.       SubItem := NIL;
  65.       NextSelect := 0;
  66.     END;
  67.     RETURN(ADR(mi))
  68. END InitItemRec;
  69.  
  70. PROCEDURE InitTextRec (VAR it : IntuiText;
  71.                        left, top : INTEGER;
  72.                        front, back : BYTE;
  73.                Mode : DrawModeSet;
  74.                        text : ADDRESS) : IntuiTextPtr;
  75. (* Initialize menu text record.     *)
  76. BEGIN
  77.     WITH it DO
  78.       FrontPen := front;        BackPen := back;
  79.       LeftEdge := left;         TopEdge := top;
  80.       DrawMode := Mode;
  81.       ITextFont := NIL;
  82.       IText := text;
  83.       NextText := NIL
  84.     END;
  85.     RETURN(ADR(it));
  86. END InitTextRec;
  87.  
  88. PROCEDURE InitBorder(VAR border : Border;
  89.                      Left, Top : INTEGER;
  90.                      Front, Back,
  91.                      count : BYTE;
  92.              Mode : DrawModeSet;
  93.                      Coords : ADDRESS;
  94.                      Next : BorderPtr);
  95. BEGIN
  96.     WITH border DO
  97.       LeftEdge := Left; TopEdge := Top;
  98.       FrontPen := Front; BackPen := Back;
  99.       DrawMode := Mode; Count := count;
  100.       XY := Coords; NextBorder := Next;
  101.     END;
  102. END InitBorder;
  103.  
  104.                      
  105. PROCEDURE InitGadget(VAR gadget : Gadget;
  106.                       Left, Top : INTEGER;
  107.                       width, height : INTEGER;
  108.                       flags : GadgetFlagsSet;
  109.                       Activate : GadgetActivationSet;
  110.                       Type : GadgetTypeSet;
  111.                       Render : ADDRESS;
  112.                       Select : ADDRESS;
  113.                       Special: ADDRESS;
  114.                       ID     : CARDINAL;
  115.                       User   : ADDRESS;
  116.                       Text   : IntuiTextPtr) : GadgetPtr;
  117. BEGIN                 
  118.     WITH gadget DO
  119.       NextGadget := NIL;
  120.       LeftEdge := Left;
  121.       TopEdge := Top;
  122.       Width := width; Height := height;
  123.       Flags := flags;
  124.       Activation := Activate;
  125.       GadgetType := Type;
  126.       GadgetRender := Render;
  127.       SelectRender := Select;
  128.       GadgetText := Text;
  129.       MutualExclude := GadgetMutualExcludeSet{};
  130.       SpecialInfo := Special;
  131.       GadgetID := ID; UserData := User
  132.     END;
  133.     RETURN(ADR(gadget));
  134. END InitGadget;
  135.  
  136. PROCEDURE InitReq(VAR requester : Requester;
  137.                   Left, Top : INTEGER;
  138.                   width, height : INTEGER;
  139.                   gadget : GadgetPtr;
  140.                   border : BorderPtr;
  141.                   Text   : IntuiTextPtr;
  142.                   Fill   : BYTE);
  143. BEGIN             
  144.     InitRequester(requester);
  145.     WITH requester DO
  146.         LeftEdge := Left; TopEdge := Top;
  147.         Width := width;   Height := height;
  148.         ReqGadget := gadget;
  149.         ReqText := Text;
  150.         ReqBorder := border;
  151.         BackFill := Fill;
  152.     END;
  153. END InitReq;
  154.  
  155. PROCEDURE InitCoordEntry(VAR coords : ARRAY OF CoordinateType;
  156.                          offset : CARDINAL;
  157.                          left, top : INTEGER);
  158. BEGIN
  159.     WITH coords[offset] DO Left := left; Top := top  END;
  160. END InitCoordEntry;
  161.  
  162. PROCEDURE SetUpAborder(VAR Coords: ARRAY OF CoordinateType;
  163.                        GadWidth, GadHeight : CARDINAL;
  164.                        VAR border : Border;
  165.                        Left, Top : INTEGER;
  166.                        Front, Back,
  167.                        count : BYTE;
  168.                Mode : DrawModeSet;
  169.                        NextBorder : BorderPtr);
  170. BEGIN
  171.     InitCoordEntry(Coords,0,0,0);
  172.     InitCoordEntry(Coords,1,GadWidth+1,0);
  173.     InitCoordEntry(Coords,2,GadWidth+1,GadHeight+1);
  174.     InitCoordEntry(Coords,3,0,GadHeight+1);
  175.     InitCoordEntry(Coords,4,0,0);
  176.     InitBorder(border,Left,Top,Front,Back,count,Mode,ADR(Coords),NIL);
  177. END SetUpAborder;
  178.  
  179. PROCEDURE AllocateStandardBorder(Width, Height : CARDINAL;
  180.                          Front, Back : BYTE; Mode : DrawModeSet): BorderPtr;
  181.  
  182. VAR
  183.     BorderP : BorderPtr;
  184.     CoordPtr: POINTER TO StandardCoordType;
  185. BEGIN
  186.     CoordPtr := AllocRemember(RKey, TSIZE(StandardCoordType), 
  187.                      MemReqSet{});
  188.     BorderP := AllocRemember(RKey, TSIZE(Border), MemReqSet{});
  189.     SetUpAborder(CoordPtr^,Width,Height,
  190.                  BorderP^,-1,-1,Front,Back,BYTE(5),Mode,NIL);
  191.     RETURN(BorderP);             
  192. END AllocateStandardBorder;                      
  193.  
  194. PROCEDURE AllocateReqBorder(Width, Height : CARDINAL;
  195.                          Front, Back : BYTE; Mode : DrawModeSet): BorderPtr;
  196. VAR
  197.     BorderP : BorderPtr;
  198.     CoordPtr: POINTER TO StandardCoordType;
  199. BEGIN
  200.     CoordPtr := AllocRemember(RKey, TSIZE(StandardCoordType), 
  201.                      MemReqSet{});
  202.     BorderP := AllocRemember(RKey, TSIZE(Border), MemReqSet{});
  203.     SetUpAborder(CoordPtr^,Width-2,Height-2,
  204.                  BorderP^,0,0,Front,Back,BYTE(5),Mode,NIL);
  205.     RETURN(BorderP);             
  206. END AllocateReqBorder;                   
  207.  
  208. PROCEDURE AddGadgetToList(VAR GadList : GadgetPtr;
  209.                           Left, Top : INTEGER;
  210.                           width, height : INTEGER;
  211.                           flags : GadgetFlagsSet;
  212.                           Activate : GadgetActivationSet;
  213.                           Type : GadgetTypeSet;
  214.                           Render : ADDRESS;
  215.                           Select : ADDRESS;
  216.                           Special: ADDRESS;
  217.                           ID     : CARDINAL;
  218.                           User   : ADDRESS;
  219.                           Text   : IntuiTextPtr) : GadgetPtr;
  220. VAR
  221.     GadP, tmp : GadgetPtr;
  222. BEGIN
  223.     GadP := AllocRemember(RKey, TSIZE(Gadget), MemReqSet{});
  224.     tmp := InitGadget(GadP^, Left, Top, width, height, flags, Activate,
  225.                  Type, Render, Select, Special, ID, User, Text);
  226.     GadP^.NextGadget := GadList;
  227.     GadList := GadP;
  228.     RETURN(GadP);                
  229. END AddGadgetToList;
  230.  
  231. BEGIN
  232.     RKey := NIL;
  233. END IntuiCommon.
  234.