瀏覽代碼

MorphOS: Added GadTools Library unit

git-svn-id: trunk@32641 -
marcus 9 年之前
父節點
當前提交
9346746c67
共有 3 個文件被更改,包括 514 次插入0 次删除
  1. 1 0
      .gitattributes
  2. 1 0
      packages/morphunits/fpmake.pp
  3. 512 0
      packages/morphunits/src/gadtools.pas

+ 1 - 0
.gitattributes

@@ -5812,6 +5812,7 @@ packages/morphunits/src/cybergraphics.pas svneol=native#text/plain
 packages/morphunits/src/datatypes.pas svneol=native#text/plain
 packages/morphunits/src/diskfont.pas svneol=native#text/plain
 packages/morphunits/src/exec.pas svneol=native#text/plain
+packages/morphunits/src/gadtools.pas svneol=native#text/pascal
 packages/morphunits/src/get9.pas svneol=native#text/plain
 packages/morphunits/src/hardware.pas svneol=native#text/plain
 packages/morphunits/src/iffparse.pas svneol=native#text/plain

+ 1 - 0
packages/morphunits/fpmake.pp

@@ -55,6 +55,7 @@ begin
     T:=P.Targets.AddUnit('diskfont.pas');
     T:=P.Targets.AddUnit('cybergraphics.pas');
     T:=P.Targets.AddUnit('cgxvideo.pas');
+    T:=P.Targets.AddUnit('gadtools.pas');
 
 {$ifndef ALLPACKAGES}
     Run;

+ 512 - 0
packages/morphunits/src/gadtools.pas

