home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 093.lha / Chaos / Sources / easymenu.mod < prev    next >
Encoding:
Modula Implementation  |  1986-11-21  |  9.7 KB  |  275 lines
  1. IMPLEMENTATION MODULE EasyMenus;
  2.  
  3. (* EasyMenus.mod 1.0           Mike Scalora            PLink : SCARY
  4.  
  5.    This MODULE is public domain.   Freely distributable as long as this 
  6.    notice stays in.
  7.  
  8.    This program was originally uploaded to PeopleLink's Amiga Zone.  The Amiga
  9.    Zone has well over 2000 members, and a library of thousands of public domain
  10.    files.  If you're interested in joining us, call 800-524-0100 (voice) 
  11.    or 800-826-8855 (modem).    
  12.  
  13.    Modified : 8/7/87 by Richie Bielak
  14.               Adapted for OXXI Modula-2 Compiler.
  15.  
  16. *)
  17.  
  18. FROM Intuition IMPORT IntuiText, IntuiTextPtr, MenuItem,
  19.      MenuItemPtr, Menu, MenuPtr, MenuFlagsSet, MenuFlags,
  20.      MenuItemFlags, MenuItemFlagsSet, HighComp, HighBox, HighNone,
  21.      SetMenuStrip, ClearMenuStrip, MenuItemMutualExcludeSet,
  22.      WindowPtr;
  23. FROM Memory IMPORT AllocMem, FreeMem, MemReqSet, MemPublic;
  24. FROM SYSTEM IMPORT ADR, ADDRESS, BYTE, TSIZE;
  25. FROM Rasters   IMPORT Jam2, Jam1, DrawModeSet;
  26.  
  27. PROCEDURE EasyIntuiText(text : ARRAY OF CHAR; x,y,fc,bc : INTEGER): ADDRESS;
  28.   VAR
  29.     I,J : INTEGER;
  30.     TP : POINTER TO ARRAY [0..1000] OF CHAR;
  31.     IT : IntuiTextPtr;
  32.   BEGIN 
  33.     I := 0; WHILE (I<=INTEGER(HIGH(text))) AND (text[I]#0C) DO INC(I); END;
  34.     TP := AllocMem(LONGCARD(I+1),MemReqSet{MemPublic});
  35.     IF TP=NIL THEN RETURN(NIL); END; 
  36.     TP^[I] := 0C; 
  37.     IF I>0 THEN FOR J := 0 TO I-1 DO TP^[J] := text[J]; END; END;
  38.     IT := AllocMem(LONGCARD(TSIZE(IntuiText)),MemReqSet{MemPublic});
  39.     IF IT=NIL THEN FreeMem(TP,LONGCARD(I+1)); RETURN(NIL); END;
  40.     WITH IT^ DO 
  41.       FrontPen := BYTE(fc); BackPen := BYTE(bc); IText := TP; NextText := NIL;
  42.       DrawMode := DrawModeSet(1); LeftEdge := x; TopEdge := y; ITextFont := NIL;
  43.       IF fc=bc THEN BackPen := BYTE(bc+1); END;
  44.     END; 
  45.     RETURN(IT);
  46.   END EasyIntuiText;
  47.  
  48. PROCEDURE EasyMenuItem( NextItems,SubItems : ADDRESS; 
  49.                         x,y,w,h,mx,select,high,fc,bc : INTEGER;
  50.                         cmd : CHAR; text : ARRAY OF CHAR): ADDRESS;
  51.   VAR 
  52.     MIP : MenuItemPtr; I : INTEGER;
  53.   BEGIN
  54.     MIP := AllocMem(LONGCARD(TSIZE(MenuItem)),MemReqSet{MemPublic});
  55.     IF MIP=NIL THEN RETURN(NIL); END;
  56.     WITH MIP^ DO
  57.       NextItem := NextItems; SubItem := SubItems;
  58.       LeftEdge := x; TopEdge := y; Width := w;
  59.       Height := h; 
  60.       MutualExclude := MenuItemMutualExcludeSet(mx); 
  61.       Command := BYTE(cmd);
  62.       ItemFill := EasyIntuiText(text,2,1,fc,bc); SelectFill := NIL;
  63.       Flags := MenuItemFlagsSet{ItemText,ItemEnabled};
  64.       IF cmd#0C THEN INCL(Flags,CommSeq); END; 
  65.       CASE select OF
  66.         0 : |
  67.         1 : Flags := Flags + MenuItemFlagsSet{CheckIt,MenuToggle}; |
  68.         2 : Flags := Flags + MenuItemFlagsSet{CheckIt,MenuToggle,Checked}; 
  69.       ELSE; END;
  70.       CASE high OF
  71.         0 : Flags := Flags + HighComp; |
  72.         1 : Flags := Flags + HighBox;  |
  73.         3 : Flags := Flags + HighNone; 
  74.       ELSE Flags := Flags + HighComp;
  75.       END;
  76.     END;
  77.     RETURN(ADDRESS(MIP));
  78.   END EasyMenuItem;
  79.  
  80. PROCEDURE EasyItemStrip(x,y,w,mx,select,selected,high : INTEGER;
  81.                         text : ARRAY OF CHAR): ADDRESS;
  82.   TYPE
  83.     TextPtr = POINTER TO ARRAY [1..1000] OF CHAR;
  84.   VAR
  85.     I,J,L,LL,MX,SEL,W,Y : INTEGER; CMD : ARRAY [1..32] OF CHAR;
  86.     TP : ARRAY [1..32] OF TextPtr;
  87.     PIP,PPIP : ADDRESS; MXBSP : POINTER TO BITSET;
  88.  BEGIN
  89.     IF x=0 THEN x := 1; END; IF y=0 THEN y := 1; END;
  90.     J := 1; L := 0; LL := 0; I := 0; TP[1] := ADR(text);
  91.     IF TP[1]^[1]='@' THEN 
  92.       CMD[1] := TP[1]^[2]; TP[1]:= ADDRESS(TP[1])+ADDRESS(2);  
  93.     ELSE CMD[1] := 0C; END;
  94.     WHILE (I<=INTEGER(HIGH(text))) AND (text[I]#0C) DO 
  95.       IF text[I]='|' THEN
  96.         IF LL<L THEN LL := L; END;    (* save length if longest so far *)
  97.         text[I] := 0C; L := 0; INC(J); TP[J] := ADR(text[I+1]);
  98.         IF TP[J]^[1]='@' THEN CMD[J] := TP[J]^[2]; 
  99.           TP[J]:= ADDRESS(TP[J])+ADDRESS(2); INC(I,2);
  100.         ELSE CMD[J] := 0C; END;
  101.       ELSE INC(L); END;
  102.       INC(I); 
  103.     END;
  104.     IF LL<L THEN LL := L; END;    (* save length if longest so far *)
  105.     MX := 0; TP[J+1] := NIL; PIP := NIL; L := LL*8+7; MXBSP := ADR(MX);
  106.     IF L<w THEN L := w; END;
  107.     FOR I := J TO 1 BY -1 DO
  108.       IF selected=I THEN SEL := 2; ELSE SEL := select; END;
  109.       IF mx=1 THEN MX := -1; EXCL(MXBSP^,CARDINAL(I-1)); END; PPIP := PIP;
  110.       PIP:=EasyMenuItem(PIP,NIL,x,(I-1)*9+y,L,9,MX,SEL,high,0,1,CMD[I],TP[I]^);
  111.       IF PIP=NIL THEN IF PPIP#NIL THEN
  112.         DisposeEasyItemStrip(PPIP); END; RETURN(NIL); END;
  113.     END;
  114.     RETURN(PIP);
  115.   END EasyItemStrip;
  116.  
  117. PROCEDURE EasyMenu(NextMenus,Items : ADDRESS; x,w : INTEGER;
  118.                    text : ARRAY OF CHAR): ADDRESS;
  119.   VAR
  120.     MP : MenuPtr;
  121.     TP : POINTER TO ARRAY [0..1000] OF CHAR; I,J : INTEGER;
  122.   BEGIN 
  123.     I := 0; WHILE (I<=INTEGER(HIGH(text))) AND (text[I]#0C) DO INC(I); END;
  124.     TP := AllocMem(LONGCARD(I+1),MemReqSet{MemPublic}); TP^[I] := 0C;
  125.     IF TP=NIL THEN RETURN(NIL); END;
  126.     IF I>0 THEN FOR J := 0 TO I-1 DO TP^[J] := text[J]; END; END;
  127.     MP := AllocMem(LONGCARD(TSIZE(Menu)),MemReqSet{MemPublic});
  128.     IF MP=NIL THEN FreeMem(TP,LONGCARD(I+1)); RETURN(NIL); END;
  129.     WITH MP^ DO
  130.       NextMenu := NextMenus; LeftEdge := x; TopEdge := 1;
  131.       Width := w; Height := 10; MenuName := TP; FirstItem := Items; 
  132.       Flags := MenuFlagsSet{MenuEnabled};
  133.     END; 
  134.     RETURN(ADDRESS(MP));
  135.   END EasyMenu;
  136.  
  137. PROCEDURE EasyMenuStrip(x : INTEGER; mx,select,high : BITSET;
  138.                   text1,text2,text3,text4,text5,text6,text7,
  139.                   text8,text9,text10,text11,text12 : ARRAY OF CHAR): ADDRESS;
  140.   VAR 
  141.     MP : MenuPtr; TP : POINTER TO ARRAY [1..1000] OF CHAR;
  142.     I,J,K,MX,SEL,HI,W : INTEGER; RAD : ADDRESS;
  143.     text : POINTER TO ARRAY [0..1000] OF CHAR;
  144.   BEGIN
  145.     MP := NIL;
  146.     FOR K := 12 TO 1 BY -1 DO
  147.       CASE K OF
  148.         1  : text := ADR(text1);  HI := HIGH(text1);  | 
  149.         2  : text := ADR(text2);  HI := HIGH(text2);  |
  150.         3  : text := ADR(text3);  HI := HIGH(text3);  | 
  151.         4  : text := ADR(text4);  HI := HIGH(text4);  | 
  152.         5  : text := ADR(text5);  HI := HIGH(text5);  | 
  153.         6  : text := ADR(text6);  HI := HIGH(text6);  | 
  154.         7  : text := ADR(text7);  HI := HIGH(text7);  | 
  155.         8  : text := ADR(text8);  HI := HIGH(text8);  | 
  156.         9  : text := ADR(text9);  HI := HIGH(text9);  |
  157.         10 : text := ADR(text10); HI := HIGH(text10); | 
  158.         11 : text := ADR(text11); HI := HIGH(text11); |  
  159.         12 : text := ADR(text12); HI := HIGH(text12); ELSE; 
  160.       END;
  161.       IF text^[0]#0C THEN
  162.         I := 0; 
  163.         WHILE (I<=HI) AND (text^[I]#0C) AND (text^[I]#'|') DO 
  164.           INC(I); END;
  165.         IF (text^[I]='|') AND ((I+1)<=HI) AND (text^[I+1]#0C) THEN
  166.           text^[I] := 0C; W := I*8+7; TP := ADR(text^[I+1]);
  167.           MP := EasyMenu(MP,NIL,0,W,text^);
  168.           IF MP=NIL THEN RETURN(NIL); END;
  169.           text^[HI] := 0C;
  170.           IF CARDINAL(K) IN select THEN SEL := 1; ELSE SEL := 0; END;
  171.           IF CARDINAL(K) IN mx THEN MX := 1; ELSE MX := 0; END;
  172.           IF CARDINAL(K) IN high THEN HI := 1; ELSE HI := 0; END;
  173.           MP^.FirstItem := EasyItemStrip(1,1,W,MX,SEL,0,HI,TP^);
  174.           IF MP^.FirstItem=NIL THEN 
  175.             DisposeEasyMenu(MP); RETURN(NIL); END;
  176.         END;
  177.       END;
  178.     END;
  179.     I := x; RAD := MP;
  180.     WHILE MP#NIL DO
  181.       MP^.LeftEdge := I; INC(I,MP^.Width); MP := MP^.NextMenu; END;
  182.     RETURN(RAD); 
  183.   END EasyMenuStrip;
  184.  
  185.  
  186. PROCEDURE DisposeEasyIntuiText(ITextPtr : ADDRESS);
  187.   VAR  
  188.    I : INTEGER; TP : POINTER TO ARRAY [1..1000] OF CHAR;
  189.    ITP : IntuiTextPtr;
  190.   BEGIN
  191.     ITP := ITextPtr; TP := ITP^.IText; I := 1; 
  192.     WHILE TP^[I]#0C DO INC(I); END;
  193.     FreeMem(TP,LONGCARD(I));
  194.     FreeMem(ITP,LONGCARD(TSIZE(IntuiText)));
  195.   END DisposeEasyIntuiText;
  196.  
  197. PROCEDURE DisposeEasyItem(ItemPtr : ADDRESS);
  198.   VAR
  199.     IP : MenuItemPtr;
  200.   BEGIN
  201.     IP := ItemPtr;
  202.     DisposeEasyIntuiText(IP^.ItemFill);
  203.     FreeMem(IP,LONGCARD(TSIZE(MenuItem)));
  204.   END DisposeEasyItem;
  205.  
  206. PROCEDURE DisposeEasyItemStrip(ItemPtr : ADDRESS);
  207.   VAR
  208.     AItemPtr : MenuItemPtr;
  209.   BEGIN
  210.     AItemPtr := ItemPtr;
  211.     IF AItemPtr^.NextItem#NIL THEN 
  212.       DisposeEasyItemStrip(AItemPtr^.NextItem); END;
  213.     IF AItemPtr^.SubItem#NIL THEN 
  214.       DisposeEasyItemStrip(AItemPtr^.SubItem); END;
  215.     DisposeEasyItem(ItemPtr);
  216.   END DisposeEasyItemStrip;  
  217.  
  218. PROCEDURE DisposeEasyMenu(MenuPt : ADDRESS);
  219.   VAR  
  220.    I : INTEGER; TP : POINTER TO ARRAY [1..1000] OF CHAR;
  221.    IMP : MenuPtr;
  222.   BEGIN
  223.     IMP := MenuPt; TP := IMP^.MenuName; I := 1; 
  224.     WHILE TP^[I]#0C DO INC(I); END;
  225.     FreeMem(TP,LONGCARD(I));
  226.     FreeMem(IMP,LONGCARD(TSIZE(Menu)));
  227.   END DisposeEasyMenu;
  228.  
  229. PROCEDURE DisposeEasyMenuStrip(MenuPt : ADDRESS);
  230.   VAR
  231.     AMenuPtr : MenuPtr;
  232.   BEGIN
  233.     AMenuPtr := MenuPt;
  234.     IF AMenuPtr^.NextMenu#NIL THEN 
  235.       DisposeEasyMenuStrip(AMenuPtr^.NextMenu); END;
  236.     IF AMenuPtr^.FirstItem#NIL THEN
  237.       DisposeEasyItemStrip(AMenuPtr^.FirstItem); END;
  238.     DisposeEasyMenu(MenuPt);
  239.   END DisposeEasyMenuStrip;  
  240.  
  241. PROCEDURE SubItemNum(MenuNumber : INTEGER): CARDINAL;
  242.   BEGIN
  243.     IF BITSET(MenuNumber)>=BITSET{11..15} THEN RETURN(0);
  244.     ELSE  RETURN(CARDINAL(MenuNumber) DIV 2048 + 1); END;
  245.   END SubItemNum;
  246.  
  247. PROCEDURE ItemNum(MenuNumber : INTEGER): CARDINAL;
  248.   BEGIN
  249.     IF BITSET(MenuNumber)>=BITSET{5..10} THEN RETURN(0);
  250.     ELSE  RETURN(CARDINAL(BITSET(MenuNumber)-BITSET{11..15}) DIV 32 + 1); END;
  251.   END ItemNum;
  252.  
  253. PROCEDURE MenuNum(MenuNumber : INTEGER): CARDINAL;
  254.   BEGIN
  255.     IF BITSET(MenuNumber)>=BITSET{0..4} THEN RETURN(0);
  256.     ELSE  RETURN(CARDINAL(BITSET(MenuNumber)-BITSET{5..15}) + 1); END;
  257.   END MenuNum;
  258.  
  259. PROCEDURE AttachMenuStrip(WindPtr, MenuPt : ADDRESS);
  260.   VAR wp : WindowPtr; MP : MenuPtr;
  261.   BEGIN
  262.     MP := MenuPt; 
  263.     wp := WindPtr;
  264.     SetMenuStrip(wp^,MP^); 
  265.   END AttachMenuStrip;
  266.  
  267. PROCEDURE DetachMenuStrip(WindPtr : ADDRESS);
  268.   VAR wp : WindowPtr; 
  269.   BEGIN 
  270.     wp := WindPtr;
  271.     ClearMenuStrip(wp^); 
  272.   END DetachMenuStrip;
  273.  
  274. END EasyMenus.
  275.