home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 647.lha / Attacks / Sources.LZH / Sources / menuutil.mod < prev    next >
Encoding:
Modula Implementation  |  1992-04-16  |  13.6 KB  |  424 lines
  1. IMPLEMENTATION MODULE MenuUtil;
  2.  
  3. IMPORT Intuition, Memory, Rasters, Strings, Tasks;
  4. FROM SYSTEM IMPORT ADDRESS, ADR, BYTE;
  5. FROM System IMPORT HALTX;
  6. FROM TermInOut IMPORT WriteString, WriteLn, WriteInt, WriteCard, WriteHex;
  7. FROM AmigaDosProcess IMPORT Delay;
  8. FROM Intuition IMPORT IDCMPFlagsSet, WindowFlagsSet,
  9.                       MenuFlagsSet, MenuItemFlagsSet, MenuItemMutualExcludeSet,
  10.                       AllocRemember, FreeRemember, MenuItemFlags;
  11. FROM Util IMPORT STRINGPTR, WriteAddress, WriteByte, WriteStringPtr;
  12.  
  13.  
  14. CONST
  15.   MemoryFlags = Memory.MemReqSet{ Memory.MemChip, Memory.MemClear };
  16.   CharWidth   = 8;
  17.   CharHeight  = 8;
  18.  
  19. VAR
  20.   menucount : CARDINAL;      (* This "hack" is used to try to fix the  *)
  21.                              (* offset on the first menu item's select *)
  22.                              (* block. *)
  23.  
  24. (************************************)
  25.  
  26. PROCEDURE CreateStringCopy(     String     : ARRAY OF CHAR;
  27.                             VAR RememberKey: Intuition.RememberPtr ): STRINGPTR;
  28.  
  29. (* Creates a copy of the given string in newly allocated memory and returns
  30.  * pointer to it.  Returns NIL if memory allocation fails.
  31.  *)
  32.  
  33. VAR
  34.   StringPtr : STRINGPTR;
  35. BEGIN
  36.   StringPtr := AllocRemember( RememberKey,
  37.                               Strings.StringLength(String)+1, MemoryFlags );
  38.   IF StringPtr = NIL THEN
  39.     WriteString("Allocation failed in CreateStringCopy"); WriteLn();
  40.     RETURN NIL;
  41.   END;
  42.   Strings.CopyString( StringPtr^, String );
  43.   RETURN StringPtr;
  44. END CreateStringCopy;
  45.  
  46. (************************************)
  47.  
  48. PROCEDURE CreateIText(     StringPtr  : STRINGPTR;
  49.                        VAR RememberKey: Intuition.RememberPtr ) :
  50.                                                      Intuition.IntuiTextPtr;
  51. VAR
  52.   ITextPtr : Intuition.IntuiTextPtr;
  53. BEGIN
  54.   ITextPtr := AllocRemember( RememberKey,
  55.                              SIZE(ITextPtr^), MemoryFlags );
  56.   IF ITextPtr = NIL THEN
  57.     WriteString("Allocation failed in CreateIText"); WriteLn();
  58.     RETURN NIL;
  59.   END;
  60.   ITextPtr^.FrontPen  := BYTE(0);
  61.   ITextPtr^.BackPen   := BYTE(1);
  62.   ITextPtr^.DrawMode  := Rasters.Jam2;
  63.   ITextPtr^.LeftEdge  := 0;
  64.   ITextPtr^.TopEdge   := 1;            (* leave one pixel row above *)
  65.   ITextPtr^.ITextFont := NIL;
  66.   ITextPtr^.IText     := StringPtr;
  67.   ITextPtr^.NextText  := NIL;
  68.   RETURN ITextPtr;
  69. END CreateIText;
  70.  
  71. (************************************)
  72.  
  73. PROCEDURE DumpIntuiText( ITextPtr : Intuition.IntuiTextPtr );
  74. BEGIN
  75.   WriteString("    INTUITEXT DUMP"); WriteLn();
  76.   WriteString("    ITextPtr  = "); WriteAddress( ITextPtr ); WriteLn();
  77.   IF ITextPtr # NIL THEN
  78.     WITH ITextPtr^ DO
  79.       WriteString("    FrontPen  = "); WriteByte( FrontPen, 6 );  WriteLn();
  80.       WriteString("    BackPen   = "); WriteByte( BackPen,  6 );  WriteLn();
  81.       WriteString("    DrawMode  = ");                            WriteLn();
  82.       WriteString("    LeftEdge  = "); WriteInt( LeftEdge,  6 );  WriteLn();
  83.       WriteString("    TopEdge   = "); WriteInt( TopEdge ,  6 );  WriteLn();
  84.       WriteString("    ITextFont = "); WriteAddress( ITextFont ); WriteLn();
  85.       WriteString("    IText     = "); WriteStringPtr( IText );   WriteLn();
  86.       WriteString("    NextText  = "); WriteAddress( NextText );  WriteLn();
  87.       DumpIntuiText( NextText );
  88.     END;  (* WITH *)
  89.   END;  (* IF *)
  90. END DumpIntuiText;
  91.  
  92. (************************************)
  93.  
  94. PROCEDURE DumpItem( ItemPtr : Intuition.MenuItemPtr );
  95. BEGIN
  96.   WriteString("  ITEM DUMP"); WriteLn();
  97.   WriteString("  ItemPtr    = "); WriteAddress( ItemPtr ); WriteLn();
  98.   IF ItemPtr # NIL THEN
  99.     WITH ItemPtr^ DO
  100.       WriteString("  LeftEdge   = "); WriteInt( LeftEdge, 6 );    WriteLn();
  101.       WriteString("  TopEdge    = "); WriteInt( TopEdge , 6 );    WriteLn();
  102.       WriteString("  Width      = "); WriteInt( Width   , 6 );    WriteLn();
  103.       WriteString("  Height     = "); WriteInt( Height  , 6 );    WriteLn();
  104.       WriteString("  Flags      = ");                             WriteLn();
  105.       WriteString("  MutualExcl = ");                             WriteLn();
  106.       WriteString("  Command    = "); WriteByte( Command, 6 );    WriteLn();
  107.       WriteString("  SubItem    = "); WriteAddress( SubItem );    WriteLn();
  108.       WriteString("  ItemFill   = "); WriteAddress( ItemFill );   WriteLn();
  109.       DumpIntuiText( ItemFill );
  110.       WriteString("  SelectFill = "); WriteAddress( SelectFill ); WriteLn();
  111.       DumpIntuiText( SelectFill );
  112.       WriteString("  NextItem   = "); WriteAddress( NextItem );   WriteLn();
  113.       DumpItem( NextItem );
  114.     END;  (* WITH *)
  115.   END;  (* IF *)
  116. END DumpItem;
  117.  
  118. (************************************)
  119.  
  120. PROCEDURE DumpMenu( MenuPtr : Intuition.MenuPtr );
  121. BEGIN
  122.   WriteString("MENU DUMP"); WriteLn();
  123.   WriteString("MenuPtr   = "); WriteAddress( MenuPtr ); WriteLn();
  124.   IF MenuPtr # NIL THEN
  125.     WITH MenuPtr^ DO
  126.       WriteString("MenuName  = "); WriteStringPtr( MenuName ); WriteLn();
  127.       WriteString("LeftEdge  = "); WriteInt( LeftEdge, 6 );    WriteLn();
  128.       WriteString("TopEdge   = "); WriteInt( TopEdge , 6 );    WriteLn();
  129.       WriteString("Width     = "); WriteInt( Width   , 6 );    WriteLn();
  130.       WriteString("Height    = "); WriteInt( Height  , 6 );    WriteLn();
  131.       WriteString("Flags     = ");                             WriteLn();
  132.       WriteString("FirstItem = "); WriteAddress( FirstItem );  WriteLn();
  133.       DumpItem( FirstItem );
  134.       WriteString("NextMenu  = "); WriteAddress( NextMenu );   WriteLn();
  135.       DumpMenu( NextMenu );
  136.     END;  (* WITH *)
  137.   END;  (* IF *)
  138. END DumpMenu;
  139.  
  140. (************************************)
  141.  
  142. PROCEDURE Dump( MenuBarPtr : MENUBARPTR );
  143. BEGIN
  144.   DumpMenu( MenuBarPtr^.FirstMenuPtr );
  145. END Dump;
  146.  
  147. (************************************)
  148.  
  149. PROCEDURE InitMenuBar( VAR MenuBarPtr : MENUBARPTR );
  150.  
  151. BEGIN
  152.   MenuBarPtr := Memory.AllocMem( SIZE(MenuBarPtr^), MemoryFlags );
  153.   IF MenuBarPtr = NIL THEN
  154.     WriteString("Allocation for new menu bar failed"); WriteLn;
  155.   ELSE
  156.     MenuBarPtr^.FirstMenuPtr := NIL;
  157.     MenuBarPtr^.RememberKey  := NIL;
  158.   END;
  159. END InitMenuBar;
  160.  
  161. (************************************)
  162.  
  163. PROCEDURE FindLastMenu(     FirstMenuPtr : Intuition.MenuPtr;
  164.                         VAR MenuPtr      : Intuition.MenuPtr;
  165.                         VAR MenuNumber   : INTEGER            );
  166. BEGIN
  167.   MenuPtr    := FirstMenuPtr;
  168.   MenuNumber := -1;
  169.   IF MenuPtr # NIL THEN
  170.     MenuNumber := 0;
  171.     WHILE MenuPtr^.NextMenu # NIL DO         (* find last menu *)
  172.       MenuPtr := MenuPtr^.NextMenu;
  173.       INC( MenuNumber );
  174.     END;
  175.     (* MenuPtr now points to the last menu *)
  176.   END;
  177. END FindLastMenu;
  178.  
  179. (************************************)
  180.  
  181. PROCEDURE FindLastItem(     FirstItemPtr : Intuition.MenuItemPtr;
  182.                         VAR ItemPtr      : Intuition.MenuItemPtr;
  183.                         VAR ItemNumber   : INTEGER                );
  184. BEGIN
  185.   ItemPtr    := FirstItemPtr;
  186.   ItemNumber := -1;
  187.   IF ItemPtr # NIL THEN
  188.     ItemNumber := 0;
  189.     WHILE ItemPtr^.NextItem # NIL DO         (* find last item *)
  190.       ItemPtr := ItemPtr^.NextItem;
  191.       INC( ItemNumber );
  192.     END;
  193.     (* ItemPtr now points to the last menu *)
  194.   END;
  195. END FindLastItem;
  196.  
  197. (************************************)
  198.  
  199. PROCEDURE AddMenu( MenuBarPtr : MENUBARPTR;
  200.                    MenuName   : ARRAY OF CHAR );
  201. VAR
  202.   LastMenuPtr : Intuition.MenuPtr;
  203.   NewMenuPtr  : Intuition.MenuPtr;
  204.   MenuNumber  : INTEGER;
  205.   MenuNamePtr : STRINGPTR;
  206.  
  207. BEGIN
  208.   MenuNamePtr := CreateStringCopy( MenuName, MenuBarPtr^.RememberKey );
  209.  
  210.   FindLastMenu( MenuBarPtr^.FirstMenuPtr, LastMenuPtr, MenuNumber );
  211.   IF MenuNumber+1 >= Intuition.NoMenu THEN
  212.     WriteString("ERROR in MenuUtil: Too many menus"); WriteLn();
  213.     RETURN;
  214.   END;
  215.  
  216. (*  WriteString("Adding menu: ");  WriteString( MenuNamePtr^ );
  217.  *  WriteCard( MenuNumber+1, 3 );  WriteLn();
  218.  *)
  219.  
  220.   NewMenuPtr := AllocRemember( MenuBarPtr^.RememberKey,
  221.                                SIZE(NewMenuPtr^), MemoryFlags );
  222.   IF NewMenuPtr = NIL THEN
  223.     WriteString("Allocation of menu failed"); WriteLn();
  224.     RETURN;
  225.   END;
  226.   IF LastMenuPtr = NIL THEN
  227.     MenuBarPtr^.FirstMenuPtr := NewMenuPtr;
  228.   ELSE
  229.     LastMenuPtr^.NextMenu := NewMenuPtr;
  230.   END;
  231.  
  232.   NewMenuPtr^.NextMenu  := NIL;
  233.   NewMenuPtr^.Flags     := MenuFlagsSet{ Intuition.MenuEnabled };
  234.   NewMenuPtr^.MenuName  := MenuNamePtr;
  235.   NewMenuPtr^.Width     := CharWidth * ( Strings.StringLength(MenuNamePtr^)+1 );
  236.   NewMenuPtr^.FirstItem := NIL;
  237. END AddMenu;
  238.  
  239. (************************************)
  240.  
  241. PROCEDURE AddItem( MenuBarPtr : MENUBARPTR;
  242.                    ItemName   : ARRAY OF CHAR;
  243.                    Command    : CHAR;       (* Is 0C if no command *)
  244.                    MutEx      : MenuItemMutualExcludeSet;
  245.                              (* This set should be empty if no check mark *)
  246.                    InitCheck  : BOOLEAN );     (* Start with a check? *)
  247. CONST
  248.   ItemFlags = MenuItemFlagsSet{ Intuition.ItemText,
  249.                                 Intuition.ItemEnabled,
  250.                                 Intuition.MIF6         };
  251. VAR
  252.   LastMenuPtr : Intuition.MenuPtr;
  253.   MenuNumber  : INTEGER;
  254.   LastItemPtr : Intuition.MenuItemPtr;
  255.   ItemNumber  : INTEGER;
  256.   NewItemPtr  : Intuition.MenuItemPtr;
  257.   ItemNamePtr : STRINGPTR;
  258.   NewITextPtr : Intuition.IntuiTextPtr;
  259.  
  260. BEGIN
  261.   FindLastMenu( MenuBarPtr^.FirstMenuPtr, LastMenuPtr, MenuNumber );
  262.   IF LastMenuPtr = NIL THEN
  263.     WriteString("ERROR--attempt to add item w/o any menus"); WriteLn();
  264.     RETURN;
  265.   END;
  266.  
  267.   FindLastItem( LastMenuPtr^.FirstItem, LastItemPtr, ItemNumber );
  268.   IF ItemNumber+1 >= Intuition.NoItem THEN
  269.     WriteString("ERROR in MenuUtil: Too many items"); WriteLn();
  270.     RETURN;
  271.   END;
  272.  
  273.   ItemNamePtr := CreateStringCopy( ItemName, MenuBarPtr^.RememberKey );
  274.   IF NewItemPtr = NIL THEN RETURN; END;
  275.  
  276.   NewITextPtr := CreateIText( ItemNamePtr, MenuBarPtr^.RememberKey );
  277.   IF NewITextPtr = NIL THEN RETURN; END;
  278.  
  279. (*  WriteString("Adding item: ");  WriteString( ItemNamePtr^ );
  280.  *  WriteCard( ItemNumber+1, 3 );  WriteLn();
  281.  *)
  282.  
  283.   NewItemPtr := AllocRemember( MenuBarPtr^.RememberKey,
  284.                                SIZE(Intuition.MenuItem), MemoryFlags );
  285.   IF NewItemPtr = NIL THEN
  286.     WriteString("Allocation of item failed"); WriteLn();
  287.     RETURN;
  288.   END;
  289.  
  290.   IF LastItemPtr = NIL THEN
  291.     LastMenuPtr^.FirstItem := NewItemPtr;
  292.   ELSE
  293.     LastItemPtr^.NextItem := NewItemPtr;
  294.   END;
  295.  
  296.   NewItemPtr^.NextItem      := NIL;
  297. (****
  298.   NewItemPtr^.LeftEdge      := 0;
  299.   NewItemPtr^.TopEdge       := 2 + 10*(ItemNumber+1);
  300.   NewItemPtr^.Width         := 100;
  301.   NewItemPtr^.Height        := 10;
  302. ****)
  303.   NewItemPtr^.Flags         := ItemFlags;
  304.   NewItemPtr^.MutualExclude := MenuItemMutualExcludeSet{};
  305.   NewItemPtr^.ItemFill      := NewITextPtr;
  306.   NewItemPtr^.Command       := BYTE(0);
  307.   NewItemPtr^.SubItem       := NIL;
  308.   IF Command # 0C THEN
  309.      INCL ( NewItemPtr^.Flags, CommSeq );
  310.      NewItemPtr^.Command := BYTE(Command);
  311.      END;
  312.   IF MutEx # MenuItemMutualExcludeSet {} THEN
  313.      INCL ( NewItemPtr^.Flags, CheckIt );
  314.      NewItemPtr^.MutualExclude := MutEx;
  315.      IF InitCheck THEN
  316.         INCL ( NewItemPtr^.Flags, Checked );
  317.         END;
  318.      END;
  319. END AddItem;
  320.  
  321. (************************************)
  322.  
  323. PROCEDURE IntuiTextWidth( ITextPtr : Intuition.IntuiTextPtr ) : INTEGER;
  324.  
  325. (* *)
  326.  
  327. BEGIN
  328.   RETURN Intuition.IntuiTextLength( ITextPtr^ );
  329. END IntuiTextWidth;
  330.  
  331. (************************************)
  332.  
  333. (* MOVE TO UTIL.MOD *)
  334.  
  335. PROCEDURE MaxInt( Value1, Value2 : INTEGER ): INTEGER;
  336. BEGIN
  337.   IF Value1 > Value2 THEN
  338.     RETURN Value1;
  339.   ELSE
  340.     RETURN Value2;
  341.   END;
  342. END MaxInt;
  343.  
  344. (************************************)
  345.  
  346. PROCEDURE ArrangeItems( MenuPtr       : Intuition.MenuPtr;
  347.                         MenuNameWidth : INTEGER            );
  348.  
  349. CONST
  350.   ItemGap = 2;      (* vertical space between items *)
  351. VAR
  352.   ItemPtr      : Intuition.MenuItemPtr;
  353.   ItemPosition : INTEGER;
  354.   ItemNumber   : INTEGER;
  355.   MaxWidth     : INTEGER;
  356. BEGIN
  357.   ItemNumber   := 0;
  358.   ItemPosition := ItemGap;
  359.   MaxWidth     := MenuNameWidth; (* since pull-down will be at least this wide*)
  360.   ItemPtr      := MenuPtr^.FirstItem;
  361.   WHILE ItemPtr # NIL DO
  362.  (* WriteString("Arranging Item "); WriteCard(ItemNumber,2); WriteLn(); *)
  363.  
  364.     IF menucount = 1 THEN                (* A hack to fix some menus *)
  365.       ItemPtr^.LeftEdge := 2;
  366.       ELSE
  367.         ItemPtr^.LeftEdge := 0;
  368.       END;
  369.  
  370.     ItemPtr^.TopEdge  := ItemPosition;
  371.     ItemPtr^.Height   := CharHeight + ItemGap ;
  372.     MaxWidth          := MaxInt( MaxWidth, IntuiTextWidth(ItemPtr^.ItemFill) );
  373.     INC( ItemPosition, CharHeight + ItemGap );    (* for next item *)
  374.     INC( ItemNumber );
  375.     ItemPtr := ItemPtr^.NextItem;
  376.   END;
  377.   ItemPtr := MenuPtr^.FirstItem;
  378.   WHILE ItemPtr # NIL DO
  379.     ItemPtr^.Width := MaxWidth;
  380.     ItemPtr := ItemPtr^.NextItem;
  381.   END;
  382. END ArrangeItems;
  383.  
  384. (************************************)
  385.  
  386. PROCEDURE ArrangeMenus( MenuBarPtr : MENUBARPTR );
  387. CONST
  388.   MenuGap = 20;     (* horizontal space between menu names *)
  389. VAR
  390.   MenuPtr      : Intuition.MenuPtr;
  391.   MenuNamePtr  : STRINGPTR;
  392.   MenuNameWidth: INTEGER;
  393.   MenuPosition : INTEGER;
  394.   MenuNumber   : INTEGER;
  395. BEGIN
  396.   menucount := 1;
  397.   MenuNumber   := 0;
  398.   MenuPosition := 0;
  399.   MenuPtr      := MenuBarPtr^.FirstMenuPtr;
  400.   WHILE MenuPtr # NIL DO
  401.  (* WriteString("Arranging menu "); WriteCard(MenuNumber,2); WriteLn(); *)
  402.     MenuNamePtr   := MenuPtr^.MenuName;
  403.     MenuNameWidth := Strings.StringLength( MenuNamePtr^ ) * CharWidth;
  404.     MenuPtr^.LeftEdge := MenuPosition;
  405.     ArrangeItems( MenuPtr, MenuNameWidth );
  406.     INC( MenuPosition, MenuNameWidth + MenuGap );  (* for next menu *)
  407.     INC( MenuNumber );
  408.     MenuPtr := MenuPtr^.NextMenu;
  409.     INC( menucount );
  410.   END;
  411. END ArrangeMenus;
  412.  
  413. (************************************)
  414.  
  415. PROCEDURE DisposeMenuBar( VAR MenuBarPtr : MENUBARPTR );
  416. BEGIN
  417.   Intuition.FreeRemember( MenuBarPtr^.RememberKey, TRUE );
  418.   Memory.FreeMem( MenuBarPtr, SIZE(MenuBarPtr^) );
  419.   MenuBarPtr := NIL;  (* this IS necessary--first FreeMem param is not a VAR *)
  420. END DisposeMenuBar;
  421.  
  422. (************************************)
  423. END MenuUtil.
  424.