Frozen Fish 1: Amiga/FrozenFish-Apr94.iso/bbs/alib/d0xx/d094/modulatools.lha/ModulaTools/ModulaTools.def

Text File | 1987-08-23 | 32.0 KB | 539 lines

(******************************************************************************)
(*                                                                            *)
(*    The global constants and variables defined in this module are optional: *)
(* if you don't want to access their features, you needn't import them into   *)
(* your program. The variables in the parameter lists of the procedures are   *)
(* the only variables you are required to supply.                             *)
(*    The global variables correspond to fields of the structures used in the *)
(* procedures. By changing the values of these variables, you may safely and  *)
(* easily access the sophisticated capabilities of Intuition. As much as fea- *)
(* sible, I have tried to prevent illegal values from being sent to the Intu- *)
(* ition and ROM Kernal procedures.                                           *)
(*    These variables are initialized prior to use, either by importing this  *)
(* module or by calling one of the initialization procedures below. Many of   *)
(* the variables are automatically reset prior to exit from certain routines. *)
(* Those variables are listed following the routines in which they are reset. *)
(*    When describing the order in which certain routines are called, I have  *)
(* adopted the curly-bracket notation of EBNF: routines in curly brackets {}  *)
(* may be called an arbitrary number of times (0 to n). A, {B}, {C, {D}} thus *)
(* implies that A is called once, followed by an arbitrary number of calls to *)
(* to B, followed by an arbitrary number of calls to C. Each of the calls to  *)
(* C may be followed by an arbitrary number of calls to D. Likewise, {{C},{D}}*)
(* implies an arbitrary number of calls to C and D in any order.              *)
(*                                                                            *)
(**************************   Aaaaagggghhhhh!   *******************************)
(*                                                                            *)
(*    ModulaTools is SHAREWARE!!! That means you had better send me all your  *)
(* money right now whether you like it or not. Pronto. Ooorrrrr, you can send *)
(* me $7.50 if you find the code useful. If you want the source code to the   *)
(* implementation module (featuring MORE documentation), a version of Modula- *)
(* Tools which is broken into smaller modules (ALL of them documented)  and   *)
(* some disk-based documentation that I found in the dumpster behind my house,*)
(* send me $10.00 and a disk (or $15.00 -- I don't like buying disks), either *)
(* in addition to or instead of the $7.50 mentioned above, to the address     *)
(* listed below.                                                              *)
(*                                                                            *)
(*****************************    Address   ***********************************)
(*                                                                            *)
(*  Version 1.00a.002 (Beta) :   August 7, 1987                               *)
(*                                                                            *)
(*    These procedures were originally written under version 2.00 of the TDI  *)
(* Modula-2 compiler. I have rewritten this module to operate under the v3.00 *)
(* compiler. However, should you find any problem or inconsistency with the   *)
(* functionality of this code, please contact me at the following address:    *)
(*                                                                            *)
(*                               Jerry Mack                                   *)
(*                               23 Prospect Hill Ave.                        *)
(*                               Waltham, MA   02154                          *)
(*                                                                            *)
(*    Check the module MenuUtils for TDI's (considerably less powerful) ver-  *)
(* sions of my Menu and IntuitionText procedures. The modules GadgetUtils and *)
(* EasyGadgets should also be of great help. Had these utilities been avail-  *)
(* able earlier, I would have been spared the months of agony trying to create*)
(* these routines. (Compile, link, run, CRASH! Compile, link,...)             *)
(*                                                                            *)
(******************************   Beware!   ***********************************)
(*                                                                            *)
(*    ModulaTools is a package consisting of three files: this definition     *)
(* module and its associated symbol and link files. ModulaTools may only be   *)
(* distributed intact and in its original form, except as noted below. In par-*)
(* ticular, no comments may be excised from this definition module, except as *)
(* noted below. No license is granted to distribute or disseminate, in any    *)
(* machine-readable or recorded form, a partial or derivative version of this *)
(* this definition module, except as noted below.                             *)
(*                                                                            *)
(*                                                                            *)
(*    If you have made the shareware contribution to me as stated above, you  *)
(* are granted the following and sole useage and distribution exceptions:     *)
(*                                                                            *)
(*  a) You may freely utilize portions or derivatives of ModulaTools in any   *)
(* program for which you do not seek recompense and which you will not distri-*)
(* bute in any machine-readable or recorded form. (If it's for your personal  *)
(* use only, do whatever the hell you want.)                                  *)
(*                                                                            *)
(*  b) You may freely utilize portions or derivatives of ModulaTools in any   *)
(* program for which you do not seek recompense but which you will distribute *)
(* in a machine-readable or recorded form, so long as your program contains a *)
(* notice or comment stating that I am the source of the utilized code. (If   *)
(* you use ModulaTools in a program for your friends or the public domain,    *)
(* give me some credit, please.)                                              *)
(*                                                                            *)
(*  c) You may freely utilize portions or derivatives of ModulaTools in any   *)
(* program for which you seek recompense only if you allow your program to be *)
(* FREELY distributed in ANY machine-readable or recorded form and only if    *)
(* your program includes a notice or comment stating that I am the source of  *)
(* the utilized code. (Commercial applications of this program are expressly  *)
(* forbidden, without my written permission, as they require payment prior to *)
(* or accompanying distribution. Shareware and/or freeware {what's the diff?} *)
(* applications of ModulaTools are encouraged.)                               *)
(*                                                                            *)
(*  d) The above exceptions apply only to programs which are functionally dis-*)
(* distinct from ModulaTools. No license is granted to use ModulaTools or a   *)
(* derivative, in whole or in part, to create or distribute a program which   *)
(* reproduces the functionality of ModulaTools in whole or in part. The sole  *)
(* exception to this exception is the creation of an interactive, graphical   *)
(* Modula-2 source-code generator. If you are interested in using ModulaTools *)
(* to create such a generator, please contact me at the above address. I will *)
(* be more than happy to assist you as my time allows.                        *)
(*                                                                            *)
(*    Any other use of ModulaTools, in either its original or a derivative    *)
(* form, is expressly forbidden and will be vigorously prosecuted to the ful- *)
(* lest extent of the law. (Scared yet?)                                      *)
(*                                                                            *)
(*************************  On the Other Hand  ********************************)
(*                                                                            *)
(*    No warranties are expressed or implied by the use or non-use of this de-*)
(* finition module. It is designed solely as a utility to be used at your own *)
(* risk. I accept no liability for any damage or suffering resulting from the *)
(* use or non-use of this definition module or any program derived from it in *)
(* whole or in part.                                                          *)
(*    I make no claims as to the performance or functionality of this defini- *)
(* tion module in whole or in part. In particular, I make no claim that this  *)
(* definition module can perform as listed in the comments below. I make no   *)
(* claim that this definition module can perform any function whatsoever. If  *)
(* this definition module performs any function whatsoever, I am wholly re-   *)
(* sponsible for that functionality but I accept no liability whatsoever for  *)
(* any deficiencies in that functionality. I accept no liability whatsoever   *)
(* for any deaths or injuries resulting from the use of this definition mo-   *)
(* dule or any program derived from it in whole or in part. Insurrections,    *)
(* terrorist strikes, acts of war or any domestic or international violence   *)
(* which can be shown to be directly or indirectly related to the functional- *)
(* ity or the lack therof of this definition module shall not be construed as *)
(* an admission of liability on my part: the blame in such cases rests solely *)
(* with the user.  In such cases, the user is responsible for easing world    *)
(* tensions and avoiding a conventional, biological, chemical and/or nuclear  *)
(* retaliation by the jingoistic extremist elements of the offended factions. *)
(*                                                                            *)
(******************************************************************************)
(*                                                                            *)
(*    Feel free to experiment with the procedures below: you never know till  *)
(* you try...                                                                 *)
(*                                                                            *)
(******************************************************************************)

DEFINITION MODULE ModulaTools;

FROM DiskFontLibrary IMPORT AvailFontsHeaderPtr;
FROM GraphicsBase    IMPORT GfxBasePtr;
FROM GraphicsLibrary IMPORT BitMapPtr, DrawingModeSet;
FROM Intuition       IMPORT ScreenPtr, ScreenFlagSet, WindowPtr, WindowFlags,
                            WindowFlagSet,  SmartRefresh,IDCMPFlags,
                            IDCMPFlagSet,MenuPtr, MenuFlags, MenuFlagSet,
                            MenuItemPtr, ItemFlags, ItemFlagSet,
                            IntuitionBasePtr, IntuitionTextPtr, IntuiMessagePtr;
FROM Libraries       IMPORT LibraryPtr;
FROM Menus           IMPORT HighComp;
FROM Strings         IMPORT String;
FROM SYSTEM          IMPORT ADDRESS;
FROM Views           IMPORT Modes, ModeSet;
FROM Text            IMPORT TextAttrPtr;


CONST
   NoTitle = 0C;                      (* no title for screen and/or window *)

VAR
   ViewFeatures    : ModeSet;         (* ViewPort type and capabilities    *)
   ScreenBitMap    : BitMapPtr;       (* custom Screen bitmap, if desired  *)
   ScreenFeatures  : ScreenFlagSet;   (* Screen type and capabilities      *)
   TextPen         : INTEGER;         (* color of text drawn in Screen     *)
   FillPen         : INTEGER;         (* color of background in Screen     *)
   MinWindowWide   : INTEGER;         (* minimum width  of next Window     *)
   MaxWindowWide   : INTEGER;         (* maximum width  of next Window     *)
   MinWindowHigh   : INTEGER;         (* minimum height of next Window     *)
   MaxWindowHigh   : INTEGER;         (* maximum height of next Windwo     *)
   WindowBitMap    : BitMapPtr;       (* custom Window bitmap, if desired  *)
   WindowFeatures  : WindowFlagSet;   (* Window type and capabilities      *)
   IDCMPFeatures   : IDCMPFlagSet;    (* types of Intuition messages wanted*)
   UserIntuiBase   : IntuitionBasePtr;(* address of IntuitionBase          *)
   UserGraphBase   : GfxBasePtr;      (* address of GraphicsBase           *)


   PROCEDURE OpenGraphics () : BOOLEAN;

   PROCEDURE CreateScreen (Left, Top, Wide, High : INTEGER;   (* Input *)
                           Bitplanes             : INTEGER;   (* Input *)
                           VAR ScreenTitle       : String)    : ScreenPtr;

   PROCEDURE CreateWindow (Left, Top, Wide, High : INTEGER;   (* Input *)
                           VAR WindowTitle       : String;    (* Input *)
                           UserScreen            : ScreenPtr) : WindowPtr;

   PROCEDURE CloseGraphics ();


          (* Variables reset in PROCEDURE OpenGraphics (): *)

(*  TextPen = 0  MinWindowWide = 30  MinWindowHigh = 20  ScreenBitMap = NULL *)
(*  FillPen = 1  MaxWindowWide =  0  MaxWindowHigh =  0  WindowBitMap = NULL *)
(*  ViewFeatures   = Empty                                                   *)
(*  ScreenFeatures = CustomScreen                                            *)
(*  IDCMPFeatures  = MenuPick, CloseWindowFlag, NewSize, GadgetUp            *)
(*  WindowFeatures = SmartRefresh, WindowSizing, WindowDrag, WindowDepth,    *)
(*                   Activate, ReportMouseFlag                               *)

(* OpenGraphics may return a value of FALSE if either the IntuitionLibrary   *)
(* or the GraphicsLibrary could not be opened. Whichever of UserIntuiBase or *)
(* UserGraphBase = NULL is the library which could not be opened. You needn't*)
(* call CloseGraphics in such a case.                                        *)

(* Both CreateScreen and CreateWindow do extensive checking to ensure that   *)
(* you don't exceed the performance limits of the Amiga. (I am FED UP with   *)
(* crashes!!) If you find any combination which doesn't work properly, I     *)
(* would appreciate your dropping me a line describing the invocation. Also, *)
(* Left and Top are measured from the upper-left corner of the display in    *)
(* CreateScreen, whereas in CreateWindow they are measured from the upper-   *)
(* left corner of the Screen in which the Window will appear.                *)

(* If UserScreen = NULL, then the Window will open in the WorkBench Screen;  *)
(* otherwise, it will open in the UserScreen.                                *)

(* ScreenBitMap and WindowBitMap are pointers to custom bitmaps. Unless you  *)
(* want to manage your own bitmaps, you should leave these alone (= NULL).   *)

(* TextPen and FillPen are chosen from the color palette; the number of pens *)
(* available = 2**bitplanes { or 2^bitplanes }. Any pen choice outside of    *)
(* this range results in choice wraparound, which I assume is done by ignor- *)
(* ing illegal higher-order bits.                                            *)

(* ViewFeatures determines the type of ViewPort in which you wish your Screen*)
(* to be rendered. Setting this to the appropriate value allows you to obtain*)
(* high-resolution, interlaced, HAM, ExtraHalfBright, etc. ViewPorts.        *)

(* ScreenFeatures determines how the Screen will appear in the display and   *)
(* whether or not the new Screen will be a CustomScreen.                     *)

(* WindowFeatures determines how the Window will appear in the display,what  *)
(* type of Gadgets you wish attached to it and how it will be refreshed.     *)

(* MinWindowWide, MaxWindowWide, MinWindowHigh and MaxWindowHigh are only of *)
(* use if the Window has a sizing gadget: INCL(WindowFeatures, WindowSizing).*)
(* If any of these is set to 0, then the limit of that dimension will be the *)
(* current dimension of the Window.                                          *)

(* IDCMPFeatures determines which messages your Window will receive from In- *)
(* tuition. If your program isn't responding to certain gadgets or events,   *)
(* check that you have included the proper notification flags here.          *)

(* CloseGraphics should not be called until you close ALL the Windows and    *)
(* Screens opened with the above procedures. Otherwise...                    *)

(* If you want to open Windows and/or Screens without using these procedures,*)
(* you should assign IntuitionBase and GraphicsBase to UserIntuiBase and     *)
(* UserGraphBase, resp. This allows you to use the libraries opened in the   *)
(* procedure OpenGraphics as opposed to opening your own versions of these   *)
(* libraries.                                                                *)

(* The order in which these procedures is called is as follows: OpenGraphics,*)
(* {{CreateScreen}, {CreateWindow}}, CloseGraphics.                          *)




VAR
   FrontTextPen : INTEGER;   (* these pens are chosen from the screen pen- *)
   BackTextPen  : INTEGER;   (* palette; e.g., 3 bit planes = 8 pens (0-7);*)
   CurrentFont  : TextAttrPtr;       (* in case you want a different font; *)
   LastText     : IntuitionTextPtr;  (* connect current text to last text; *)
   TextDrawMode : DrawingModeSet;             (* method used to draw text; *)


   PROCEDURE GetIntuiText     (TextItem          : String;        (* Input *)
                               TextLeft, TextTop : INTEGER;       (* Input *)
                               VAR IntuiText     : IntuitionTextPtr);

   PROCEDURE DestroyIntuiText (VAR IntuiText     : IntuitionTextPtr;
                               DestroyAllText    : BOOLEAN);


        (* Default values upon importing this module: *)
        (* FrontTextPen =  0    CurrentFont = NULL    *)
        (* BackTextPen  =  1    LastText    = NULL    *)
        (* TextDrawMode = Jam2                        *)

    (* GetIntuiText returns an IntuitionText structure containing the    *)
    (* desired text. TextLeft and TextTop are the pixel positions where  *)
    (* the lower-left corner of the text will be placed. If LastText <>  *)
    (* NULL, then LastText will point to IntuiText, thus creating a      *)
    (* linked list of IntuitionText structures. Just call GetIntuiText,  *)
    (* assign LastText to IntuiText and call GetIntuiText again.         *)

    (* LastText is set to NULL following the call to GetIntuiText.       *)

    (* DestroyIntuiText DISPOSEs of IntuitionText: If DestroyAllText is  *)
    (* TRUE, then it also DISPOSEs of all IntuitionText forward-linked   *)
    (* to IntuiText. If DestroyAllText is FALSE, then only the Intuition-*)
    (* Text pointed to by IntuiText is DISPOSEd. If IntuiText is forward-*)
    (* linked to other IntuitionText upon entry to this procedure, then, *)
    (* upon return, IntuiText will point to the next IntuitionText in the*)
    (* linked list.                                                      *)



VAR
   UserDiskFontBase  : LibraryPtr;      (* entry point into DiskFont library *)


   PROCEDURE GetAndSortAllFonts (VAR FontBuffer : AvailFontsHeaderPtr): BOOLEAN;

   PROCEDURE ReturnFontResourcesToSystem (VAR FontBuffer : AvailFontsHeaderPtr);


 (* GetAndSortAllFonts returns an array of AvailFonts structures, each of    *)
 (* which contains a TextAttr structure and a flag informing whether the     *)
 (* font resides in memory or on disk. The array contains data for the ROM   *)
 (* fonts and all fonts in the FONTS: directory. The array is sorted by name *)
 (* and also by point-size for fonts with identical names. Thus, the list on *)
 (* the left would be returned in the order shown on the right:              *)
 (*                                                                          *)
 (*   9 point  diamond.font                   9 point  diamond.font          *)
 (*  12 point  ruby.font                      9 point  garnet.font           *)
 (*   8 point  topaz.font                    16 point  garnet.font           *)
 (*   9 point  topaz.font                    12 point  ruby.font             *)
 (*  19 point  sapphire.font                 19 point  sapphire.font         *)
 (*  11 point  topaz.font                     8 point  topaz.font            *)
 (*   9 point  garnet.font                    9 point  topaz.font            *)
 (*  16 point  garnet.font                   11 point  topaz.font            *)
 (*                                                                          *)
 (* After calling GetAndSortAllFonts, you must call OpenFont or OpenDiskFont *)
 (* to allow your program to load and utilize the available fonts.           *)

 (* ReturnFontResourcesToSystem should be called when you are finished with  *)
 (* the FontBuffer. Also, you must call ReturnFontResourcesToSystem prior to *)
 (* calling GetAndSortAllFonts again. However, unless you reassign the FONTS:*)
 (* directory, there is little need to call GetAndSortAllFonts more than     *)
 (* once. ReturnFontResourcesToSystem closes the DiskFont library which Get- *)
 (* AndSortAllFonts opened (and which you may access via UserDiskFontBase),  *)
 (* and DEALLOCATES the memory used by FontBuffer. Prior to calling Return-  *)
 (* FontResourcesToSystem, you should call CloseFont and RemFont for each    *)
 (* font that your program has opened. This ensures that all font-management *)
 (* resources used by the system are released.                               *)



CONST                  (* set Commandkey to this if you do not want a    *)
   NoKey  = " ";       (* key-equivalent for the current Item or SubItem *)

                    (* common assignments for ItemSetting & MenuSetting: *)
CONST
   Checkable = ItemFlagSet{CheckIt, MenuToggle};
   CheckNow  = ItemFlagSet{Checked};              (* requires Checkable  *)
   ItemOn    = ItemFlagSet{ItemEnabled} + HighComp;
   ItemOff   = ItemFlagSet{};
   MenuOn    = MenuFlagSet{MenuEnabled}; (* default value of MenuSetting *)
   MenuOff   = MenuFlagSet{};

VAR
   FirstMenu      : MenuPtr;        (* pointer to first Menu in Menu bar *)
   CurrentMenu    : MenuPtr;        (* current Menu    in Menu bar       *)
   CurrentItem    : MenuItemPtr;    (* current Item    in Menu bar       *)
   CurrentSubItem : MenuItemPtr;    (* current SubItem in Menu bar       *)
   LoneMenuStrip  : MenuPtr;        (* unattached, DISPOSEable MenuStrip *)
   SelectText     : String;         (* (Sub)Item text shown if selected  *)
   VerPixPerChar  : CARDINAL;       (* vertical   pixels per character   *)
   HorPixPerChar  : CARDINAL;       (* horizontal pixels per character   *)
   MenuSetting    : MenuFlagSet;    (* characteristics of current Menu   *)
   HiResScreen    : BOOLEAN;        (* high resolution screen?           *)
   AutoIndent     : BOOLEAN;        (* shift (Sub)Items to right?        *)
   RightJustify   : BOOLEAN;        (* extend select boxes to right?     *)
   Left, Top      : INTEGER;        (* left & top location and width &   *)
   Wide, High     : INTEGER;        (* height of current Menu, (Sub)Item *)
   NewItemColumn  : BOOLEAN;        (* flag: start new (Sub)Item column? *)

                                    (* all of these parameters are inputs *)
   PROCEDURE InitializeMenuStrip;

   PROCEDURE AddMenu    (MenuBarText : String);

   PROCEDURE AddItem    (ItemText    : String;
                         Commandkey  : CHAR;
                         ItemSetting : ItemFlagSet;
                         Exclusion   : LONGINT);

   PROCEDURE AddSubItem (SubItemText : String;
                         Commandkey  : CHAR;
                         ItemSetting : ItemFlagSet;
                         Exclusion   : LONGINT);

   PROCEDURE DestroyMenuStrip (WindowPointer : WindowPtr);


         (* Variables reset in PROCEDURE InitializeMenuStrip : *)

         (* CurrentMenu = NULL    MenuSetting   = MenuOn       *)
         (* FirstMenu   = NULL    AutoIndent    = FALSE        *)
         (* SelectText  = NoText  HorPixPerChar = 8            *)
         (* MenuLeft    = 0       VerPixPerChar = 8            *)
         (* HiResScreen = FALSE   RightJustify  = TRUE         *)

 (* ItemSetting := Checkable + CheckNow --> this (Sub)Item can be and is  *)
 (* now checked; the routines above automatically set the ItemText flag.  *)

 (* Left, Top, Wide & High are recalculated in each subroutine to yield   *)
 (* a pleasing MenuStrip; if you dislike it, you may change them prior to *)
 (* calling AddMenu, AddItem and/or AddSubItem; also, Left & Wide affect  *)
 (* the placement of text in AddMenu but affect the placement and size    *)
 (* of the select boxes in AddItem and AddSubItem;                        *)

 (* To what are Left, Top, Wide and High measured relative? For Menus,    *)
 (* they are relative to the upper-left corner of the Screen. For Items,  *)
 (* they are relative to the lower-left corner of the Menu. For SubItems, *)
 (* they are relative to the lower-left corner of the Item.               *)

 (* If AutoIndent = TRUE, all Items under the CurrentMenu (or all SubItems*)
 (* under the CurrentItem) will be shifted to the right to allow for a    *)
 (* checkmark. If AutoIndent = FALSE, then only those (Sub)Items which    *)
 (* request a checkmark in ItemSetting will be shifted to the right. The  *)
 (* amount of space added to the left of the select box depends upon the  *)
 (* value of HiresScreen.                                                 *)

 (* If RightJustify is TRUE, then the right edge of each Item extends to  *)
 (* the edge of its Menu. Otherwise, the right edge of each Item is deter-*)
 (* mined by the width of the longest Item in the current Item-column.    *)
 (* This is of most use when multiple Item-columns are desired: setting   *)
 (* RightJustify to FALSE ensures that the first column of Items isn't    *)
 (* excessively wide.                                                     *)

 (* If CommandKey <> NoKey, then space will be added to the right of the  *)
 (* (Sub)Item's select box according to the value of HiresScreen.         *)

 (* In addition, TextFlag is included in all Itemsetting values above,    *)
 (* since these routines are designed to create text Menus and (Sub)Items.*)

 (* HorPixPerChar and VerPixPerChar are used to determine the width and   *)
 (* height of the Menus, Items and SubItems. You may change these values  *)
 (* to quickly obtain larger select boxes.                                *)

 (* SelectText allows you to specify a different text be displayed when   *)
 (* the (Sub)Item is chosen, though it prevents use of other highlighting.*)
 (* SelectText = NoText upon exit from each of the above four procedures. *)
 (* As stated above, Left, Wide, Top and High are reset or recalculated   *)
 (* prior to exit from the above four routines. Don't change these values *)
 (* unless you know where you want a specific Menu or (Sub)Item placed.   *)

 (* CurrentMenu, CurrentItem and CurrentSubItem point to the Menu, Item   *)
 (* or SubItem, respectively, which was just added to the MenuStrip. Thus,*)
 (* if you require access to a particular node in the MenuStrip, you may  *)
 (* copy these pointers as needed following the call to AddMenu, AddItem  *)
 (* or AddSubItem.                                                        *)

 (* DestroyMenuStrip is designed to remove a MenuStrip from a Window and  *)
 (* DISPOSE of its Menus, Items and SubItems, as well as the IntuitionText*)
 (* structures to which they point. ANY non-NULL pointer in the MenuStrip *)
 (* has its contents DISPOSED. If you wish only to DISPOSE of a MenuStrip *)
 (* (one that is not attached to a Window), then set WindowPointer to NULL*)
 (* and assign LoneMenuStrip to the MenuStrip of which to DISPOSE. Just   *)
 (* prior to exit, DestroyMenuStrip calls InitializeMenuStrip. Thus, you  *)
 (* need only call InitializeMenuStrip for the first MenuStrip and if you *)
 (* want multiple MenuStrips defined at one time. I didn't call the pro-  *)
 (* cedure in the module body because it looked unusual to call it for the*)
 (* second and subsequent concurrent MenuStrips but not the first.        *)

 (* You can easily create multiple MenuStrips by calling InitializeMenu-  *)
 (* Strip once for each MenuStrip. Be sure to save the value of FirstMenu *)
 (* prior to the call, as that is the pointer to the first Menu of the    *)
 (* current MenuStrip.                                                    *)

 (* Since the IntuiText routines above are used to create the Intuition-  *)
 (* Text structures for the MenuStrip, you may change the values of the   *)
 (* global variables associated with those routines to obtain different   *)
 (* colors and fonts for your MenuStrip.                                  *)

 (* Be sure to add at least one Item to each Menu to prevent a crash.     *)

 (* In case you haven't figured it out, the order in which you call these *)
 (* routines is as follows:  InitializeMenuStrip, {AddMenu,  AddItem,     *)
 (* {AddSubItem}, {AddItem, {AddSubItem}}}, DestroyMenuStrip.             *)




TYPE
   ChoiceType = RECORD
                   MenuChosen    : CARDINAL;
                   ItemChosen    : CARDINAL;
                   SubItemChosen : CARDINAL;
                   ChoicePointer : MenuItemPtr;
                END; (* ChoiceType *)


   PROCEDURE GotMessage     (VAR IMessage   : IntuiMessagePtr;
                             CurrentWindow  : WindowPtr)     : BOOLEAN;

   PROCEDURE GetMenuChoice  (MenuSelection  : CARDINAL;        (* Input  *)
                             FirstMenu      : MenuPtr;         (* Input  *)
                             VAR MenuChoice : ChoiceType);     (* Output *)

 (* GotMessage quickly copies any message from Intuition and returns the *)
 (* original to Intuition. This helps reduce the number of IntuiMessages *)
 (* Intuition allocates. Since Intuition doesn't deallocate them unless  *)
 (* it is reinitialized, this is definitely a desireable practice. Also, *)
 (* Imessage is DISPOSEd of if it is non-NULL upon entering GotMessage.  *)
 (* This means you don't have to worry about disposing of the copies of  *)
 (* the Intuition messages, either. If IMessage^.Class = MenuPick, then  *)
 (* you may obtain the (Sub)Item chosen by calling GetMenuChoice. If no  *)
 (* message was pending from Intuition, then GotMessage returns FALSE.   *)
 (* CurrentWindow is the only input, pointing to the Window in which you *)
 (* wish to determine whether an Intuition message is pending.           *)

 (* GetMenuChoice determines the FIRST (Sub)Item chosen, and returns a   *)
 (* a pointer to it. Be certain to check the NextSelect field of the cho-*)
 (* sen (Sub)Item, as it is possible to click-select or drag-select mul- *)
 (* tiple choices before releasing the right mousebutton. Thus, MenuSe-  *)
 (* lection will be either IMessage^.Code or ChoicePointer^.NextSelect.  *)




   (* These color values are from p.294 of the Amiga Programmer's Handbook *)
   (*  Vol. 1 by Eugene P. Mortimore; Sybex, Inc., Berkeley; 1987.         *)

CONST
   White     = 0FFFH;    GoldenOrange  = 0FB0H;    LightAqua = 01FBH;
   BrickRed  = 0D00H;    CadmiumYellow = 0FD0H;    SkyBlue   = 06FEH;
   Red       = 0F00H;    LemonYellow   = 0FF0H;    LightBlue = 06CEH;
   RedOrange = 0F80H;    ForestGreen   = 00B1H;    Blue      = 000FH;
   Orange    = 0F90H;    LightGreen    = 08E0H;    Purple    = 091FH;
   LimeGreen = 0BF0H;    BrightBlue    = 061FH;    Violet    = 0C1FH;
   Green     = 00F0H;    DarkBlue      = 006DH;    Pink      = 0FACH;
   DarkGreen = 02C0H;    MediumGrey    = 0999H;    Tan       = 0DB9H;
   BlueGreen = 00BBH;    LightGrey     = 0CCCH;    Brown     = 0C80H;
   Aqua      = 00DBH;    Magenta       = 0F1FH;    DarkBrown = 0A87H;
   Black     = 0000H;
   MaxColors = 32;     (* # of colors to load when calling SetScreenColors *)

VAR
   ScreenColors : ARRAY [0..MaxColors-1] OF CARDINAL;


   PROCEDURE SetScreenColors (CurrentScreen : ScreenPtr);


 (* SetScreenColors assigns ScreenColors to the color registers of Current- *)
 (* Screen. Though ScreenColors is assigned values upon import of this mo-  *)
 (* dule, I have spent little time determining which combinations are aes-  *)
 (* thetically appealing. Thus, don't count on ScreenColors having the same *)
 (* default values in later versions of this module.                        *)

END ModulaTools.