@@ -0,0 +1,512 @@
+{
+    This file is part of the Free Pascal run time library.
+
+    A file in Amiga system run time library.
+    Copyright (c) 1998-2003 by Nils Sjoholm
+    member of the Amiga RTL development team.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$PACKRECORDS 2}
+
+unit gadtools;
+
+INTERFACE
+
+uses exec, intuition, agraphics, utility;
+
+
+{------------------------------------------------------------------------}
+
+{  The kinds (almost classes) of gadgets in the toolkit.  Use these
+    identifiers when calling CreateGadgetA() }
+
+CONST
+ GENERIC_KIND  =  0;
+ BUTTON_KIND   =  1;
+ CHECKBOX_KIND =  2;
+ INTEGER_KIND  =  3;
+ LISTVIEW_KIND =  4;
+ MX_KIND       =  5;
+ NUMBER_KIND   =  6;
+ CYCLE_KIND    =  7;
+ PALETTE_KIND  =  8;
+ SCROLLER_KIND =  9;
+{ Kind number 10 is reserved }
+ SLIDER_KIND   =  11;
+ STRING_KIND   =  12;
+ TEXT_KIND     =  13;
+
+ NUM_KINDS     =  14;
+
+ GADTOOLSNAME   : PChar = 'gadtools.library';
+
+
+{------------------------------------------------------------------------}
+
+{  'Or' the appropriate set together for your Window IDCMPFlags: }
+
+ ARROWIDCMP    =  (IDCMP_GADGETUP + IDCMP_GADGETDOWN +
+                   IDCMP_INTUITICKS + IDCMP_MOUSEBUTTONS);
+
+ BUTTONIDCMP   =  (IDCMP_GADGETUP);
+ CHECKBOXIDCMP =  (IDCMP_GADGETUP);
+ INTEGERIDCMP  =  (IDCMP_GADGETUP);
+ LISTVIEWIDCMP =  (IDCMP_GADGETUP + IDCMP_GADGETDOWN +
+                   IDCMP_MOUSEMOVE + ARROWIDCMP);
+
+ MXIDCMP       =  (IDCMP_GADGETDOWN);
+ NUMBERIDCMP   =  0;
+ CYCLEIDCMP    =  (IDCMP_GADGETUP);
+ PALETTEIDCMP  =  (IDCMP_GADGETUP);
+
+{  Use ARROWIDCMP+SCROLLERIDCMP if your scrollers have arrows: }
+ SCROLLERIDCMP =  (IDCMP_GADGETUP + IDCMP_GADGETDOWN + IDCMP_MOUSEMOVE);
+ SLIDERIDCMP   =  (IDCMP_GADGETUP + IDCMP_GADGETDOWN + IDCMP_MOUSEMOVE);
+ STRINGIDCMP   =  (IDCMP_GADGETUP);
+
+ TEXTIDCMP     =  0;
+
+
+{------------------------------------------------------------------------}
+
+{  Generic NewGadget used by several of the gadget classes: }
+
+Type
+   pNewGadget = ^tNewGadget;
+   tNewGadget = record
+    ng_LeftEdge, ng_TopEdge : smallint;     {  gadget position }
+    ng_Width, ng_Height     : smallint;     {  gadget size }
+    ng_GadgetText           : STRPTR;      {  gadget label }
+    ng_TextAttr             : pTextAttr;   {  desired font for gadget label }
+    ng_GadgetID             : Word;        {  gadget ID }
+    ng_Flags                : ULONG;       {  see below }
+    ng_VisualInfo           : Pointer;     {  Set to retval of GetVisualInfo() }
+    ng_UserData             : Pointer;     {  gadget UserData }
+   END;
+
+
+{  ng_Flags control certain aspects of the gadget.  The first five control
+    the placement of the descriptive text.  All larger groups supply a
+    default: }
+
+CONST
+ PLACETEXT_LEFT  = $0001;  { Right-align text on left side }
+ PLACETEXT_RIGHT = $0002;  { Left-align text on right side }
+ PLACETEXT_ABOVE = $0004;  { Center text above }
+ PLACETEXT_BELOW = $0008;  { Center text below }
+ PLACETEXT_IN    = $0010;  { Center text on }
+
+ NG_HIGHLABEL    = $0020;  { Highlight the label }
+
+{------------------------------------------------------------------------}
+
+{ Fill out an array of these and pass that to CreateMenus(): }
+
+Type
+   pNewMenu = ^tNewMenu;
+   tNewMenu = record
+    nm_Type           : Byte;              {  See below }
+    nm_Label          : STRPTR;            {  Menu's label }
+    nm_CommKey        : STRPTR;            {  MenuItem Command Key Equiv }
+    nm_Flags          : Word;              {  Menu OR MenuItem flags (see note) }
+    nm_MutualExclude  : Longint;           {  MenuItem MutualExclude word }
+    nm_UserData       : Pointer;           {  For your own use, see note }
+   END;
+
+const
+{ Needed only by inside IM_ definitions below }
+ MENU_IMAGE     = 128;
+
+{ nm_Type determines what each NewMenu structure corresponds to.
+ * for the NM_TITLE, NM_ITEM, and NM_SUB values, nm_Label should
+ * be a text string to use for that menu title, item, or sub-item.
+ * For IM_ITEM or IM_SUB, set nm_Label to point at the Image structure
+ * you wish to use for this item or sub-item.
+ * NOTE: At present, you may only use conventional images.
+ * Custom images created from Intuition image-classes do not work.
+ }
+ NM_TITLE      =  1;       { Menu header }
+ NM_ITEM       =  2;       { Textual menu item }
+ NM_SUB        =  3;       { Textual menu sub-item }
+
+ IM_ITEM       =  (NM_ITEM OR MENU_IMAGE);    { Graphical menu item }
+ IM_SUB        =  (NM_SUB OR MENU_IMAGE);     { Graphical menu sub-item }
+
+{ The NewMenu array should be terminated with a NewMenu whose
+ * nm_Type equals NM_END.
+ }
+ NM_END        =  0;       { End of NewMenu array }
+
+{ Starting with V39, GadTools will skip any NewMenu entries whose
+ * nm_Type field has the NM_IGNORE bit set.
+ }
+ NM_IGNORE     =  64;
+
+
+{ nm_Label should be a text string for textual items, a pointer
+ * to an Image structure for graphical menu items, or the special
+ * constant NM_BARLABEL, to get a separator bar.
+ }
+ NM_BARLABEL   = -1;
+
+{ The nm_Flags field is used to fill out either the Menu->Flags or
+ * MenuItem->Flags field.  Note that the sense of the MENUENABLED or
+ * ITEMENABLED bit is inverted between this use and Intuition's use,
+ * in other words, NewMenus are enabled by default.  The following
+ * labels are provided to disable them:
+ }
+ NM_MENUDISABLED = MENUENABLED;
+ NM_ITEMDISABLED = ITEMENABLED;
+
+{ New for V39:  NM_COMMANDSTRING.  For a textual MenuItem or SubItem,
+ * point nm_CommKey at an arbitrary string, and set the NM_COMMANDSTRING
+ * flag.
+ }
+ NM_COMMANDSTRING = COMMSEQ;
+
+{ The following are pre-cleared (COMMSEQ, ITEMTEXT, and HIGHxxx are set
+ * later as appropriate):
+ * Under V39, the COMMSEQ flag bit is not cleared, since it now has
+ * meaning.
+ }
+ NM_FLAGMASK    = NOT (COMMSEQ OR ITEMTEXT OR HIGHFLAGS);
+ NM_FLAGMASK_V39 = NOT (ITEMTEXT OR HIGHFLAGS);
+
+{ You may choose among CHECKIT, MENUTOGGLE, and CHECKED.
+ * Toggle-select menuitems are of type CHECKIT|MENUTOGGLE, along
+ * with CHECKED if currently selected.  Mutually exclusive ones
+ * are of type CHECKIT, and possibly CHECKED too.  The nm_MutualExclude
+ * is a bit-wise representation of the items excluded by this one,
+ * so in the simplest case (choose 1 among n), these flags would be
+ * ~1, ~2, ~4, ~8, ~16, etc.  See the Intuition Menus chapter.
+ }
+
+{ A UserData pointer can be associated with each Menu and MenuItem structure.
+ * The CreateMenus() call allocates space for a UserData after each
+ * Menu or MenuItem (header, item or sub-item).  You should use the
+ * GTMENU_USERDATA() or GTMENUITEM_USERDATA() macro to extract it.
+ }
+
+const
+{ These return codes can be obtained through the GTMN_SecondaryError tag }
+ GTMENU_TRIMMED = $00000001;      { Too many menus, items, or subitems,
+                                         * menu has been trimmed down
+                                         }
+ GTMENU_INVALID = $00000002;      { Invalid NewMenu array }
+ GTMENU_NOMEM   = $00000003;      { Out of memory }
+
+{------------------------------------------------------------------------}
+
+{ Starting with V39, checkboxes and mx gadgets can be scaled to your
+ * specified gadget width/height.  Use the new GTCB_Scaled or GTMX_Scaled
+ * tags, respectively.  Under V37, and by default in V39, the imagery
+ * is of the following fixed size:
+ }
+
+{ MX gadget default dimensions: }
+ MX_WIDTH      =  17;
+ MX_HEIGHT     =  9;
+
+{ Checkbox default dimensions: }
+ CHECKBOX_WIDTH  = 26;
+ CHECKBOX_HEIGHT = 11;
+
+{------------------------------------------------------------------------}
+
+
+{------------------------------------------------------------------------}
+
+{  Tags for GadTools functions: }
+CONST
+ GT_TagBase        =   TAG_USER + $80000;
+
+ GTVI_NewWindow    =   GT_TagBase+1;  { Unused }
+ GTVI_NWTags       =   GT_TagBase+2;  { Unused }
+
+ GT_Private0       =   GT_TagBase+3;  { (private) }
+
+ GTCB_Checked      =   GT_TagBase+4;  { State of checkbox }
+
+ GTLV_Top          =   GT_TagBase+5;  { Top visible one in listview }
+ GTLV_Labels       =   GT_TagBase+6;  { List to display in listview }
+ GTLV_ReadOnly     =   GT_TagBase+7;  { TRUE IF listview is to be
+                                              read-only }
+ GTLV_ScrollWidth  =   GT_TagBase+8;  { Width of scrollbar }
+
+ GTMX_Labels       =   GT_TagBase+9;  { NULL-terminated array of labels }
+ GTMX_Active       =   GT_TagBase+10; { Active one in mx gadget }
+
+ GTTX_Text         =   GT_TagBase+11; { Text to display }
+ GTTX_CopyText     =   GT_TagBase+12; { Copy text label instead of
+                                              referencing it }
+
+ GTNM_Number       =   GT_TagBase+13; { Number to display }
+
+ GTCY_Labels       =   GT_TagBase+14; { NULL-terminated array of labels }
+ GTCY_Active       =   GT_TagBase+15; { The active one in the cycle gad }
+
+ GTPA_Depth        =   GT_TagBase+16; { Number of bitplanes in palette }
+ GTPA_Color        =   GT_TagBase+17; { Palette color }
+ GTPA_ColorOffset  =   GT_TagBase+18; { First color to use in palette }
+ GTPA_IndicatorWidth = GT_TagBase+19; { Width of current-color indicator }
+ GTPA_IndicatorHeight = GT_TagBase+20; { Height of current-color indicator }
+
+ GTSC_Top          =   GT_TagBase+21; { Top visible in scroller }
+ GTSC_Total        =   GT_TagBase+22; { Total in scroller area }
+ GTSC_Visible      =   GT_TagBase+23; { Number visible in scroller }
+ GTSC_Overlap      =   GT_TagBase+24; { Unused }
+
+{  GT_TagBase+25 through GT_TagBase+37 are reserved }
+
+ GTSL_Min          =   GT_TagBase+38; { Slider min value }
+ GTSL_Max          =   GT_TagBase+39; { Slider max value }
+ GTSL_Level        =   GT_TagBase+40; { Slider level }
+ GTSL_MaxLevelLen  =   GT_TagBase+41; { Max length of printed level }
+ GTSL_LevelFormat  =   GT_TagBase+42; { Format string for level }
+ GTSL_LevelPlace   =   GT_TagBase+43; { Where level should be placed }
+ GTSL_DispFunc     =   GT_TagBase+44; { Callback for number calculation
+                                              before display }
+
+ GTST_String       =   GT_TagBase+45; { String gadget's displayed string }
+ GTST_MaxChars     =   GT_TagBase+46; { Max length of string }
+
+ GTIN_Number       =   GT_TagBase+47; { Number in integer gadget }
+ GTIN_MaxChars     =   GT_TagBase+48; { Max number of digits }
+
+ GTMN_TextAttr     =   GT_TagBase+49; { MenuItem font TextAttr }
+ GTMN_FrontPen     =   GT_TagBase+50; { MenuItem text pen color }
+
+ GTBB_Recessed     =   GT_TagBase+51; { Make BevelBox recessed }
+
+ GT_VisualInfo     =   GT_TagBase+52; { result of VisualInfo call }
+
+ GTLV_ShowSelected =   GT_TagBase+53; { show selected entry beneath
+                listview, set tag data = NULL for display-only, or pointer
+                to a string gadget you've created }
+ GTLV_Selected     =   GT_TagBase+54; { Set ordinal number of selected
+                                              entry in the list }
+ GT_Reserved0      =   GT_TagBase+55; { Reserved }
+ GT_Reserved1      =   GT_TagBase+56; { Reserved for future use }
+
+ GTTX_Border       =   GT_TagBase+57; { Put a border around
+                                              Text-display gadgets }
+ GTNM_Border       =   GT_TagBase+58; { Put a border around
+                                              Number-display gadgets }
+
+ GTSC_Arrows       =   GT_TagBase+59; { Specify size of arrows for
+                                              scroller }
+
+ GTMN_Menu         =   GT_TagBase+60; { Pointer to Menu for use by
+                                              LayoutMenuItems() }
+ GTMX_Spacing      =   GT_TagBase+61; { Added to font height to
+                figure spacing between mx choices.  Use this instead
+                of LAYOUTA_SPACING for mx gadgets. }
+
+{ New to V37 GadTools.  Ignored by GadTools V36 }
+ GTMN_FullMenu     =   GT_TagBase+62; { Asks CreateMenus() to
+                validate that this is a complete menu structure }
+ GTMN_SecondaryError =  GT_TagBase+63; { ti_Data is a pointer
+                to a ULONG to receive error reports from CreateMenus() }
+ GT_Underscore     =   GT_TagBase+64; { ti_Data points to the symbol
+                that preceeds the character you'd like to underline in a
+                gadget label }
+
+{ New to V39 GadTools.  Ignored by GadTools V36 and V37 }
+ GTMN_Checkmark     =  GT_TagBase+65; { ti_Data is checkmark img to use }
+ GTMN_AmigaKey      =  GT_TagBase+66; { ti_Data is Amiga-key img to use }
+ GTMN_NewLookMenus  =  GT_TagBase+67; { ti_Data is boolean }
+
+{ New to V39 GadTools.  Ignored by GadTools V36 and V37.
+ * Set to TRUE if you want the checkbox or mx image scaled to
+ * the gadget width/height you specify.  Defaults to FALSE,
+ * for compatibility.
+ }
+ GTCB_Scaled         = GT_TagBase+68; { ti_Data is boolean }
+ GTMX_Scaled         = GT_TagBase+69; { ti_Data is boolean }
+
+ GTPA_NumColors      = GT_TagBase+70; { Number of colors in palette }
+
+ GTMX_TitlePlace     = GT_TagBase+71; { Where to put the title }
+
+ GTTX_FrontPen       = GT_TagBase+72; { Text color in TEXT_KIND gad }
+ GTTX_BackPen        = GT_TagBase+73; { Bgrnd color in TEXT_KIND gad }
+ GTTX_Justification  = GT_TagBase+74; { See GTJ_#? constants }
+
+ GTNM_FrontPen       = GT_TagBase+72; { Text color in NUMBER_KIND gad }
+ GTNM_BackPen        = GT_TagBase+73; { Bgrnd color in NUMBER_KIND gad }
+ GTNM_Justification  = GT_TagBase+74; { See GTJ_#? constants }
+ GTNM_Format         = GT_TagBase+75; { Formatting string for number }
+ GTNM_MaxNumberLen   = GT_TagBase+76; { Maximum length of number }
+
+ GTBB_FrameType      = GT_TagBase+77; { defines what kind of boxes
+                                            * DrawBevelBox() renders. See
+                                            * the BBFT_#? constants for
+                                            * possible values
+                                            }
+
+ GTLV_MakeVisible    = GT_TagBase+78; { Make this item visible }
+ GTLV_ItemHeight     = GT_TagBase+79; { Height of an individual item }
+
+ GTSL_MaxPixelLen    = GT_TagBase+80; { Max pixel size of level display }
+ GTSL_Justification  = GT_TagBase+81; { how should the level be displayed }
+
+ GTPA_ColorTable     = GT_TagBase+82; { colors to use in palette }
+
+ GTLV_CallBack       = GT_TagBase+83; { general-purpose listview call back }
+ GTLV_MaxPen         = GT_TagBase+84; { maximum pen number used by call back }
+
+ GTTX_Clipped        = GT_TagBase+85; { make a TEXT_KIND clip text }
+ GTNM_Clipped        = GT_TagBase+85; { make a NUMBER_KIND clip text }
+
+
+{------------------------------------------------------------------------}
+
+{ Justification types for GTTX_Justification and GTNM_Justification tags }
+ GTJ_LEFT   = 0;
+ GTJ_RIGHT  = 1;
+ GTJ_CENTER = 2;
+
+{------------------------------------------------------------------------}
+
+{ Bevel box frame types for GTBB_FrameType tag }
+ BBFT_BUTTON      = 1;  { Standard button gadget box }
+ BBFT_RIDGE       = 2;  { Standard string gadget box }
+ BBFT_ICONDROPBOX = 3;  { Standard icon drop box     }
+
+{------------------------------------------------------------------------}
+
+{ Typical suggested spacing between "elements": }
+ INTERWIDTH    =  8;
+ INTERHEIGHT   =  4;
+
+{------------------------------------------------------------------------}
+
+
+{  "NWay" is an old synonym for cycle gadgets }
+ NWAY_KIND    =   CYCLE_KIND;
+ NWAYIDCMP    =   CYCLEIDCMP;
+ GTNW_Labels  =   GTCY_Labels;
+ GTNW_Active  =   GTCY_Active;
+
+{------------------------------------------------------------------------}
+
+{ These two definitions are obsolete, but are here for backwards
+ * compatibility.  You never need to worry about these:
+ }
+ GADTOOLBIT    =  ($8000);
+{ Use this mask to isolate the user part: }
+ GADTOOLMASK   =  NOT (GADTOOLBIT);
+
+{------------------------------------------------------------------------}
+
+{ These definitions are for the GTLV_CallBack tag }
+
+{ The different types of messages that a listview callback hook can see }
+ LV_DRAW     =  $202;    { draw yourself, with state }
+
+{ Possible return values from a callback hook }
+ LVCB_OK      = 0;         { callback understands this message type    }
+ LVCB_UNKNOWN = 1;         { callback does not understand this message }
+
+{ states for LVDrawMsg.lvdm_State }
+ LVR_NORMAL           = 0; { the usual                 }
+ LVR_SELECTED         = 1; { for selected gadgets      }
+ LVR_NORMALDISABLED   = 2;         { for disabled gadgets      }
+ LVR_SELECTEDDISABLED = 8;         { disabled and selected     }
+
+Type
+{ structure of LV_DRAW messages, object is a (struct Node *) }
+ pLVDrawMsg = ^tLVDrawMsg;
+ tLVDrawMsg = record
+    lvdm_MethodID       : ULONG;       { LV_DRAW                   }
+    lvdm_RastPort       : pRastPort;   { where to render to        }
+    lvdm_DrawInfo       : pDrawInfo;   { useful to have around     }
+    lvdm_Bounds         : tRectangle;  { limits of where to render }
+    lvdm_State          : ULONG;     { how to render     }
+ end;
+
+
+VAR
+    GadToolsBase : pLibrary;
+
+FUNCTION CreateContext(glistptr : pGadget location 'a0'): pGadget; syscall GadToolsBase 114;
+FUNCTION CreateGadgetA(kind : ULONG location 'd0'; gad : pGadget location 'a0'; const ng : pNewGadget location 'a1'; const taglist : pTagItem location 'a2') : pGadget; syscall GadToolsBase 030;
+FUNCTION CreateMenusA(const newmenu : pNewMenu location 'a0'; const taglist : pTagItem location 'a1') : pMenu; syscall GadToolsBase 048;
+PROCEDURE DrawBevelBoxA(rport : pRastPort location 'a0'; left : LONGINT location 'd0'; top : LONGINT location 'd1'; width : LONGINT location 'd2'; height : LONGINT location 'd3'; const taglist : pTagItem location 'a1'); syscall GadToolsBase 120;
+PROCEDURE FreeGadgets(gad : pGadget location 'a0'); syscall GadToolsBase 036;
+PROCEDURE FreeMenus(menu : pMenu location 'a0'); syscall GadToolsBase 054;
+PROCEDURE FreeVisualInfo(vi : POINTER location 'a0'); syscall GadToolsBase 132;
+FUNCTION GetVisualInfoA(screen : pScreen location 'a0'; const taglist : pTagItem location 'a1') : POINTER; syscall GadToolsBase 126;
+PROCEDURE GT_BeginRefresh(win : pWindow location 'a0'); syscall GadToolsBase 090;
+PROCEDURE GT_EndRefresh(win : pWindow location 'a0'; complete : LONGINT location 'd0'); syscall GadToolsBase 096;
+FUNCTION GT_FilterIMsg(const imsg : pIntuiMessage location 'a1') : pIntuiMessage; syscall GadToolsBase 102;
+FUNCTION GT_GetGadgetAttrsA(gad : pGadget location 'a0'; win : pWindow location 'a1'; req : pRequester location 'a2'; const taglist : pTagItem location 'a3') : LONGINT; syscall GadToolsBase 174;
+FUNCTION GT_GetIMsg(iport : pMsgPort location 'a0') : pIntuiMessage; syscall GadToolsBase 072;
+FUNCTION GT_PostFilterIMsg(imsg : pIntuiMessage location 'a1') : pIntuiMessage; syscall GadToolsBase 108;
+PROCEDURE GT_RefreshWindow(win : pWindow location 'a0'; req : pRequester location 'a1'); syscall GadToolsBase 084;
+PROCEDURE GT_ReplyIMsg(imsg : pIntuiMessage location 'a1'); syscall GadToolsBase 078;
+PROCEDURE GT_SetGadgetAttrsA(gad : pGadget location 'a0'; win : pWindow location 'a1'; req : pRequester location 'a2'; const taglist : pTagItem location 'a3'); syscall GadToolsBase 042;
+FUNCTION LayoutMenuItemsA(firstitem : pMenuItem location 'a0'; vi : POINTER location 'a1'; const taglist : pTagItem location 'a2') : LongBool; syscall GadToolsBase 060;
+FUNCTION LayoutMenusA(firstmenu : pMenu location 'a0'; vi : POINTER location 'a1'; const taglist : pTagItem location 'a2') : LongBool; syscall GadToolsBase 066;
+
+function GTMENUITEM_USERDATA(menuitem : pMenuItem): pointer;
+function GTMENU_USERDATA(menu : pMenu): pointer;
+
+function InitGadToolsLibrary: Boolean;
+
+IMPLEMENTATION
+
+function GTMENUITEM_USERDATA(menuitem : pMenuItem): pointer;
+begin
+    GTMENUITEM_USERDATA := pointer((pMenuItem(menuitem)+1));
+end;
+
+function GTMENU_USERDATA(menu : pMenu): pointer;
+begin
+    GTMENU_USERDATA := pointer((pMenu(menu)+1));
+end;
+
+const
+    { Change VERSION and LIBVERSION to proper values }
+
+    VERSION : string[2] = '0';
+    LIBVERSION : longword = 0;
+
+var
+    GadTools_Exit : Pointer;
+
+procedure CloseGadToolsLibrary;
+begin
+    ExitProc := gadtools_exit;
+    if GadToolsBase <> nil then begin
+        CloseLibrary(GadToolsBase);
+        GadToolsBase := nil;
+    end;
+end;
+
+function InitGadToolsLibrary: Boolean;
+begin
+    InitGadToolsLibrary := False;
+    GadToolsBase := nil;
+    GadToolsBase := OpenLibrary(GADTOOLSNAME,LIBVERSION);
+    if GadToolsBase <> nil then
+    begin
+        GadTools_Exit := ExitProc;
+        ExitProc := @CloseGadToolsLibrary;
+        InitGadToolsLibrary := True;
+    end;
+end;
+
+END. (* UNIT GADTOOLS *)
+
+
+
+