home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_disks / 001-099 / ff094.lzh / ModulaTools / ModulaTools.def next >
Text File  |  1987-08-23  |  33KB  |  539 lines
  1. (******************************************************************************)
  2. (*                                                                            *)
  3. (*    The global constants and variables defined in this module are optional: *)
  4. (* if you don't want to access their features, you needn't import them into   *)
  5. (* your program. The variables in the parameter lists of the procedures are   *)
  6. (* the only variables you are required to supply.                             *)
  7. (*    The global variables correspond to fields of the structures used in the *)
  8. (* procedures. By changing the values of these variables, you may safely and  *)
  9. (* easily access the sophisticated capabilities of Intuition. As much as fea- *)
  10. (* sible, I have tried to prevent illegal values from being sent to the Intu- *)
  11. (* ition and ROM Kernal procedures.                                           *)
  12. (*    These variables are initialized prior to use, either by importing this  *)
  13. (* module or by calling one of the initialization procedures below. Many of   *)
  14. (* the variables are automatically reset prior to exit from certain routines. *)
  15. (* Those variables are listed following the routines in which they are reset. *)
  16. (*    When describing the order in which certain routines are called, I have  *)
  17. (* adopted the curly-bracket notation of EBNF: routines in curly brackets {}  *)
  18. (* may be called an arbitrary number of times (0 to n). A, {B}, {C, {D}} thus *)
  19. (* implies that A is called once, followed by an arbitrary number of calls to *)
  20. (* to B, followed by an arbitrary number of calls to C. Each of the calls to  *)
  21. (* C may be followed by an arbitrary number of calls to D. Likewise, {{C},{D}}*)
  22. (* implies an arbitrary number of calls to C and D in any order.              *)
  23. (*                                                                            *)
  24. (**************************   Aaaaagggghhhhh!   *******************************)
  25. (*                                                                            *)
  26. (*    ModulaTools is SHAREWARE!!! That means you had better send me all your  *)
  27. (* money right now whether you like it or not. Pronto. Ooorrrrr, you can send *)
  28. (* me $7.50 if you find the code useful. If you want the source code to the   *)
  29. (* implementation module (featuring MORE documentation), a version of Modula- *)
  30. (* Tools which is broken into smaller modules (ALL of them documented)  and   *)
  31. (* some disk-based documentation that I found in the dumpster behind my house,*)
  32. (* send me $10.00 and a disk (or $15.00 -- I don't like buying disks), either *)
  33. (* in addition to or instead of the $7.50 mentioned above, to the address     *)
  34. (* listed below.                                                              *)
  35. (*                                                                            *)
  36. (*****************************    Address   ***********************************)
  37. (*                                                                            *)
  38. (*  Version 1.00a.002 (Beta) :   August 7, 1987                               *)
  39. (*                                                                            *)
  40. (*    These procedures were originally written under version 2.00 of the TDI  *)
  41. (* Modula-2 compiler. I have rewritten this module to operate under the v3.00 *)
  42. (* compiler. However, should you find any problem or inconsistency with the   *)
  43. (* functionality of this code, please contact me at the following address:    *)
  44. (*                                                                            *)
  45. (*                               Jerry Mack                                   *)
  46. (*                               23 Prospect Hill Ave.                        *)
  47. (*                               Waltham, MA   02154                          *)
  48. (*                                                                            *)
  49. (*    Check the module MenuUtils for TDI's (considerably less powerful) ver-  *)
  50. (* sions of my Menu and IntuitionText procedures. The modules GadgetUtils and *)
  51. (* EasyGadgets should also be of great help. Had these utilities been avail-  *)
  52. (* able earlier, I would have been spared the months of agony trying to create*)
  53. (* these routines. (Compile, link, run, CRASH! Compile, link,...)             *)
  54. (*                                                                            *)
  55. (******************************   Beware!   ***********************************)
  56. (*                                                                            *)
  57. (*    ModulaTools is a package consisting of three files: this definition     *)
  58. (* module and its associated symbol and link files. ModulaTools may only be   *)
  59. (* distributed intact and in its original form, except as noted below. In par-*)
  60. (* ticular, no comments may be excised from this definition module, except as *)
  61. (* noted below. No license is granted to distribute or disseminate, in any    *)
  62. (* machine-readable or recorded form, a partial or derivative version of this *)
  63. (* this definition module, except as noted below.                             *)
  64. (*                                                                            *)
  65. (*                                                                            *)
  66. (*    If you have made the shareware contribution to me as stated above, you  *)
  67. (* are granted the following and sole useage and distribution exceptions:     *)
  68. (*                                                                            *)
  69. (*  a) You may freely utilize portions or derivatives of ModulaTools in any   *)
  70. (* program for which you do not seek recompense and which you will not distri-*)
  71. (* bute in any machine-readable or recorded form. (If it's for your personal  *)
  72. (* use only, do whatever the hell you want.)                                  *)
  73. (*                                                                            *)
  74. (*  b) You may freely utilize portions or derivatives of ModulaTools in any   *)
  75. (* program for which you do not seek recompense but which you will distribute *)
  76. (* in a machine-readable or recorded form, so long as your program contains a *)
  77. (* notice or comment stating that I am the source of the utilized code. (If   *)
  78. (* you use ModulaTools in a program for your friends or the public domain,    *)
  79. (* give me some credit, please.)                                              *)
  80. (*                                                                            *)
  81. (*  c) You may freely utilize portions or derivatives of ModulaTools in any   *)
  82. (* program for which you seek recompense only if you allow your program to be *)
  83. (* FREELY distributed in ANY machine-readable or recorded form and only if    *)
  84. (* your program includes a notice or comment stating that I am the source of  *)
  85. (* the utilized code. (Commercial applications of this program are expressly  *)
  86. (* forbidden, without my written permission, as they require payment prior to *)
  87. (* or accompanying distribution. Shareware and/or freeware {what's the diff?} *)
  88. (* applications of ModulaTools are encouraged.)                               *)
  89. (*                                                                            *)
  90. (*  d) The above exceptions apply only to programs which are functionally dis-*)
  91. (* distinct from ModulaTools. No license is granted to use ModulaTools or a   *)
  92. (* derivative, in whole or in part, to create or distribute a program which   *)
  93. (* reproduces the functionality of ModulaTools in whole or in part. The sole  *)
  94. (* exception to this exception is the creation of an interactive, graphical   *)
  95. (* Modula-2 source-code generator. If you are interested in using ModulaTools *)
  96. (* to create such a generator, please contact me at the above address. I will *)
  97. (* be more than happy to assist you as my time allows.                        *)
  98. (*                                                                            *)
  99. (*    Any other use of ModulaTools, in either its original or a derivative    *)
  100. (* form, is expressly forbidden and will be vigorously prosecuted to the ful- *)
  101. (* lest extent of the law. (Scared yet?)                                      *)
  102. (*                                                                            *)
  103. (*************************  On the Other Hand  ********************************)
  104. (*                                                                            *)
  105. (*    No warranties are expressed or implied by the use or non-use of this de-*)
  106. (* finition module. It is designed solely as a utility to be used at your own *)
  107. (* risk. I accept no liability for any damage or suffering resulting from the *)
  108. (* use or non-use of this definition module or any program derived from it in *)
  109. (* whole or in part.                                                          *)
  110. (*    I make no claims as to the performance or functionality of this defini- *)
  111. (* tion module in whole or in part. In particular, I make no claim that this  *)
  112. (* definition module can perform as listed in the comments below. I make no   *)
  113. (* claim that this definition module can perform any function whatsoever. If  *)
  114. (* this definition module performs any function whatsoever, I am wholly re-   *)
  115. (* sponsible for that functionality but I accept no liability whatsoever for  *)
  116. (* any deficiencies in that functionality. I accept no liability whatsoever   *)
  117. (* for any deaths or injuries resulting from the use of this definition mo-   *)
  118. (* dule or any program derived from it in whole or in part. Insurrections,    *)
  119. (* terrorist strikes, acts of war or any domestic or international violence   *)
  120. (* which can be shown to be directly or indirectly related to the functional- *)
  121. (* ity or the lack therof of this definition module shall not be construed as *)
  122. (* an admission of liability on my part: the blame in such cases rests solely *)
  123. (* with the user.  In such cases, the user is responsible for easing world    *)
  124. (* tensions and avoiding a conventional, biological, chemical and/or nuclear  *)
  125. (* retaliation by the jingoistic extremist elements of the offended factions. *)
  126. (*                                                                            *)
  127. (******************************************************************************)
  128. (*                                                                            *)
  129. (*    Feel free to experiment with the procedures below: you never know till  *)
  130. (* you try...                                                                 *)
  131. (*                                                                            *)
  132. (******************************************************************************)
  133.  
  134. DEFINITION MODULE ModulaTools;
  135.  
  136. FROM DiskFontLibrary IMPORT AvailFontsHeaderPtr;
  137. FROM GraphicsBase    IMPORT GfxBasePtr;
  138. FROM GraphicsLibrary IMPORT BitMapPtr, DrawingModeSet;
  139. FROM Intuition       IMPORT ScreenPtr, ScreenFlagSet, WindowPtr, WindowFlags,
  140.                             WindowFlagSet,  SmartRefresh,IDCMPFlags,
  141.                             IDCMPFlagSet,MenuPtr, MenuFlags, MenuFlagSet,
  142.                             MenuItemPtr, ItemFlags, ItemFlagSet,
  143.                             IntuitionBasePtr, IntuitionTextPtr, IntuiMessagePtr;
  144. FROM Libraries       IMPORT LibraryPtr;
  145. FROM Menus           IMPORT HighComp;
  146. FROM Strings         IMPORT String;
  147. FROM SYSTEM          IMPORT ADDRESS;
  148. FROM Views           IMPORT Modes, ModeSet;
  149. FROM Text            IMPORT TextAttrPtr;
  150.  
  151.  
  152. CONST
  153.    NoTitle = 0C;                      (* no title for screen and/or window *)
  154.  
  155. VAR
  156.    ViewFeatures    : ModeSet;         (* ViewPort type and capabilities    *)
  157.    ScreenBitMap    : BitMapPtr;       (* custom Screen bitmap, if desired  *)
  158.    ScreenFeatures  : ScreenFlagSet;   (* Screen type and capabilities      *)
  159.    TextPen         : INTEGER;         (* color of text drawn in Screen     *)
  160.    FillPen         : INTEGER;         (* color of background in Screen     *)
  161.    MinWindowWide   : INTEGER;         (* minimum width  of next Window     *)
  162.    MaxWindowWide   : INTEGER;         (* maximum width  of next Window     *)
  163.    MinWindowHigh   : INTEGER;         (* minimum height of next Window     *)
  164.    MaxWindowHigh   : INTEGER;         (* maximum height of next Windwo     *)
  165.    WindowBitMap    : BitMapPtr;       (* custom Window bitmap, if desired  *)
  166.    WindowFeatures  : WindowFlagSet;   (* Window type and capabilities      *)
  167.    IDCMPFeatures   : IDCMPFlagSet;    (* types of Intuition messages wanted*)
  168.    UserIntuiBase   : IntuitionBasePtr;(* address of IntuitionBase          *)
  169.    UserGraphBase   : GfxBasePtr;      (* address of GraphicsBase           *)
  170.  
  171.  
  172.    PROCEDURE OpenGraphics () : BOOLEAN;
  173.  
  174.    PROCEDURE CreateScreen (Left, Top, Wide, High : INTEGER;   (* Input *)
  175.                            Bitplanes             : INTEGER;   (* Input *)
  176.                            VAR ScreenTitle       : String)    : ScreenPtr;
  177.    
  178.    PROCEDURE CreateWindow (Left, Top, Wide, High : INTEGER;   (* Input *)
  179.                            VAR WindowTitle       : String;    (* Input *)
  180.                            UserScreen            : ScreenPtr) : WindowPtr;
  181.                          
  182.    PROCEDURE CloseGraphics ();
  183.  
  184.  
  185.           (* Variables reset in PROCEDURE OpenGraphics (): *)
  186.  
  187. (*  TextPen = 0  MinWindowWide = 30  MinWindowHigh = 20  ScreenBitMap = NULL *)
  188. (*  FillPen = 1  MaxWindowWide =  0  MaxWindowHigh =  0  WindowBitMap = NULL *)
  189. (*  ViewFeatures   = Empty                                                   *)
  190. (*  ScreenFeatures = CustomScreen                                            *)
  191. (*  IDCMPFeatures  = MenuPick, CloseWindowFlag, NewSize, GadgetUp            *)
  192. (*  WindowFeatures = SmartRefresh, WindowSizing, WindowDrag, WindowDepth,    *)
  193. (*                   Activate, ReportMouseFlag                               *)
  194.  
  195. (* OpenGraphics may return a value of FALSE if either the IntuitionLibrary   *)
  196. (* or the GraphicsLibrary could not be opened. Whichever of UserIntuiBase or *)
  197. (* UserGraphBase = NULL is the library which could not be opened. You needn't*)
  198. (* call CloseGraphics in such a case.                                        *) 
  199.  
  200. (* Both CreateScreen and CreateWindow do extensive checking to ensure that   *)
  201. (* you don't exceed the performance limits of the Amiga. (I am FED UP with   *)
  202. (* crashes!!) If you find any combination which doesn't work properly, I     *)
  203. (* would appreciate your dropping me a line describing the invocation. Also, *)
  204. (* Left and Top are measured from the upper-left corner of the display in    *)
  205. (* CreateScreen, whereas in CreateWindow they are measured from the upper-   *)
  206. (* left corner of the Screen in which the Window will appear.                *) 
  207.  
  208. (* If UserScreen = NULL, then the Window will open in the WorkBench Screen;  *)
  209. (* otherwise, it will open in the UserScreen.                                *) 
  210.  
  211. (* ScreenBitMap and WindowBitMap are pointers to custom bitmaps. Unless you  *)
  212. (* want to manage your own bitmaps, you should leave these alone (= NULL).   *)
  213.  
  214. (* TextPen and FillPen are chosen from the color palette; the number of pens *)
  215. (* available = 2**bitplanes { or 2^bitplanes }. Any pen choice outside of    *)
  216. (* this range results in choice wraparound, which I assume is done by ignor- *)
  217. (* ing illegal higher-order bits.                                            *)
  218.  
  219. (* ViewFeatures determines the type of ViewPort in which you wish your Screen*)
  220. (* to be rendered. Setting this to the appropriate value allows you to obtain*)
  221. (* high-resolution, interlaced, HAM, ExtraHalfBright, etc. ViewPorts.        *)
  222.  
  223. (* ScreenFeatures determines how the Screen will appear in the display and   *)
  224. (* whether or not the new Screen will be a CustomScreen.                     *)
  225.  
  226. (* WindowFeatures determines how the Window will appear in the display,what  *)
  227. (* type of Gadgets you wish attached to it and how it will be refreshed.     *)
  228.  
  229. (* MinWindowWide, MaxWindowWide, MinWindowHigh and MaxWindowHigh are only of *)
  230. (* use if the Window has a sizing gadget: INCL(WindowFeatures, WindowSizing).*) 
  231. (* If any of these is set to 0, then the limit of that dimension will be the *)
  232. (* current dimension of the Window.                                          *)
  233.  
  234. (* IDCMPFeatures determines which messages your Window will receive from In- *)
  235. (* tuition. If your program isn't responding to certain gadgets or events,   *)
  236. (* check that you have included the proper notification flags here.          *)
  237.  
  238. (* CloseGraphics should not be called until you close ALL the Windows and    *)
  239. (* Screens opened with the above procedures. Otherwise...                    *)
  240.  
  241. (* If you want to open Windows and/or Screens without using these procedures,*)
  242. (* you should assign IntuitionBase and GraphicsBase to UserIntuiBase and     *)
  243. (* UserGraphBase, resp. This allows you to use the libraries opened in the   *)
  244. (* procedure OpenGraphics as opposed to opening your own versions of these   *)
  245. (* libraries.                                                                *)
  246.  
  247. (* The order in which these procedures is called is as follows: OpenGraphics,*)
  248. (* {{CreateScreen}, {CreateWindow}}, CloseGraphics.                          *)
  249.  
  250.   
  251.  
  252.  
  253. VAR
  254.    FrontTextPen : INTEGER;   (* these pens are chosen from the screen pen- *)
  255.    BackTextPen  : INTEGER;   (* palette; e.g., 3 bit planes = 8 pens (0-7);*)
  256.    CurrentFont  : TextAttrPtr;       (* in case you want a different font; *)
  257.    LastText     : IntuitionTextPtr;  (* connect current text to last text; *)
  258.    TextDrawMode : DrawingModeSet;             (* method used to draw text; *)
  259.  
  260.  
  261.    PROCEDURE GetIntuiText     (TextItem          : String;        (* Input *)
  262.                                TextLeft, TextTop : INTEGER;       (* Input *)
  263.                                VAR IntuiText     : IntuitionTextPtr); 
  264.  
  265.    PROCEDURE DestroyIntuiText (VAR IntuiText     : IntuitionTextPtr;
  266.                                DestroyAllText    : BOOLEAN); 
  267.  
  268.  
  269.         (* Default values upon importing this module: *)
  270.         (* FrontTextPen =  0    CurrentFont = NULL    *)
  271.         (* BackTextPen  =  1    LastText    = NULL    *)
  272.         (* TextDrawMode = Jam2                        *)
  273.  
  274.     (* GetIntuiText returns an IntuitionText structure containing the    *)
  275.     (* desired text. TextLeft and TextTop are the pixel positions where  *)
  276.     (* the lower-left corner of the text will be placed. If LastText <>  *)
  277.     (* NULL, then LastText will point to IntuiText, thus creating a      *)
  278.     (* linked list of IntuitionText structures. Just call GetIntuiText,  *)
  279.     (* assign LastText to IntuiText and call GetIntuiText again.         *)
  280.  
  281.     (* LastText is set to NULL following the call to GetIntuiText.       *)
  282.  
  283.     (* DestroyIntuiText DISPOSEs of IntuitionText: If DestroyAllText is  *)
  284.     (* TRUE, then it also DISPOSEs of all IntuitionText forward-linked   *)
  285.     (* to IntuiText. If DestroyAllText is FALSE, then only the Intuition-*)
  286.     (* Text pointed to by IntuiText is DISPOSEd. If IntuiText is forward-*)
  287.     (* linked to other IntuitionText upon entry to this procedure, then, *)
  288.     (* upon return, IntuiText will point to the next IntuitionText in the*)
  289.     (* linked list.                                                      *)
  290.  
  291.  
  292.  
  293. VAR
  294.    UserDiskFontBase  : LibraryPtr;      (* entry point into DiskFont library *)
  295.  
  296.  
  297.    PROCEDURE GetAndSortAllFonts (VAR FontBuffer : AvailFontsHeaderPtr): BOOLEAN;
  298.  
  299.    PROCEDURE ReturnFontResourcesToSystem (VAR FontBuffer : AvailFontsHeaderPtr);
  300.  
  301.  
  302.  (* GetAndSortAllFonts returns an array of AvailFonts structures, each of    *)
  303.  (* which contains a TextAttr structure and a flag informing whether the     *)
  304.  (* font resides in memory or on disk. The array contains data for the ROM   *)
  305.  (* fonts and all fonts in the FONTS: directory. The array is sorted by name *)
  306.  (* and also by point-size for fonts with identical names. Thus, the list on *)
  307.  (* the left would be returned in the order shown on the right:              *)
  308.  (*                                                                          *)
  309.  (*   9 point  diamond.font                   9 point  diamond.font          *)
  310.  (*  12 point  ruby.font                      9 point  garnet.font           *)
  311.  (*   8 point  topaz.font                    16 point  garnet.font           *)
  312.  (*   9 point  topaz.font                    12 point  ruby.font             *)
  313.  (*  19 point  sapphire.font                 19 point  sapphire.font         *)
  314.  (*  11 point  topaz.font                     8 point  topaz.font            *)
  315.  (*   9 point  garnet.font                    9 point  topaz.font            *)
  316.  (*  16 point  garnet.font                   11 point  topaz.font            *)
  317.  (*                                                                          *)
  318.  (* After calling GetAndSortAllFonts, you must call OpenFont or OpenDiskFont *)
  319.  (* to allow your program to load and utilize the available fonts.           *)
  320.  
  321.  (* ReturnFontResourcesToSystem should be called when you are finished with  *)
  322.  (* the FontBuffer. Also, you must call ReturnFontResourcesToSystem prior to *)
  323.  (* calling GetAndSortAllFonts again. However, unless you reassign the FONTS:*)
  324.  (* directory, there is little need to call GetAndSortAllFonts more than     *)
  325.  (* once. ReturnFontResourcesToSystem closes the DiskFont library which Get- *)
  326.  (* AndSortAllFonts opened (and which you may access via UserDiskFontBase),  *)
  327.  (* and DEALLOCATES the memory used by FontBuffer. Prior to calling Return-  *)
  328.  (* FontResourcesToSystem, you should call CloseFont and RemFont for each    *)
  329.  (* font that your program has opened. This ensures that all font-management *)
  330.  (* resources used by the system are released.                               *)
  331.  
  332.  
  333.  
  334. CONST                  (* set Commandkey to this if you do not want a    *)
  335.    NoKey  = " ";       (* key-equivalent for the current Item or SubItem *)
  336.  
  337.                     (* common assignments for ItemSetting & MenuSetting: *)
  338. CONST
  339.    Checkable = ItemFlagSet{CheckIt, MenuToggle};
  340.    CheckNow  = ItemFlagSet{Checked};              (* requires Checkable  *)
  341.    ItemOn    = ItemFlagSet{ItemEnabled} + HighComp;
  342.    ItemOff   = ItemFlagSet{};
  343.    MenuOn    = MenuFlagSet{MenuEnabled}; (* default value of MenuSetting *)
  344.    MenuOff   = MenuFlagSet{};
  345.  
  346. VAR
  347.    FirstMenu      : MenuPtr;        (* pointer to first Menu in Menu bar *)
  348.    CurrentMenu    : MenuPtr;        (* current Menu    in Menu bar       *)
  349.    CurrentItem    : MenuItemPtr;    (* current Item    in Menu bar       *)
  350.    CurrentSubItem : MenuItemPtr;    (* current SubItem in Menu bar       *)
  351.    LoneMenuStrip  : MenuPtr;        (* unattached, DISPOSEable MenuStrip *)
  352.    SelectText     : String;         (* (Sub)Item text shown if selected  *)
  353.    VerPixPerChar  : CARDINAL;       (* vertical   pixels per character   *)
  354.    HorPixPerChar  : CARDINAL;       (* horizontal pixels per character   *)
  355.    MenuSetting    : MenuFlagSet;    (* characteristics of current Menu   *)
  356.    HiResScreen    : BOOLEAN;        (* high resolution screen?           *)
  357.    AutoIndent     : BOOLEAN;        (* shift (Sub)Items to right?        *)
  358.    RightJustify   : BOOLEAN;        (* extend select boxes to right?     *)
  359.    Left, Top      : INTEGER;        (* left & top location and width &   *)
  360.    Wide, High     : INTEGER;        (* height of current Menu, (Sub)Item *)
  361.    NewItemColumn  : BOOLEAN;        (* flag: start new (Sub)Item column? *)
  362.  
  363.                                     (* all of these parameters are inputs *)
  364.    PROCEDURE InitializeMenuStrip;
  365.  
  366.    PROCEDURE AddMenu    (MenuBarText : String);
  367.  
  368.    PROCEDURE AddItem    (ItemText    : String;
  369.                          Commandkey  : CHAR;
  370.                          ItemSetting : ItemFlagSet;
  371.                          Exclusion   : LONGINT);
  372.  
  373.    PROCEDURE AddSubItem (SubItemText : String;
  374.                          Commandkey  : CHAR;
  375.                          ItemSetting : ItemFlagSet;
  376.                          Exclusion   : LONGINT);
  377.  
  378.    PROCEDURE DestroyMenuStrip (WindowPointer : WindowPtr);
  379.  
  380.  
  381.          (* Variables reset in PROCEDURE InitializeMenuStrip : *)
  382.  
  383.          (* CurrentMenu = NULL    MenuSetting   = MenuOn       *)
  384.          (* FirstMenu   = NULL    AutoIndent    = FALSE        *)
  385.          (* SelectText  = NoText  HorPixPerChar = 8            *)
  386.          (* MenuLeft    = 0       VerPixPerChar = 8            *)
  387.          (* HiResScreen = FALSE   RightJustify  = TRUE         *)
  388.  
  389.  (* ItemSetting := Checkable + CheckNow --> this (Sub)Item can be and is  *)
  390.  (* now checked; the routines above automatically set the ItemText flag.  *)
  391.  
  392.  (* Left, Top, Wide & High are recalculated in each subroutine to yield   *)
  393.  (* a pleasing MenuStrip; if you dislike it, you may change them prior to *)
  394.  (* calling AddMenu, AddItem and/or AddSubItem; also, Left & Wide affect  *)
  395.  (* the placement of text in AddMenu but affect the placement and size    *)
  396.  (* of the select boxes in AddItem and AddSubItem;                        *)
  397.  
  398.  (* To what are Left, Top, Wide and High measured relative? For Menus,    *)
  399.  (* they are relative to the upper-left corner of the Screen. For Items,  *)
  400.  (* they are relative to the lower-left corner of the Menu. For SubItems, *)
  401.  (* they are relative to the lower-left corner of the Item.               *) 
  402.  
  403.  (* If AutoIndent = TRUE, all Items under the CurrentMenu (or all SubItems*)
  404.  (* under the CurrentItem) will be shifted to the right to allow for a    *)
  405.  (* checkmark. If AutoIndent = FALSE, then only those (Sub)Items which    *)
  406.  (* request a checkmark in ItemSetting will be shifted to the right. The  *)
  407.  (* amount of space added to the left of the select box depends upon the  *)
  408.  (* value of HiresScreen.                                                 *)
  409.  
  410.  (* If RightJustify is TRUE, then the right edge of each Item extends to  *)
  411.  (* the edge of its Menu. Otherwise, the right edge of each Item is deter-*)
  412.  (* mined by the width of the longest Item in the current Item-column.    *)
  413.  (* This is of most use when multiple Item-columns are desired: setting   *)
  414.  (* RightJustify to FALSE ensures that the first column of Items isn't    *)
  415.  (* excessively wide.                                                     *)
  416.  
  417.  (* If CommandKey <> NoKey, then space will be added to the right of the  *)
  418.  (* (Sub)Item's select box according to the value of HiresScreen.         *)
  419.  
  420.  (* In addition, TextFlag is included in all Itemsetting values above,    *)
  421.  (* since these routines are designed to create text Menus and (Sub)Items.*)
  422.  
  423.  (* HorPixPerChar and VerPixPerChar are used to determine the width and   *)
  424.  (* height of the Menus, Items and SubItems. You may change these values  *)
  425.  (* to quickly obtain larger select boxes.                                *)
  426.  
  427.  (* SelectText allows you to specify a different text be displayed when   *)
  428.  (* the (Sub)Item is chosen, though it prevents use of other highlighting.*)
  429.  (* SelectText = NoText upon exit from each of the above four procedures. *)
  430.  (* As stated above, Left, Wide, Top and High are reset or recalculated   *)
  431.  (* prior to exit from the above four routines. Don't change these values *)
  432.  (* unless you know where you want a specific Menu or (Sub)Item placed.   *)
  433.   
  434.  (* CurrentMenu, CurrentItem and CurrentSubItem point to the Menu, Item   *)
  435.  (* or SubItem, respectively, which was just added to the MenuStrip. Thus,*)
  436.  (* if you require access to a particular node in the MenuStrip, you may  *)
  437.  (* copy these pointers as needed following the call to AddMenu, AddItem  *)
  438.  (* or AddSubItem.                                                        *)
  439.  
  440.  (* DestroyMenuStrip is designed to remove a MenuStrip from a Window and  *)
  441.  (* DISPOSE of its Menus, Items and SubItems, as well as the IntuitionText*)
  442.  (* structures to which they point. ANY non-NULL pointer in the MenuStrip *)
  443.  (* has its contents DISPOSED. If you wish only to DISPOSE of a MenuStrip *)
  444.  (* (one that is not attached to a Window), then set WindowPointer to NULL*)
  445.  (* and assign LoneMenuStrip to the MenuStrip of which to DISPOSE. Just   *)
  446.  (* prior to exit, DestroyMenuStrip calls InitializeMenuStrip. Thus, you  *)
  447.  (* need only call InitializeMenuStrip for the first MenuStrip and if you *)
  448.  (* want multiple MenuStrips defined at one time. I didn't call the pro-  *)
  449.  (* cedure in the module body because it looked unusual to call it for the*)
  450.  (* second and subsequent concurrent MenuStrips but not the first.        *)
  451.  
  452.  (* You can easily create multiple MenuStrips by calling InitializeMenu-  *)
  453.  (* Strip once for each MenuStrip. Be sure to save the value of FirstMenu *)
  454.  (* prior to the call, as that is the pointer to the first Menu of the    *)
  455.  (* current MenuStrip.                                                    *)
  456.  
  457.  (* Since the IntuiText routines above are used to create the Intuition-  *)
  458.  (* Text structures for the MenuStrip, you may change the values of the   *)
  459.  (* global variables associated with those routines to obtain different   *)
  460.  (* colors and fonts for your MenuStrip.                                  *)
  461.  
  462.  (* Be sure to add at least one Item to each Menu to prevent a crash.     *)
  463.  
  464.  (* In case you haven't figured it out, the order in which you call these *)
  465.  (* routines is as follows:  InitializeMenuStrip, {AddMenu,  AddItem,     *)
  466.  (* {AddSubItem}, {AddItem, {AddSubItem}}}, DestroyMenuStrip.             *)
  467.  
  468.  
  469.  
  470.  
  471. TYPE
  472.    ChoiceType = RECORD
  473.                    MenuChosen    : CARDINAL;
  474.                    ItemChosen    : CARDINAL;
  475.                    SubItemChosen : CARDINAL;
  476.                    ChoicePointer : MenuItemPtr;
  477.                 END; (* ChoiceType *)
  478.  
  479.  
  480.    PROCEDURE GotMessage     (VAR IMessage   : IntuiMessagePtr;
  481.                              CurrentWindow  : WindowPtr)     : BOOLEAN;
  482.  
  483.    PROCEDURE GetMenuChoice  (MenuSelection  : CARDINAL;        (* Input  *)
  484.                              FirstMenu      : MenuPtr;         (* Input  *)
  485.                              VAR MenuChoice : ChoiceType);     (* Output *)
  486.  
  487.  (* GotMessage quickly copies any message from Intuition and returns the *)
  488.  (* original to Intuition. This helps reduce the number of IntuiMessages *)
  489.  (* Intuition allocates. Since Intuition doesn't deallocate them unless  *)
  490.  (* it is reinitialized, this is definitely a desireable practice. Also, *)
  491.  (* Imessage is DISPOSEd of if it is non-NULL upon entering GotMessage.  *)
  492.  (* This means you don't have to worry about disposing of the copies of  *)
  493.  (* the Intuition messages, either. If IMessage^.Class = MenuPick, then  *)
  494.  (* you may obtain the (Sub)Item chosen by calling GetMenuChoice. If no  *)
  495.  (* message was pending from Intuition, then GotMessage returns FALSE.   *)
  496.  (* CurrentWindow is the only input, pointing to the Window in which you *)
  497.  (* wish to determine whether an Intuition message is pending.           *)
  498.  
  499.  (* GetMenuChoice determines the FIRST (Sub)Item chosen, and returns a   *)
  500.  (* a pointer to it. Be certain to check the NextSelect field of the cho-*)
  501.  (* sen (Sub)Item, as it is possible to click-select or drag-select mul- *)
  502.  (* tiple choices before releasing the right mousebutton. Thus, MenuSe-  *)
  503.  (* lection will be either IMessage^.Code or ChoicePointer^.NextSelect.  *)
  504.  
  505.  
  506.  
  507.  
  508.    (* These color values are from p.294 of the Amiga Programmer's Handbook *)
  509.    (*  Vol. 1 by Eugene P. Mortimore; Sybex, Inc., Berkeley; 1987.         *)
  510.  
  511. CONST
  512.    White     = 0FFFH;    GoldenOrange  = 0FB0H;    LightAqua = 01FBH;
  513.    BrickRed  = 0D00H;    CadmiumYellow = 0FD0H;    SkyBlue   = 06FEH;
  514.    Red       = 0F00H;    LemonYellow   = 0FF0H;    LightBlue = 06CEH;
  515.    RedOrange = 0F80H;    ForestGreen   = 00B1H;    Blue      = 000FH;
  516.    Orange    = 0F90H;    LightGreen    = 08E0H;    Purple    = 091FH;
  517.    LimeGreen = 0BF0H;    BrightBlue    = 061FH;    Violet    = 0C1FH;
  518.    Green     = 00F0H;    DarkBlue      = 006DH;    Pink      = 0FACH;
  519.    DarkGreen = 02C0H;    MediumGrey    = 0999H;    Tan       = 0DB9H;
  520.    BlueGreen = 00BBH;    LightGrey     = 0CCCH;    Brown     = 0C80H;
  521.    Aqua      = 00DBH;    Magenta       = 0F1FH;    DarkBrown = 0A87H;
  522.    Black     = 0000H;
  523.    MaxColors = 32;     (* # of colors to load when calling SetScreenColors *)
  524.  
  525. VAR
  526.    ScreenColors : ARRAY [0..MaxColors-1] OF CARDINAL;
  527.  
  528.  
  529.    PROCEDURE SetScreenColors (CurrentScreen : ScreenPtr);
  530.  
  531.  
  532.  (* SetScreenColors assigns ScreenColors to the color registers of Current- *)
  533.  (* Screen. Though ScreenColors is assigned values upon import of this mo-  *)
  534.  (* dule, I have spent little time determining which combinations are aes-  *)
  535.  (* thetically appealing. Thus, don't count on ScreenColors having the same *)
  536.  (* default values in later versions of this module.                        *)
  537.  
  538. END ModulaTools.
  539.