IMPLEMENTATION MODULE IntuitionSupport;

(* Die Anleitungen und Erläuterungen befinden sich im Definitionsfile  *)
(* Compiler M2Amiga V4.097d                  © 1991 by Andre Wiethoff  *)

(*$ StackChk:=FALSE *)
(*$ OverflowChk:=FALSE *)
(*$ NilChk:=FALSE *)
(*$ ReturnChk:=FALSE *)
(*$ Volatile:=FALSE *)
(*$ LargeVars:=FALSE *)

FROM SYSTEM       IMPORT ADR,ADDRESS,BITSET,LONGSET,ASSEMBLE;
FROM IntuitionD   IMPORT ScreenPtr,IntuiMessagePtr,IntuiMessage,NewScreen,
                         MenuPtr,WindowPtr,IDCMPFlagSet,IDCMPFlags,IntuiText,
                         Menu,MenuItem,MenuItemFlags,MenuItemFlagSet,menuNull,
                         MenuItemPtr,IntuiTextPtr,NewWindow,ScreenFlagSet,
                         customScreen,ScreenFlags,GadgetPtr,WindowFlagSet,
                         WindowFlags,commWidth,checkWidth,menuEnabled,Image,
                         ImagePtr,RequesterPtr,Gadget,BoolInfo,boolGadget,
                         PropInfo,StringInfo,ActivationFlags,GadgetFlagSet,
                         GadgetFlags,ActivationFlagSet,propGadget,strGadget,
                         reqGadget,gzzGadget,PropInfoFlags,PropInfoFlagSet,
                         Requester,RequesterFlags,RequesterFlagSet,maxPot,
                         maxBody,knobVmin,knobHmin,IntuitionBasePtr,
                         lowCheckWidth,lowCommWidth;
FROM IntuitionL   IMPORT ModifyIDCMP,SetMenuStrip,ClearMenuStrip,OpenWindow,
                         OpenScreen,CloseScreen,CloseWindow,DrawImage,
                         IntuiTextLength,AddGadget,RemoveGadget,RefreshGList,
                         ActivateGadget,OnGadget,OffGadget,Request,AddGList,
                         EndRequest,SetDMRequest,ClearDMRequest,NewModifyProp,
                         ViewPortAddress;
FROM GraphicsD    IMPORT ViewModes,ViewModeSet,TextAttrPtr,TextAttr,jam2,
                         TextFontPtr,BitMap,FontFlagSet,FontFlags,
                         FontStyleSet,RastPortPtr,DrawModeSet,jam1,
                         FontStyles,BitMapPtr,ViewPortPtr;
FROM GraphicsL    IMPORT TextLength,BltBitMap,CloseFont,SetFont,AddFont,
                         RemFont, Move,Draw,SetAPen;
FROM DiskFontL    IMPORT OpenDiskFont;
FROM ExecL        IMPORT GetMsg,ReplyMsg,WaitPort,Forbid,Permit,CopyMem;
FROM FileSystem   IMPORT ReadBytes,WriteBytes,File;
FROM String       IMPORT Length,Copy,Concat;
FROM Heap         IMPORT AllocMem,Deallocate,Available;
FROM RememberHeap IMPORT NewRememberPtr,NewAllocRemember,NewFreeRemember,
                         CutRememberElement,SearchRememberElement,
                         GetAddress,CutRememberStructure;
FROM KeyMapD      IMPORT KeyMapPtr;
IMPORT IntuitionL;


TYPE ScreenHandlePtr = POINTER TO ScreenHandle;
     ScreenHandle    = RECORD
       screen        : ScreenPtr;
     END;


     WindowHandlePtr = POINTER TO WindowHandle;
     WindowHandle = RECORD
       window     : WindowPtr;
     END;



VAR rememberScreen,rememberWindow : NewRememberPtr;


PROCEDURE CreateScreen(width,height : INTEGER;
                       depth        : INTEGER;
                       title        : ADDRESS;
                       detailPen    : SHORTINT;
                       blockPen     : SHORTINT;
                       type         : ScreenFlagSet;
                       viewModes    : ViewModeSet;
                       defFont      : TextAttrPtr) : ScreenPtr;
VAR ns  : NewScreen;
    scr : ScreenPtr;
    sh  : ScreenHandlePtr;
BEGIN
  ns.leftEdge:=0;
  ns.topEdge:=0;
  ns.width:=width;
  ns.height:=height;
  ns.depth:=depth;
  ns.detailPen:=detailPen;
  ns.blockPen:=blockPen;
  ns.viewModes:=viewModes;
  ns.type:=type;
  ns.font:=defFont;
  ns.defaultTitle:=title;
  ns.gadgets:=NIL;
  ns.customBitMap:=NIL;
  scr:=OpenScreen(ns);
  IF scr#NIL THEN
    sh:=NewAllocRemember(rememberScreen,SIZE(ScreenHandle),FALSE);
    sh^.screen:=scr;
  END;
  RETURN scr;
END CreateScreen;



PROCEDURE CreateSimpleScreen(width,height : INTEGER;
                             depth        : INTEGER;
                             title        : ADDRESS;
                             mode         : INTEGER) : ScreenPtr;
VAR ns  : NewScreen;
    scr : ScreenPtr;
    sh  : ScreenHandlePtr;
BEGIN
  ns.width:=width;
  ns.height:=height;
  ns.depth:=depth;
  WITH ns DO
    leftEdge:=0; topEdge:=0; detailPen:=0; blockPen:=1;
    type:=customScreen; font:=NIL; defaultTitle:=title;
    gadgets:=NIL; customBitMap:=NIL;
    CASE mode OF
    |2 : viewModes:=ViewModeSet{hires};
    |3 : viewModes:=ViewModeSet{lace};
    |4 : viewModes:=ViewModeSet{hires,lace};
    ELSE
         viewModes:=ViewModeSet{};
    END;
  END;
  scr:=OpenScreen(ns);
  IF scr#NIL THEN
    sh:=NewAllocRemember(rememberScreen,SIZE(ScreenHandle),FALSE);
    sh^.screen:=scr;
  END;
  RETURN scr;
END CreateSimpleScreen;



PROCEDURE DeleteScreen(VAR screen : ScreenPtr);
VAR rem : NewRememberPtr;
    sh  : ScreenHandlePtr;
BEGIN
  IF screen#NIL THEN
    rem:=rememberScreen;
    WHILE rem#NIL DO
      sh:=GetAddress(rem);
      IF sh#NIL THEN
        IF sh^.screen=screen THEN
          CloseScreen(sh^.screen);
          CutRememberElement(rememberScreen,rem,TRUE);
        END;
      END;
      rem:=rem^.next;
    END;
  END;
  screen:=NIL;
END DeleteScreen;



PROCEDURE CreateWindow(x,y                : INTEGER;
                       width,height       : INTEGER;
                       minWidth,minHeight : INTEGER;
                       maxWidth,maxHeight : INTEGER;
                       title              : ADDRESS;
                       detailPen          : SHORTINT;
                       blockPen           : SHORTINT;
                       gadgets            : GadgetPtr;
                       idcmpFlags         : IDCMPFlagSet;
                       flags              : WindowFlagSet;
                       screenFlags        : ScreenFlagSet;
                       screen             : ScreenPtr) : WindowPtr;
VAR nw  : NewWindow;
    win : WindowPtr;
    wh  : WindowHandlePtr;
BEGIN
  WITH nw DO
    leftEdge:=x; topEdge:=y; type:=screenFlags; bitMap:=NIL; checkMark:=NIL;
  END;
  nw.width:=width;
  nw.height:=height;
  nw.detailPen:=detailPen;
  nw.blockPen:=blockPen;
  nw.idcmpFlags:=idcmpFlags;
  nw.flags:=flags;
  nw.firstGadget:=gadgets;
  nw.title:=title;
  nw.screen:=screen;
  nw.minWidth:=minWidth;
  nw.maxWidth:=maxWidth;
  nw.minHeight:=minHeight;
  nw.maxHeight:=maxHeight;
  win:=OpenWindow(nw);
  IF win#NIL THEN
    wh:=NewAllocRemember(rememberWindow,SIZE(WindowHandle),FALSE);
    wh^.window:=win;
    win^.userData:=NIL;
  END;
  RETURN win;
END CreateWindow;



PROCEDURE CreateSimpleWindow(x,y          : INTEGER;
                             width,height : INTEGER;
                             title        : ADDRESS;
                             flags        : WindowFlagSet;
                             screen       : ScreenPtr) : WindowPtr;
VAR nw  : NewWindow;
    win : WindowPtr;
    wh  : WindowHandlePtr;
BEGIN
  nw.width:=width;
  nw.height:=height;
  nw.title:=title;
  nw.flags:=flags;
  nw.screen:=screen;
  WITH nw DO
    leftEdge:=x; topEdge:=y; detailPen:=0; blockPen:=1; bitMap:=NIL;
    IF screen=NIL THEN
      type:=ScreenFlagSet{wbenchScreen};
    ELSE
      type:=customScreen;
    END;
    idcmpFlags:=IDCMPFlagSet{};
    minWidth:=40; maxWidth:=-1; minHeight:=80; maxHeight:=-1;
    checkMark:=NIL;
  END;
  win:=OpenWindow(nw);
  IF win#NIL THEN
    wh:=NewAllocRemember(rememberWindow,SIZE(WindowHandle),FALSE);
    wh^.window:=win;
    win^.userData:=NIL;
  END;
  RETURN win;
END CreateSimpleWindow;



PROCEDURE DeleteWindow(VAR window : WindowPtr);
VAR win : WindowPtr;
    rem : NewRememberPtr;
    wh  : WindowHandlePtr;
BEGIN
  IF window#NIL THEN
    rem:=rememberWindow;
    WHILE rem#NIL DO
      wh:=GetAddress(rem);
      IF wh#NIL THEN
        IF wh^.window=window THEN
          IF window^.userData#NIL THEN
            ReplyMsg(window^.userData);
          END;
          CloseWindow(wh^.window);
          CutRememberElement(rememberWindow,rem,TRUE);
        END;
      END;
      rem:=rem^.next;
    END;
  END;
  window:=NIL;
END DeleteWindow;



PROCEDURE InclIDCMPFlag(window : WindowPtr;
                        idcmp  : IDCMPFlags);
VAR id : IDCMPFlagSet;
BEGIN
  IF window#NIL THEN
    id:=window^.idcmpFlags;
    INCL(id,idcmp);
    ModifyIDCMP(window,id);
  END;
END InclIDCMPFlag;



PROCEDURE ExclIDCMPFlag(window : WindowPtr;
                        idcmp  : IDCMPFlags);
VAR id  : IDCMPFlagSet;
BEGIN
  IF window#NIL THEN
    id:=window^.idcmpFlags;
    EXCL(id,idcmp);
    ModifyIDCMP(window,id);
  END;
END ExclIDCMPFlag;



VAR rememberImage  : NewRememberPtr;
    rememberBorder : NewRememberPtr;
    rememberText   : NewRememberPtr;

PROCEDURE GetImage(rp    : RastPortPtr;
                   x,y   : INTEGER;
                   w,h   : INTEGER;
                   dx,dy : INTEGER;
                   if    : ImagePtr) : ImagePtr;
VAR image,save  : ImagePtr;
    adr    : ADDRESS;
    d,t    : INTEGER;
    bitmap : BitMap;
    lc     : LONGCARD;
BEGIN
  image:=NewAllocRemember(rememberImage,SIZE(Image),FALSE);
  IF image#NIL THEN
    WITH image^ DO
      leftEdge:=dx; topEdge:=dy; width:=w; height:=h; depth:=0;
      imageData:=NIL; planePick:=255; planeOnOff:=0;
      IF rp#NIL THEN
        d:=ABS(rp^.bitMap^.depth);
        IF d>6 THEN d:=6; END;
        depth:=d;
        adr:=NewAllocRemember(rememberImage,2*d*h*((w+15) DIV 16),TRUE);
        imageData:=adr;
        WITH bitmap DO
          bytesPerRow:=((w+15) DIV 16)*2; rows:=h;
          depth:=rp^.bitMap^.depth; flags:=0;
          FOR t:=0 TO d DO
            planes[t]:=adr;
            INC(adr,2*h*((w+15) DIV 16));
          END;
        END;
        lc:=BltBitMap(rp^.bitMap,x,y,ADR(bitmap),0,0,w,h,192,255,NIL);
      END;
    END;
    IF if#NIL THEN
      save:=if;
      WHILE if^.nextImage#NIL DO if:=if^.nextImage; END;
      if^.nextImage:=image;
      image:=save;
    END;
  END;
  RETURN image;
END GetImage;



PROCEDURE SaveImage(VAR fh : File;
                    image  : ImagePtr);
VAR li : LONGINT;
BEGIN
  IF (image#NIL) AND (fh.file#NIL) THEN
    WriteBytes(fh,image,SIZE(Image),li);
    WITH image^ DO
      IF imageData#NIL THEN
        WriteBytes(fh,imageData,((width+7) DIV 8)*height*depth,li);
      END;
    END;
  END;
END SaveImage;



PROCEDURE LoadImage(VAR fh : File;
                    if     : ImagePtr) : ImagePtr;
VAR image,save : ImagePtr;
    li    : LONGINT;
BEGIN
  image:=NIL;
  IF fh.file#NIL THEN
    image:=NewAllocRemember(rememberImage,SIZE(Image),FALSE);
    IF image#NIL THEN
      ReadBytes(fh,image,SIZE(Image),li);
      IF li=SIZE(Image) THEN
        WITH image^ DO
          nextImage:=NIL;
          IF imageData#NIL THEN
            imageData:=NewAllocRemember(rememberImage,
                       ((width+7) DIV 8)*height*depth,TRUE);
            IF imageData#NIL THEN
              ReadBytes(fh,imageData,((width+7) DIV 8)*height*depth,li);
            END;
          END;
        END;
      END;
      IF if#NIL THEN
        save:=if;
        WHILE if^.nextImage#NIL DO if:=if^.nextImage; END;
        if^.nextImage:=image;
        image:=save;
      END;
    END;
  END;
  RETURN image;
END LoadImage;



PROCEDURE GetColorImage(w,h   : INTEGER;
                        dx,dy : INTEGER;
                        color : INTEGER;
                        if    : ImagePtr) : ImagePtr;
VAR image,save : ImagePtr;
    get   : POINTER TO BITSET;
    d     : INTEGER;
BEGIN
  image:=NewAllocRemember(rememberImage,SIZE(Image),FALSE);
  IF image#NIL THEN
    WITH image^ DO
      leftEdge:=dx; topEdge:=dy; width:=w; height:=h; depth:=0; imageData:=NIL;
      planePick:=0; planeOnOff:=color MOD 64; depth:=6;
    END;
    IF if#NIL THEN
      save:=if;
      WHILE if^.nextImage#NIL DO if:=if^.nextImage; END;
      if^.nextImage:=image;
      image:=save;
    END;
  END;
  RETURN image;
END GetColorImage;



PROCEDURE FreeImage(VAR image : ImagePtr);
BEGIN
  IF image#NIL THEN
    WITH image^ DO
      CutRememberStructure(rememberImage,imageData,TRUE);
    END;
    CutRememberStructure(rememberImage,image,TRUE);
  END;
  image:=NIL;
END FreeImage;



PROCEDURE FreeImageList(VAR image : ImagePtr);
VAR next : ImagePtr;
BEGIN
  WHILE image#NIL DO
    next:=image^.nextImage;
    FreeImage(image);
    image:=next;
  END;
END FreeImageList;



PROCEDURE GetBorder(fp,bp : INTEGER;
                    dm    : DrawModeSet;
                    c     : SHORTCARD;
                    bf    : BorderPtr) : BorderPtr;
VAR border,save : BorderPtr;
BEGIN
  border:=NewAllocRemember(rememberBorder,SIZE(Border),FALSE);
  IF border#NIL THEN
    WITH border^ DO
      leftEdge:=0; topEdge:=0; frontPen:=fp; backPen:=bp;
      drawMode:=dm; count:=c; nextBorder:=NIL;
      xy:=NewAllocRemember(rememberBorder,(c+2)*4,TRUE);
      IF xy=NIL THEN
        CutRememberStructure(rememberBorder,border,TRUE);
      END;
    END;
    IF bf#NIL THEN
      save:=bf;
      WHILE bf^.nextBorder#NIL DO bf:=bf^.nextBorder; END;
      bf^.nextBorder:=border;
      border:=save;
    END;
  END;
  RETURN border;
END GetBorder;



PROCEDURE SetBorderOutline(b    : BorderPtr;
                           data : ADDRESS);
VAR t     : INTEGER;
    ls,lt : POINTER TO ARRAY[0..256] OF LONGCARD;
BEGIN
  IF (b#NIL) AND (data#NIL) THEN
    ls:=data; lt:=ADDRESS(b^.xy);
    FOR t:=0 TO b^.count+1 DO
      lt^[t]:=ls^[t];
    END;
  END;
END SetBorderOutline;



PROCEDURE GetRectBorder(fp,bp       : INTEGER;
                        dm          : DrawModeSet;
                        x1,y1,x2,y2 : INTEGER;
                        bf          : BorderPtr) : BorderPtr;
VAR b,save : BorderPtr;
BEGIN
  b:=GetBorder(fp,bp,dm,5,NIL);
  IF b#NIL THEN
    WITH b^ DO
      IF xy#NIL THEN
        xy^[0,borderX]:=x1; xy^[0,borderY]:=y1;
        xy^[1,borderX]:=x1; xy^[1,borderY]:=y2;
        xy^[2,borderX]:=x2; xy^[2,borderY]:=y2;
        xy^[3,borderX]:=x2; xy^[3,borderY]:=y1;
        xy^[4,borderX]:=x1; xy^[4,borderY]:=y1;
      END;
    END;
    IF bf#NIL THEN
      save:=bf;
      WHILE bf^.nextBorder#NIL DO bf:=bf^.nextBorder; END;
      bf^.nextBorder:=b;
      b:=save;
    END;
  END;
  RETURN b;
END GetRectBorder;



PROCEDURE NewGetRectBorder(fp,bp       : INTEGER;
                           dm          : DrawModeSet;
                           x1,y1,x2,y2 : INTEGER;
                           bf          : BorderPtr) : BorderPtr;
VAR b1,b2,save : BorderPtr;
BEGIN
  b1:=GetBorder(fp,0,jam1,3,NIL);
  b2:=GetBorder(bp,0,jam1,3,NIL);
  IF (b1#NIL) AND (b2#NIL) THEN
    IF (b1^.xy#NIL) AND (b2^.xy#NIL) THEN
      WITH b1^ DO
        xy^[0,borderX]:=x1; xy^[0,borderY]:=y2;
        xy^[1,borderX]:=x1; xy^[1,borderY]:=y1;
        xy^[2,borderX]:=x2; xy^[2,borderY]:=y1;
      END;
      WITH b2^ DO
        xy^[0,borderX]:=x1; xy^[0,borderY]:=y2;
        xy^[1,borderX]:=x2; xy^[1,borderY]:=y2;
        xy^[2,borderX]:=x2; xy^[2,borderY]:=y1;
      END;
      b1^.nextBorder:=b2;
    END;
    IF bf#NIL THEN
      save:=bf;
      WHILE bf^.nextBorder#NIL DO bf:=bf^.nextBorder; END;
      bf^.nextBorder:=b1;
      b1:=save;
    END;
  END;
  RETURN b1;
END NewGetRectBorder;



PROCEDURE FreeBorder(VAR b : BorderPtr);
BEGIN
  IF b#NIL THEN
    IF b^.xy#NIL THEN
      CutRememberStructure(rememberBorder,b^.xy,TRUE);
    END;
    CutRememberStructure(rememberBorder,b,TRUE);
  END;
  b:=NIL;
END FreeBorder;



PROCEDURE FreeBorderList(VAR b : BorderPtr);
VAR next : BorderPtr;
BEGIN
  WHILE b#NIL DO
    next:=b^.nextBorder;
    FreeBorder(b);
    b:=next;
  END;
END FreeBorderList;



PROCEDURE AddIntuiText(xr,yr  : INTEGER;
                       fp,bp  : SHORTCARD;
                       dm     : DrawModeSet;
                       font   : TextAttrPtr;
                       text   : ARRAY OF CHAR;
                       fit    : IntuiTextPtr) : IntuiTextPtr;
VAR its,ret : IntuiTextPtr;
BEGIN
  its:=NIL;
  its:=NewAllocRemember(rememberText,SIZE(IntuiText),FALSE);
  IF its#NIL THEN
    its^.iText:=NewAllocRemember(rememberText,HIGH(text)+2,FALSE);
    IF its^.iText#NIL THEN
      WITH its^ DO
        frontPen:=fp; backPen:=bp; drawMode:=dm; leftEdge:=xr;
        topEdge:=yr; iTextFont:=font; nextText:=NIL;
        CopyMem(ADR(text),iText,HIGH(text)+1);
      END;
    ELSE
      CutRememberStructure(rememberText,its,TRUE);
    END;
  END;
  IF fit#NIL THEN
    ret:=fit;
    WHILE fit^.nextText#NIL DO
      fit:=fit^.nextText;
    END;
    fit^.nextText:=its;
    its:=ret;
  END;
  RETURN its;
END AddIntuiText;



PROCEDURE FreeIntuiText(VAR it : IntuiTextPtr);
BEGIN
  IF it#NIL THEN
    IF it^.iText#NIL THEN
      CutRememberStructure(rememberText,it^.iText,TRUE);
    END;
    CutRememberStructure(rememberText,it,TRUE);
  END;
  it:=NIL;
END FreeIntuiText;



PROCEDURE FreeIntuiTextList(VAR fit : IntuiTextPtr);
VAR it : IntuiTextPtr;
BEGIN
  WHILE fit#NIL DO
    IF fit^.iText#NIL THEN
      CutRememberStructure(rememberText,fit^.iText,TRUE);
    END;
    it:=fit^.nextText;
    CutRememberStructure(rememberText,fit,TRUE);
    fit:=it;
  END;
  fit:=NIL;
END FreeIntuiTextList;



CONST bar          = "-----------------------------------------"+
                     "-----------------------------------------";

TYPE FAttr  = RECORD
       attr : TextAttr;
       name : ARRAY[0..31] OF CHAR;
     END;

VAR rememberMenu  : NewRememberPtr;
    rememberSText : NewRememberPtr;
    DAString      : ARRAY[0..1] OF CHAR;

PROCEDURE GetMenu(mh     : MenuHandlePtr;
                  menuNr : INTEGER) : MenuPtr;
VAR menu : MenuPtr;
    t    : INTEGER;
BEGIN
  IF mh#NIL THEN
    menu:=mh^.main;
    t:=0;
    WHILE (t<menuNr) AND (menu#NIL) DO
      INC(t);
      menu:=menu^.nextMenu;
    END;
  END;
  RETURN menu;
END GetMenu;



PROCEDURE GetItem(menu   : MenuPtr;
                  itemNr : INTEGER) : MenuItemPtr;
VAR item : MenuItemPtr;
    t    : INTEGER;
BEGIN
  IF menu#NIL THEN
    item:=menu^.firstItem;
    t:=0;
    WHILE (t<itemNr) AND (item#NIL) DO
      INC(t);
      item:=item^.nextItem;
    END;
  END;
  RETURN item;
END GetItem;



PROCEDURE GetSubItem(menuItem  : MenuItemPtr;
                     subItemNr : INTEGER) : MenuItemPtr;
VAR item : MenuItemPtr;
    t    : INTEGER;
BEGIN
  IF menuItem#NIL THEN
    item:=menuItem^.subItem;
    t:=0;
    WHILE (t<subItemNr) AND (item#NIL) DO
      INC(t);
      item:=item^.nextItem;
    END;
  END;
  RETURN item;
END GetSubItem;



PROCEDURE GetMenuItem(mh                      : MenuHandlePtr;
                      menuNr,itemNr,subItemNr : INTEGER) : MenuItemPtr;
VAR menu : MenuPtr;
    item : MenuItemPtr;
BEGIN
  item:=NIL;
  IF mh#NIL THEN
    menu:=GetMenu(mh,menuNr);
    IF menu#NIL THEN
      item:=GetItem(menu,itemNr);
      IF (item#NIL) AND (subItemNr>=0) THEN
        item:=GetSubItem(item,subItemNr);
      END;
    END;
  END;
  RETURN item;
END GetMenuItem;



PROCEDURE GetItemNumber(mh : MenuHandlePtr;
                        it : MenuItemPtr;
                        VAR menuNr,itemNr,subItemNr : INTEGER);
VAR menu         : MenuPtr;
    item,sitem   : MenuItemPtr;
    mNr,iNr,siNr : INTEGER;
BEGIN
  menuNr:=-1; itemNr:=-1; subItemNr:=-1;
  IF mh#NIL THEN
    menu:=mh^.main;
    mNr:=0;
    WHILE menu#NIL DO
      item:=menu^.firstItem;
      iNr:=0;
      WHILE item#NIL DO
        sitem:=item^.subItem;
        siNr:=0;
        WHILE sitem#NIL DO
          IF sitem=it THEN
            menuNr:=mNr;
            itemNr:=iNr;
            subItemNr:=siNr;
          END;
          INC(subItemNr);
          sitem:=sitem^.nextItem;
        END;
        IF item=it THEN
          menuNr:=mNr;
          itemNr:=iNr;
        END;
        INC(itemNr);
        item:=item^.nextItem;
      END;
      INC(menuNr);
      menu:=menu^.nextMenu;
    END;
  END;
END GetItemNumber;



PROCEDURE GetMaxWidth(menuItem : MenuItemPtr) : INTEGER;
VAR max : INTEGER;
BEGIN
  max:=0;
  WHILE menuItem#NIL DO
    IF menuItem^.width>max THEN
      max:=menuItem^.width;
    END;
    menuItem:=menuItem^.nextItem;
  END;
  RETURN max;
END GetMaxWidth;



PROCEDURE CalcMenuItem(mh : MenuHandlePtr) : INTEGER;
VAR max,w,ws,h : INTEGER;
    menuItem   : MenuItemPtr;
    it,st      : IntuiTextPtr;
    pt         : POINTER TO ARRAY[0..64] OF CHAR;
BEGIN
  IF mh#NIL THEN
    WITH mh^ DO
      IF item IN made THEN
        max:=GetMaxWidth(startItem);
        menuItem:=startItem;
        WHILE menuItem#NIL DO
          IF (menuItem^.itemFill#NIL) AND (menuItem^.width<0) AND
             (itemText IN menuItem^.flags) THEN
            w:=IntuiTextLength(menuItem^.itemFill);
            it:=menuItem^.itemFill;
            pt:=it^.iText;
            ws:=Length(pt^);
            pt^[max*ws/w]:=CHR(0)
          END;
          menuItem^.width:=max;
          IF (menuItem^.subItem#NIL) AND (itemText IN menuItem^.flags) THEN
            it:=NewAllocRemember(rememberSText,SIZE(IntuiText),FALSE);
            IF it#NIL THEN
              WITH it^ DO
                frontPen:=window^.detailPen;
                backPen:=window^.blockPen; drawMode:=jam2;
                iTextFont:=NIL; nextText:=NIL;
                iText:=ADR(DAString);
                IF actFont#NIL THEN
                  h:=actFont^.ySize;
                ELSE
                  h:=defFont^.ySize
                END;
                ws:=IntuiTextLength(it);
                leftEdge:=max-(ws+2);
                topEdge:=(defHeight+h-ws) DIV 2; (* ca. *)
              END;
            END;
            st:=menuItem^.itemFill;
            IF st#NIL THEN
              WHILE st^.nextText#NIL DO
                st:=st^.nextText;
              END;
              st^.nextText:=it;
            END;
          END;
          menuItem:=menuItem^.nextItem;
        END;
      END;
    END;
  END;
  RETURN max;
END CalcMenuItem;



PROCEDURE EndMenuItem(mh : MenuHandlePtr);
VAR t        : INTEGER;
    menuItem : MenuItemPtr;
    save     : LONGSET;
BEGIN
  IF mh#NIL THEN
    WITH mh^ DO
      IF item IN made THEN
        t:=CalcMenuItem(mh);
        menuItem:=actMenu^.firstItem;
        t:=0;
        WHILE menuItem#NIL DO
          IF t IN exSetItem THEN
            save:=exSetItem; EXCL(save,t);
            menuItem^.mutualExclude:=save;
          END;
          menuItem:=menuItem^.nextItem;
          INC(t);
        END;
        EXCL(made,item);
        exItem:=FALSE;
        exPauseItem:=FALSE;
        exSetItem:=LONGSET{};
        xSubItem:=0;
        startItem:=NIL;
        topItem:=0;
      END;
    END;
  END;
END EndMenuItem;



PROCEDURE CalcSubMenuItem(mh : MenuHandlePtr) : INTEGER;
VAR max,w,ws : INTEGER;
    menuItem : MenuItemPtr;
    it       : IntuiTextPtr;
    pt       : POINTER TO ARRAY[0..80] OF CHAR;
BEGIN
  IF mh#NIL THEN
    WITH mh^ DO
      IF subItem IN made THEN
        max:=GetMaxWidth(startSub);
        menuItem:=startSub;
        WHILE menuItem#NIL DO
          IF (menuItem^.itemFill#NIL) AND (menuItem^.width<0) AND
             (itemText IN menuItem^.flags) THEN
            w:=IntuiTextLength(menuItem^.itemFill);
            it:=menuItem^.itemFill;
            pt:=it^.iText;
            ws:=Length(pt^);
            pt^[max*ws/w]:=CHR(0)
          END;
          menuItem^.width:=max;
          menuItem:=menuItem^.nextItem;
        END;
      END;
    END;
  END;
  RETURN max;
END CalcSubMenuItem;



PROCEDURE EndSubMenuItem(mh : MenuHandlePtr);
VAR t        : INTEGER;
    menuItem : MenuItemPtr;
    save     : LONGSET;
BEGIN
  IF mh#NIL THEN
    WITH mh^ DO
      IF subItem IN made THEN
        t:=CalcSubMenuItem(mh);
        menuItem:=actItem^.subItem;
        t:=0;
        WHILE menuItem#NIL DO
          IF t IN exSetSub THEN
            save:=exSetSub; EXCL(save,t);
            menuItem^.mutualExclude:=save;
          END;
          menuItem:=menuItem^.nextItem;
          INC(t);
        END;
        EXCL(made,subItem);
        exSubItem:=FALSE;
        exPauseSub:=FALSE;
        exSetSub:=LONGSET{};
        xSubItem:=0;
        topSub:=0;
        startSub:=NIL;
      END;
    END;
  END;
END EndSubMenuItem;



PROCEDURE SetDefaultMenuFont(mh : MenuHandlePtr);
BEGIN
  IF mh#NIL THEN
    IF mh^.actFont#NIL THEN
      CloseFont(mh^.actFont);
      mh^.actFont:=NIL;
    END;
  END;
END SetDefaultMenuFont;



PROCEDURE SetMenuFont(mh     : MenuHandlePtr;
                      font   : ARRAY OF CHAR;
                      height : CARDINAL;
                      styles : FontStyleSet) : BOOLEAN;
VAR get,sub,h : INTEGER;
    ok        : BOOLEAN;
    at        : POINTER TO FAttr;
BEGIN
  IF mh#NIL THEN
    SetDefaultMenuFont(mh);
    at:=NewAllocRemember(mh^.fontAttr,SIZE(FAttr),FALSE);
    Copy(at^.name,font); Concat(at^.name,".font");
    WITH at^.attr DO
      ySize:=height; style:=styles; flags:=FontFlagSet{};
      name:=ADR(at^.name);
    END;
    mh^.actFontAttr:=ADR(at^.attr);
    WITH mh^ DO
      actFont:=OpenDiskFont(mh^.actFontAttr);
      IF actFont#NIL THEN
        RETURN TRUE;
      ELSE
        RETURN FALSE;
      END;
    END;
  ELSE
    RETURN FALSE;
  END;
END SetMenuFont;


CONST endFontname = ".font";


PROCEDURE InitMenu(window       : WindowPtr;
                   standardFont : ARRAY OF CHAR;
                   height       : CARDINAL;
                   styles       : FontStyleSet) : MenuHandlePtr;
VAR mh  : MenuHandlePtr;
    err : BOOLEAN;
    str : POINTER TO ARRAY[0..31] OF CHAR;
    vp  : ViewPortPtr;
BEGIN
  mh:=NewAllocRemember(rememberMenu, SIZE(MenuHandle), FALSE);
  IF mh#NIL THEN
    mh^.window:=window;
    vp:=ViewPortAddress(window);
    WITH mh^ DO
      made:=MadeSet{}; xItem:=0; xSubItem:=0; defWidthAdd:=24; defXOffset:=0;
      actMenus:=0; actItems:=0; actSubItems:=0; topItem:=0; topSub:=0;
      actMenu:=NIL; actItem:=NIL; actSubItem:=NIL; startItem:=NIL;
      main:=NIL; exclude:=FALSE; exSetItem:=LONGSET{}; startSub:=NIL;
      exSetSub:=LONGSET{}; exItem:=FALSE; exSubItem:=FALSE; defXSpace:=0;
      defHeight:=2; defYSpace:=0; exPauseItem:=FALSE; exPauseSub:=FALSE;
      fontAttr:=NIL;
      AllocMem(defFontName,32,FALSE);
      IF vp#NIL THEN
        IF hires IN vp^.modes THEN
          widthCom:=commWidth;
          widthCheck:=checkWidth;
        ELSE
          widthCom:=lowCommWidth;
          widthCheck:=lowCheckWidth;
        END;
      ELSE
        widthCom:=commWidth;
        widthCheck:=checkWidth;
      END;
    END;

    str:=ADDRESS(mh^.defFontName);
    Copy(str^,standardFont); Concat(str^,endFontname);
    WITH mh^.defFontAttr DO
      ySize:=height; style:=styles; flags:=FontFlagSet{}; name:=str;
    END;
    mh^.defFont:=OpenDiskFont(ADR(mh^.defFontAttr));
    IF mh^.defFont=NIL THEN
      str^:=stdFont+endFontname;
      WITH mh^.defFontAttr DO
        ySize:=stdHeight; style:=FontStyleSet{}; flags:=FontFlagSet{};
        name:=str;
      END;
      mh^.defFont:=OpenDiskFont(ADR(mh^.defFontAttr));
    END;
  END;
  RETURN mh;
END InitMenu;



PROCEDURE AddMenu(mh     : MenuHandlePtr;
                  name   : ARRAY OF CHAR;
                  enable : BOOLEAN);
VAR txt   : POINTER TO ARRAY[0..31] OF CHAR;
    smenu : MenuPtr;
    intui : IntuiText;
BEGIN
  IF mh#NIL THEN

    IF mh^.actMenus<8 THEN

      EndSubMenuItem(mh);

      EndMenuItem(mh);

      WITH mh^ DO
        AllocMem(actMenu,SIZE(Menu),FALSE);
        IF actMenu#NIL THEN
          IF main=NIL THEN
            main:=actMenu;
          ELSE
            smenu:=main;
            WHILE smenu^.nextMenu#NIL DO
              smenu:=smenu^.nextMenu;
            END;
            smenu^.nextMenu:=actMenu;
            INC(actMenus);
          END;

          AllocMem(txt,32,FALSE);
          IF txt#NIL THEN
            Copy(txt^,name);
            txt^[31]:=CHR(0);
            actMenu^.menuName:=txt;

            actItems:=0;
            actSubItems:=0;
            INCL(made,menu);

            IF actMenus=0 THEN
              actMenu^.leftEdge:=2;
            ELSE
              actMenu^.leftEdge:=smenu^.leftEdge+smenu^.width;
            END;
            WITH actMenu^ DO
              topEdge:=0;
              WITH intui DO
                leftEdge:=0; topEdge:=0; iTextFont:=ADR(defFontAttr);
                iText:=ADR(name); nextText:=NIL;
              END;
              width:=IntuiTextLength(ADR(intui))+mh^.defWidthAdd;
              height:=defFont^.ySize;
              IF enable THEN
                flags:=BITSET{menuEnabled}
              ELSE
                flags:=BITSET{};
              END;
              menuName:=txt; firstItem:=NIL;
            END;
          ELSE
            Deallocate(actMenu);
          END;
        END;
      END;
    END;
  END;
END AddMenu;



PROCEDURE SetDefaultHeight(mh     : MenuHandlePtr;
                           height : INTEGER);
BEGIN
  IF mh#NIL THEN
    mh^.defHeight:=height;
  END;
END SetDefaultHeight;



PROCEDURE SetDefaultAdditionalWidth(mh  : MenuHandlePtr;
                                    add : INTEGER);
BEGIN
  IF mh#NIL THEN
    mh^.defWidthAdd:=add;
  END;
END SetDefaultAdditionalWidth;



PROCEDURE SetXOffset(mh     : MenuHandlePtr;
                     offset : INTEGER);
BEGIN
  IF mh#NIL THEN
    IF offset<0 THEN
      mh^.defXOffset:=mh^.defWidthAdd DIV 2;
    ELSE
      mh^.defXOffset:=offset;
    END;
  END;
END SetXOffset;



PROCEDURE SetDefaultYSpace(mh    : MenuHandlePtr;
                           space : INTEGER);
BEGIN
  IF mh#NIL THEN
    mh^.defYSpace:=space;
  END;
END SetDefaultYSpace;



PROCEDURE SetDefaultXSpace(mh    : MenuHandlePtr;
                           space : INTEGER);
BEGIN
  IF mh#NIL THEN
    mh^.defXSpace:=space;
  END;
END SetDefaultXSpace;



PROCEDURE StartMutualExclude(mh : MenuHandlePtr);
BEGIN
  IF mh#NIL THEN
    mh^.exclude:=TRUE;
  END;
END StartMutualExclude;



PROCEDURE PauseMutualExclude(mh : MenuHandlePtr);
BEGIN
  IF mh#NIL THEN
    IF mh^.exSubItem THEN
      mh^.exPauseSub:=TRUE;
    ELSE
      mh^.exPauseItem:=TRUE;
    END;
  END;
END PauseMutualExclude;



PROCEDURE EndPauseMutualExclude(mh : MenuHandlePtr);
BEGIN
  IF mh#NIL THEN
    IF mh^.exPauseSub THEN
      mh^.exPauseSub:=FALSE;
    ELSE
      mh^.exPauseItem:=FALSE;
    END;
  END;
END EndPauseMutualExclude;



PROCEDURE EndMutualExclude(mh : MenuHandlePtr);
VAR menuItem : MenuItemPtr;
    t        : INTEGER;
    save     : LONGSET;
BEGIN
  IF mh#NIL THEN
    IF mh^.exSubItem THEN
      mh^.exSubItem:=FALSE;
      menuItem:=mh^.actItem^.subItem;
      t:=0;
      WHILE menuItem#NIL DO
        IF t IN mh^.exSetSub THEN
          save:=mh^.exSetSub; EXCL(save,t);
          menuItem^.mutualExclude:=save;
        END;
        menuItem:=menuItem^.nextItem;
        INC(t);
      END;
    ELSE
      mh^.exItem:=FALSE;
      menuItem:=mh^.actMenu^.firstItem;
      t:=0;
      WHILE menuItem#NIL DO
        IF t IN mh^.exSetItem THEN
          save:=mh^.exSetItem; EXCL(save,t);
          menuItem^.mutualExclude:=save;
        END;
        menuItem:=menuItem^.nextItem;
        INC(t);
      END;
    END;
  END;
END EndMutualExclude;



PROCEDURE MakeIntuiText(mh    : MenuHandlePtr;
                        intui : IntuiTextPtr;
                        flags : ItemFlagSet;
                        txt   : ADDRESS);
BEGIN
  IF (mh#NIL) AND (intui#NIL) THEN
    WITH mh^ DO
      WITH intui^ DO
        frontPen:=window^.detailPen;
        backPen:=window^.blockPen; drawMode:=jam2;
        topEdge:=defHeight DIV 2;
        IF actFont#NIL THEN
          iTextFont:=actFontAttr;
        ELSE
          iTextFont:=ADR(defFontAttr);
        END;
        iText:=txt; nextText:=NIL;
        IF (checkit IN flags) OR (checkset IN flags) THEN
          leftEdge:=widthCheck;
        END;
        INC(leftEdge,defXOffset);
      END;
    END;
  END;
END MakeIntuiText;



PROCEDURE GetFlags(flags    : ItemFlagSet;
                   selected : ARRAY OF CHAR) : MenuItemFlagSet;
VAR fl : MenuItemFlagSet;
BEGIN
  fl:=MenuItemFlagSet{itemText,itemEnabled};
  IF Length(selected)=0 THEN
    IF box IN flags THEN
      INCL(fl,highBox);
    ELSIF non IN flags THEN
      INCL(fl,highBox);
      INCL(fl,highComp);
    ELSE
      INCL(fl,highComp);
    END;
  ELSE
    INCL(fl,highItem);
  END;
  IF disable IN flags THEN
    EXCL(fl,itemEnabled);
  END;
  RETURN fl;
END GetFlags;



PROCEDURE MakeShortCut(mh    : MenuHandlePtr;
                       cut   : CHAR;
                       flags : ItemFlagSet);
BEGIN
  IF mh#NIL THEN
    WITH mh^ DO
      IF startSub#NIL THEN
        IF cut#none THEN
          INC(actSubItem^.width,widthCom);
          INCL(actSubItem^.flags,commSeq);
          actSubItem^.command:=cut;
        END;
        IF (checkit IN flags) OR (checkset IN flags) THEN
          INC(actSubItem^.width,widthCheck);
          INCL(actSubItem^.flags,checkIt);
          IF (NOT exItem) OR (exPauseItem) THEN
            INCL(actSubItem^.flags,menuToggle);
          END;
          IF checkset IN flags THEN
            INCL(actSubItem^.flags,checked);
          END;
        END;
      ELSIF actItem#NIL THEN
       IF cut#none THEN
          INC(actItem^.width,widthCom);
          INCL(actItem^.flags,commSeq);
          actItem^.command:=cut;
        END;
        IF (checkit IN flags) OR (checkset IN flags) THEN
          INC(actItem^.width,widthCheck);
          INCL(actItem^.flags,checkIt);
          IF (NOT exItem) OR (exPauseItem) THEN
            INCL(actItem^.flags,menuToggle);
          END;
          IF checkset IN flags THEN
            INCL(actItem^.flags,checked);
          END;
        END;
      END;
    END;
  END;
END MakeShortCut;



PROCEDURE AddTextMenuItem(mh     : MenuHandlePtr;
                          text   : ARRAY OF CHAR;
                          sel    : ARRAY OF CHAR;
                          cut    : CHAR;
                          flags  : ItemFlagSet);
VAR txt,stxt   : POINTER TO ARRAY[0..31] OF CHAR;
    itemptr    : MenuItemPtr;
    itxt,istxt : IntuiTextPtr;
    fl         : MenuItemFlagSet;
    w          : INTEGER;
BEGIN
  IF mh#NIL THEN
    IF (mh^.actItems<64) AND (mh^.actMenu#NIL) THEN

      IF mh^.exclude THEN
        mh^.exclude:=FALSE;
        mh^.exItem:=TRUE;
      END;

      EndSubMenuItem(mh);

      fl:=GetFlags(flags,sel);

      WITH mh^ DO

        AllocMem(actItem,SIZE(MenuItem),FALSE);
        IF actItem#NIL THEN
          IF actMenu^.firstItem=NIL THEN
            actMenu^.firstItem:=actItem;
          ELSE
            itemptr:=actMenu^.firstItem;
            WHILE itemptr^.nextItem#NIL DO
              itemptr:=itemptr^.nextItem;
            END;
            itemptr^.nextItem:=actItem;
            INC(actItems);
          END;

          AllocMem(itxt,SIZE(IntuiText),FALSE);
          IF itxt#NIL THEN
            AllocMem(txt,64,FALSE);
            IF txt#NIL THEN
              AllocMem(istxt,SIZE(IntuiText),FALSE);
              IF istxt#NIL THEN
                AllocMem(stxt,64,FALSE);
                IF stxt#NIL THEN
                  Copy(txt^,text);
                  txt^[31]:=CHR(0);
                  Copy(stxt^,sel);
                  stxt^[31]:=CHR(0);

                  INCL(made,item);
                  actSubItems:=0;

                  IF startItem=NIL THEN
                    startItem:=actItem;
                  END;

                  IF NOT exPauseItem AND exItem AND (actItems<32) THEN
                    INCL(exSetItem,actItems);
                  END;

                  MakeIntuiText(mh,itxt,flags,txt);
                  MakeIntuiText(mh,istxt,flags,stxt);

                  WITH actItem^ DO
                    leftEdge:=xItem;
                    IF actFont#NIL THEN
                      height:=actFont^.ySize;
                    ELSE
                      height:=defFont^.ySize
                    END;
                    INC(height,defHeight);
                    topEdge:=topItem;
                    INC(topItem,height+defYSpace);
                    width:=IntuiTextLength(itxt);
                    w:=IntuiTextLength(istxt);
                    IF w>width THEN
                      width:=w;
                    END;
                    INC(width,defWidthAdd);
                    flags:=fl; itemFill:=itxt; selectFill:=istxt; subItem:=NIL;
                  END;

                  MakeShortCut(mh,cut,flags);

                ELSE
                  Deallocate(istxt);
                  Deallocate(txt);
                  Deallocate(itxt);
                  Deallocate(actItem);
                END;
              ELSE
                Deallocate(txt);
                Deallocate(itxt);
                Deallocate(actItem);
              END;
            ELSE
              Deallocate(itxt);
              Deallocate(actItem);
            END;
          ELSE
            Deallocate(actItem);
          END;
        END;
      END;
    END;
  END;
END AddTextMenuItem;



PROCEDURE AddBarMenuItem(mh   : MenuHandlePtr);
BEGIN
  IF mh#NIL THEN
    AddTextMenuItem(mh,bar,none,none,ItemFlagSet{non,disable});
    IF mh^.actItem#NIL THEN
      mh^.actItem^.width:=-1;
    END;
  END;
END AddBarMenuItem;



PROCEDURE AddImageMenuItem(mh     : MenuHandlePtr;
                           image  : ImagePtr;
                           sel    : ImagePtr;
                           cut    : CHAR;
                           flags  : ItemFlagSet);
VAR im,sim       : ImagePtr;
    idata,isdata : IntuiTextPtr;
    itemptr      : MenuItemPtr;
    fl           : MenuItemFlagSet;
    w            : INTEGER;
BEGIN
  IF mh#NIL THEN
    IF (mh^.actItems<64) AND (mh^.actMenu#NIL) THEN

      IF mh^.exclude THEN
        mh^.exclude:=FALSE;
        mh^.exItem:=TRUE;
      END;

      EndSubMenuItem(mh);

      IF sel#NIL THEN
        fl:=GetFlags(flags,"selected");
      ELSE
        fl:=GetFlags(flags,none);
      END;
      EXCL(fl,itemText);

      WITH mh^ DO

        AllocMem(actItem,SIZE(MenuItem),FALSE);
        IF actItem#NIL THEN
          IF actMenu^.firstItem=NIL THEN
            actMenu^.firstItem:=actItem;
          ELSE
            itemptr:=actMenu^.firstItem;
            WHILE itemptr^.nextItem#NIL DO
              itemptr:=itemptr^.nextItem;
            END;
            itemptr^.nextItem:=actItem;
            INC(actItems);
          END;
          idata:=NIL; isdata:=NIL;
          AllocMem(im,SIZE(Image),FALSE);
          IF im#NIL THEN
            IF image#NIL THEN
              w:=2*image^.depth*image^.height*((image^.width+15) DIV 16);
              AllocMem(idata,w,TRUE);
              im^.imageData:=idata;
              IF (image^.imageData#NIL) AND (im^.imageData#NIL) THEN
                CopyMem(image^.imageData,im^.imageData,w);
              END;
            END;
            AllocMem(sim,SIZE(Image),FALSE);
            IF sim#NIL THEN
              IF sel#NIL THEN
                w:=2*sel^.depth*sel^.height*((sel^.width+15) DIV 16);
                AllocMem(isdata,w,TRUE);
                sim^.imageData:=isdata;
                IF (sel^.imageData#NIL) AND (sim^.imageData#NIL) THEN
                  CopyMem(sel^.imageData,sim^.imageData,w);
                END;
              END;
              IF image#NIL THEN im^:=image^; END;
              IF sel#NIL THEN sim^:=sel^; END;
              im^.imageData:=idata;
              sim^.imageData:=isdata;
              im^.topEdge:=defHeight DIV 2;
              sim^.topEdge:=defHeight DIV 2;
              IF (checkit IN flags) OR (checkset IN flags) THEN
                im^.leftEdge:=widthCheck;
                sim^.leftEdge:=widthCheck;
              END;
              INC(im^.leftEdge,defXOffset);
              INC(sim^.leftEdge,defXOffset);

              INCL(made,item);
              actSubItems:=0;

              IF startItem=NIL THEN
                startItem:=actItem;
              END;

              IF NOT exPauseItem AND exItem AND (actItems<32) THEN
                INCL(exSetItem,actItems);
              END;

              WITH actItem^ DO
                leftEdge:=xItem;
                IF sim^.height>im^.height THEN
                  height:=sim^.height;
                ELSE
                  height:=im^.height;
                END;
                INC(height,defHeight);
                topEdge:=topItem;
                INC(topItem,height+defYSpace);
                IF sim^.width>im^.width THEN
                  width:=sim^.width;
                ELSE
                  width:=im^.width;
                END;
                INC(width,defWidthAdd);
                flags:=fl; itemFill:=im; selectFill:=sim; subItem:=NIL;
              END;

              MakeShortCut(mh,cut,flags);

            ELSE
              IF idata#NIL THEN Deallocate(idata); END;
              Deallocate(im);
              Deallocate(actItem);
            END;
          ELSE
            Deallocate(actItem);
          END;
        END;
      END;
    END;
  END;
END AddImageMenuItem;



PROCEDURE AddTextSubItem(mh     : MenuHandlePtr;
                         text   : ARRAY OF CHAR;
                         sel    : ARRAY OF CHAR;
                         cut    : CHAR;
                         flags  : ItemFlagSet);
VAR txt,stxt   : POINTER TO ARRAY[0..31] OF CHAR;
    itemptr    : MenuItemPtr;
    itxt,istxt : IntuiTextPtr;
    fl         : MenuItemFlagSet;
    w          : INTEGER;
BEGIN
  IF mh#NIL THEN
    IF (mh^.actSubItems<32) AND (mh^.actMenu#NIL) THEN
      IF mh^.actMenu^.firstItem#NIL THEN

        IF mh^.exclude THEN
          mh^.exclude:=FALSE;
          mh^.exSubItem:=TRUE;
        END;

        fl:=GetFlags(flags,sel);

        WITH mh^ DO

          AllocMem(actSubItem,SIZE(MenuItem),FALSE);
          IF actSubItem#NIL THEN
            IF actItem^.subItem=NIL THEN
              actItem^.subItem:=actSubItem;
            ELSE
              itemptr:=actItem^.subItem;
              WHILE itemptr^.nextItem#NIL DO
                itemptr:=itemptr^.nextItem;
              END;
              itemptr^.nextItem:=actSubItem;
              INC(actSubItems);
            END;

            AllocMem(itxt,SIZE(IntuiText),FALSE);
            IF itxt#NIL THEN
              AllocMem(txt,64,FALSE);
              IF txt#NIL THEN
                AllocMem(istxt,SIZE(IntuiText),FALSE);
                IF istxt#NIL THEN
                  AllocMem(stxt,64,FALSE);
                  IF stxt#NIL THEN
                    Copy(txt^,text);
                    txt^[31]:=CHR(0);
                    Copy(stxt^,sel);
                    stxt^[31]:=CHR(0);

                    INCL(made,subItem);

                    IF startSub=NIL THEN
                      startSub:=actSubItem;
                    END;

                    IF NOT exPauseSub AND exSubItem AND (actSubItems<32) THEN
                      INCL(exSetItem,actSubItems);
                    END;

                    MakeIntuiText(mh,itxt,flags,txt);
                    MakeIntuiText(mh,istxt,flags,stxt);

                    WITH actSubItem^ DO
                      leftEdge:=xSubItem+actItem^.width+defWidthAdd;

                      IF actFont#NIL THEN
                        height:=actFont^.ySize;
                      ELSE
                        height:=defFont^.ySize;
                      END;
                      INC(height,defHeight);
                      topEdge:=topSub;
                      INC(topSub,height+defYSpace);
                      width:=IntuiTextLength(itxt);
                      w:=IntuiTextLength(istxt);
                      IF w>width THEN
                        width:=w;
                      END;
                      INC(width,defWidthAdd);
                      flags:=fl;
                      itemFill:=itxt; selectFill:=istxt;
                      subItem:=NIL;
                    END;

                    MakeShortCut(mh,cut,flags);

                  ELSE
                    Deallocate(istxt);
                    Deallocate(txt);
                    Deallocate(itxt);
                    Deallocate(actSubItem);
                  END;
                ELSE
                  Deallocate(txt);
                  Deallocate(itxt);
                  Deallocate(actSubItem);
                END;
              ELSE
                Deallocate(itxt);
                Deallocate(actSubItem);
              END;
            ELSE
              Deallocate(actSubItem);
            END;
          END;
        END;
      END;
    END;
  END;
END AddTextSubItem;



PROCEDURE AddBarSubItem(mh   : MenuHandlePtr);
BEGIN
  IF mh#NIL THEN
    AddTextSubItem(mh,bar,none,none,ItemFlagSet{non,disable});
    IF mh^.actSubItem#NIL THEN
      mh^.actSubItem^.width:=-1;
    END;
  END;
END AddBarSubItem;



PROCEDURE AddImageSubItem(mh     : MenuHandlePtr;
                          image  : ImagePtr;
                          sel    : ImagePtr;
                          cut    : CHAR;
                          flags  : ItemFlagSet);
VAR im,sim       : ImagePtr;
    idata,isdata : IntuiTextPtr;
    itemptr      : MenuItemPtr;
    fl           : MenuItemFlagSet;
    w            : INTEGER;
BEGIN
  IF mh#NIL THEN
    IF (mh^.actSubItems<32) AND (mh^.actMenu#NIL) THEN
      IF mh^.actMenu^.firstItem#NIL THEN

        IF mh^.exclude THEN
          mh^.exclude:=FALSE;
          mh^.exSubItem:=TRUE;
        END;

        IF sel#NIL THEN
          fl:=GetFlags(flags,"selected");
        ELSE
          fl:=GetFlags(flags,none);
        END;
        EXCL(fl,itemText);

        WITH mh^ DO

          AllocMem(actSubItem,SIZE(MenuItem),FALSE);
          IF actSubItem#NIL THEN
            IF actItem^.subItem=NIL THEN
              actItem^.subItem:=actSubItem;
            ELSE
              itemptr:=actItem^.subItem;
              WHILE itemptr^.nextItem#NIL DO
                itemptr:=itemptr^.nextItem;
              END;
              itemptr^.nextItem:=actSubItem;
              INC(actSubItems);
            END;

            idata:=NIL; isdata:=NIL;
            AllocMem(im,SIZE(Image),FALSE);
            IF im#NIL THEN
              IF image#NIL THEN
                w:=2*image^.depth*image^.height*((image^.width+15) DIV 16);
                AllocMem(idata,w,TRUE);
                im^.imageData:=idata;
                IF (image^.imageData#NIL) AND (im^.imageData#NIL) THEN
                  CopyMem(image^.imageData,im^.imageData,w);
                END;
              END;
              AllocMem(sim,SIZE(Image),FALSE);
              IF sim#NIL THEN
                IF sel#NIL THEN
                  w:=2*sel^.depth*sel^.height*((sel^.width+15) DIV 16);
                  AllocMem(isdata,w,TRUE);
                  sim^.imageData:=isdata;
                  IF (sel^.imageData#NIL) AND (sim^.imageData#NIL) THEN
                    CopyMem(sel^.imageData,sim^.imageData,w);
                  END;
                END;
                IF image#NIL THEN im^:=image^; END;
                IF sel#NIL THEN sim^:=sel^; END;
                im^.imageData:=idata;
                sim^.imageData:=isdata;
                im^.topEdge:=defHeight DIV 2;
                sim^.topEdge:=defHeight DIV 2;
                IF (checkit IN flags) OR (checkset IN flags) THEN
                  im^.leftEdge:=widthCheck;
                  sim^.leftEdge:=widthCheck;
                END;

                INC(im^.leftEdge,defXOffset);
                INC(sim^.leftEdge,defXOffset);

                INCL(made,subItem);

                IF startSub=NIL THEN
                  startSub:=actSubItem;
                END;

                IF NOT exPauseSub AND exSubItem AND (actSubItems<32) THEN
                  INCL(exSetItem,actSubItems);
                END;

                WITH actSubItem^ DO
                  leftEdge:=xSubItem+actItem^.width+defWidthAdd;
                  IF sim^.height>im^.height THEN
                    height:=sim^.height;
                  ELSE
                    height:=im^.height;
                  END;
                  INC(height,defHeight);
                  topEdge:=topSub;
                  INC(topSub,height+defYSpace);
                  IF sim^.width>im^.width THEN
                    width:=sim^.width;
                  ELSE
                    width:=im^.width;
                  END;
                  INC(width,defWidthAdd);
                  flags:=fl;
                  itemFill:=im; selectFill:=sim;
                  subItem:=NIL;
                END;

              MakeShortCut(mh,cut,flags);

              ELSE
                IF idata#NIL THEN Deallocate(idata); END;
                Deallocate(im);
                Deallocate(actItem);
              END;
            ELSE
              Deallocate(actItem);
            END;
          END;
        END;
      END;
    END;
  END;
END AddImageSubItem;



PROCEDURE StartNewColumn(mh : MenuHandlePtr);
BEGIN
  IF mh#NIL THEN
    WITH mh^ DO
      IF subItem IN made THEN
        INC(xSubItem,CalcSubMenuItem(mh));
        INC(xSubItem,defXSpace);
        startSub:=NIL;
        topSub:=0;
      ELSE
        INC(xItem,CalcMenuItem(mh));
        INC(xItem,defXSpace);
        startItem:=NIL;
        topItem:=0;
      END;
    END;
  END;
END StartNewColumn;



PROCEDURE InstallMenu(mh : MenuHandlePtr) : BOOLEAN;
VAR id : IDCMPFlagSet;
BEGIN
  IF mh#NIL THEN
    EndSubMenuItem(mh);

    EndMenuItem(mh);

    IF mh^.window#NIL THEN
      InclIDCMPFlag(mh^.window,menuPick);
    END;

    RETURN SetMenuStrip(mh^.window,mh^.main);
  ELSE
    RETURN FALSE;
  END;
END InstallMenu;



PROCEDURE Dealloc(item : MenuItemPtr);

  PROCEDURE DeallocIntuiText(intui : IntuiTextPtr);
  VAR t,s : IntuiTextPtr;
  BEGIN
    IF intui#NIL THEN
      t:=intui^.nextText;
      WHILE t#NIL DO
        s:=t;
        CutRememberStructure(rememberSText,s,TRUE);
        t:=t^.nextText;
      END;
      IF intui^.iText#NIL THEN
        Deallocate(intui^.iText);
      END;
      Deallocate(intui);
    END;
  END DeallocIntuiText;

BEGIN
  IF item#NIL THEN
    IF (itemText IN item^.flags) THEN
      DeallocIntuiText(item^.itemFill);
      DeallocIntuiText(item^.selectFill);
    END;
  END;
  Deallocate(item);
END Dealloc;



PROCEDURE FreeMenu(VAR mh : MenuHandlePtr);
VAR actM,newM             : MenuPtr;
    actI,actSI,newI,newSI : MenuItemPtr;
BEGIN
  IF mh#NIL THEN
    SetDefaultMenuFont(mh);
    CloseFont(mh^.defFont);
    ClearMenuStrip(mh^.window);
    NewFreeRemember(mh^.fontAttr,TRUE);
    Deallocate(mh^.defFontName);
    actM:=mh^.main;
    WHILE actM#NIL DO
      newM:=actM^.nextMenu;
      actI:=actM^.firstItem;
      WHILE actI#NIL DO
        newI:=actI^.nextItem;
        actSI:=actI^.subItem;
        WHILE actSI#NIL DO
          newSI:=actSI^.nextItem;
          Dealloc(actSI);
          actSI:=newSI;
        END;
        Dealloc(actI);
        actI:=newI;
      END;
      Deallocate(actM^.menuName);
      Deallocate(actM);
      actM:=newM;
    END;
    CutRememberStructure(rememberMenu,mh,TRUE);
  END;
  mh:=NIL;
END FreeMenu;



PROCEDURE MenuItemChecked(mh                      : MenuHandlePtr;
                          menuNr,itemNr,subItemNr : INTEGER) : BOOLEAN;
VAR item : MenuItemPtr;
BEGIN
  item:=GetMenuItem(mh,menuNr,itemNr,subItemNr);
  IF item#NIL THEN
    RETURN (checked IN item^.flags);
  ELSE
    RETURN FALSE;
  END;
END MenuItemChecked;



PROCEDURE MenuEnable(mh     : MenuHandlePtr;
                     menuNr : INTEGER;
                     enable : BOOLEAN);
VAR menu : MenuPtr;
    t    : INTEGER;
BEGIN
  IF mh#NIL THEN
    menu:=GetMenu(mh,menuNr);
    IF menu#NIL THEN
      IF enable THEN
        INCL(menu^.flags,menuEnabled);
      ELSE
        EXCL(menu^.flags,menuEnabled);
      END;
    END;
  END;
END MenuEnable;



PROCEDURE MenuItemEnable(mh                  : MenuHandlePtr;
                         menuNr,itemNr,subNr : INTEGER;
                         enable              : BOOLEAN);
VAR menu     : MenuPtr;
    item,sub : MenuItemPtr;
BEGIN
  IF mh#NIL THEN
    item:=GetMenuItem(mh,menuNr,itemNr,subNr);
    IF item#NIL THEN
      IF enable THEN
        INCL(item^.flags,itemEnabled);
      ELSE
        EXCL(item^.flags,itemEnabled);
      END;
    END;
  END;
END MenuItemEnable;



PROCEDURE ModifyMenu(mh     : MenuHandlePtr;
                     menuNr : INTEGER;
                     name   : ARRAY OF CHAR;
                     enable : BOOLEAN);
VAR menu : MenuPtr;
    txt  : POINTER TO ARRAY[0..31] OF CHAR;
BEGIN
  IF mh#NIL THEN
    menu:=GetMenu(mh,menuNr);
    IF menu#NIL THEN
      WITH mh^ DO
        txt:=menu^.menuName;
        Copy(txt^,name);
        txt^[31]:=CHR(0);
        IF enable THEN
          INCL(menu^.flags,menuEnabled);
        ELSE
          EXCL(menu^.flags,menuEnabled);
        END;
      END;
    END;
  END;
END ModifyMenu;



PROCEDURE ModifyTextItem(mh                  : MenuHandlePtr;
                         menuNr,itemNr,subNr : INTEGER;
                         text                : ARRAY OF CHAR;
                         sel                 : ARRAY OF CHAR;
                         flags               : ItemFlagSet);
VAR menu     : MenuPtr;
    item,sub : MenuItemPtr;
    fl       : MenuItemFlagSet;
    int      : IntuiTextPtr;
    txt      : POINTER TO ARRAY[0..31] OF CHAR;
BEGIN
  IF mh#NIL THEN
    item:=GetMenuItem(mh,menuNr,itemNr,subNr);
    IF item#NIL THEN
      IF itemText IN item^.flags THEN
        txt:=item^.itemFill;
        Copy(txt^,text);
        txt^[31]:=CHR(0);
        txt:=item^.selectFill;
        Copy(txt^,sel);
        txt^[31]:=CHR(0);
        fl:=item^.flags;
        IF ((checkit IN flags) OR (checkset IN flags)) AND
        (checkIt IN item^.flags) THEN
          INCL(fl,checkIt);
          IF checkset IN flags THEN
            INCL(fl,checked);
          END;
        END;
        int:=item^.selectFill;
        txt:=int^.iText;
        IF ((sel[0]=noModify) AND (Length(txt^)=0)) OR (Length(sel)=0) THEN
          IF box IN flags THEN
            EXCL(fl,highComp);
            INCL(fl,highBox);
          ELSIF non IN flags THEN
            INCL(fl,highComp);
            INCL(fl,highBox);
          ELSE
            EXCL(fl,highBox);
            INCL(fl,highComp);
          END;
        ELSE
          EXCL(fl,highComp);
          EXCL(fl,highBox);
          INCL(fl,highItem);
        END;
        IF disable IN flags THEN
          EXCL(fl,itemEnabled);
        ELSE
          INCL(fl,itemEnabled);
        END;
      END;
      item^.flags:=fl;
    END;
  END;
END ModifyTextItem;



PROCEDURE ModifyImageItem(mh                  : MenuHandlePtr;
                          menuNr,itemNr,subNr : INTEGER;
                          image               : ImagePtr;
                          sel                 : ImagePtr;
                          flags               : ItemFlagSet);
VAR menu     : MenuPtr;
    item,sub : MenuItemPtr;
    fl       : MenuItemFlagSet;
    txt      : POINTER TO ARRAY[0..31] OF CHAR;
    im       : ImagePtr;
    w        : INTEGER;
BEGIN
  IF mh#NIL THEN
    item:=GetMenuItem(mh,menuNr,itemNr,subNr);
    IF (item#NIL) AND (image#NIL) THEN
      IF NOT (itemText IN item^.flags) THEN
        im:=item^.itemFill;
        im^:=image^;
        IF im^.imageData#NIL THEN
          Deallocate(im^.imageData);
          w:=2*image^.depth*image^.height*((image^.width+15) DIV 16);
          AllocMem(im^.imageData,w,TRUE);
          IF (image^.imageData#NIL) AND (im^.imageData#NIL) THEN
            CopyMem(image^.imageData,im^.imageData,w);
          END;
        END;

        im:=item^.selectFill;
        IF sel#NIL THEN im^:=sel^; END;
        IF im^.imageData#NIL THEN
          Deallocate(im^.imageData);
          w:=2*sel^.depth*sel^.height*((sel^.width+15) DIV 16);
          AllocMem(im^.imageData,w,TRUE);
          IF (sel^.imageData#NIL) AND (im^.imageData#NIL) THEN
            CopyMem(sel^.imageData,im^.imageData,w);
          END;
        END;

        fl:=item^.flags;
        IF ((checkit IN flags) OR (checkset IN flags)) AND
        (checkIt IN item^.flags) THEN
          INCL(fl,checkIt);
          IF checkset IN flags THEN
            INCL(fl,checked);
          END;
        END;
        IF (sel=NIL) THEN
          IF box IN flags THEN
            EXCL(fl,highComp);
            INCL(fl,highBox);
          ELSIF non IN flags THEN
            INCL(fl,highComp);
            INCL(fl,highBox);
          ELSE
            EXCL(fl,highBox);
            INCL(fl,highComp);
          END;
        ELSE
          EXCL(fl,highComp);
          EXCL(fl,highBox);
          INCL(fl,highItem);
        END;
        IF disable IN flags THEN
          EXCL(fl,itemEnabled);
        ELSE
          INCL(fl,itemEnabled);
        END;
      END;
      item^.flags:=fl;
    END;
  END;
END ModifyImageItem;



PROCEDURE WaitForPossibleAction(win       : WindowPtr;
                                VAR idcmp : IDCMPFlagSet) : MessageType;
VAR msg : IntuiMessagePtr;
    mt  : MessageType;
BEGIN
  mt:=otherStuff;
  IF win#NIL THEN
    IF win^.userData#NIL THEN
      ReplyMsg(win^.userData);
      win^.userData:=NIL;
    END;
    WaitPort(win^.userPort);
    msg:=GetMsg(win^.userPort);
    IF msg#NIL THEN
      idcmp:=msg^.class;
      IF menuPick IN idcmp THEN
        mt:=menuSelected;
      ELSIF gadgetUp IN idcmp THEN
        mt:=gadgetReleased;
      ELSIF gadgetDown IN idcmp THEN
        mt:=gadgetSelected;
      ELSIF reqSet IN idcmp THEN
        mt:=requesterSet;
      ELSIF reqClear IN idcmp THEN
        mt:=requesterCleared;
      ELSE
        mt:=otherStuff;
      END;
    END;
    win^.userData:=ADDRESS(msg);
  END;
  RETURN mt;
END WaitForPossibleAction;



PROCEDURE GetMenuSelection(win                     : WindowPtr;
                           VAR menuNr,itemNr,subNr : INTEGER);
VAR msg      : IntuiMessagePtr;
    msgclass : IDCMPFlagSet;
    msgcode  : CARDINAL;
    item     : MenuItemPtr;
BEGIN
  menuNr:=-1; itemNr:=-1; subNr:=-1;
  IF win#NIL THEN
    IF win^.userData#NIL THEN
      msg:=win^.userData;
      win^.userData:=NIL;
    ELSE
      msg:=GetMsg(win^.userPort);
    END;
    IF msg#NIL THEN
      msgclass:=msg^.class;
      msgcode:=msg^.code;
      ReplyMsg(msg);
      IF (menuPick IN msgclass) AND (msgcode#menuNull) THEN
        menuNr:=msgcode MOD 32;
        itemNr:=(msgcode DIV 32) MOD 64;
        subNr:=(msgcode DIV 2048) MOD 32;
        IF subNr=31 THEN
          subNr:=-1;
          IF itemNr=63 THEN
            itemNr:=-1;
            IF menuNr=31 THEN
              menuNr:=-1;
            END;
          END;
        END;
      END;
    END;
  END;
END GetMenuSelection;



VAR rememberGadgets : NewRememberPtr;


PROCEDURE GetIDGadget(gh : GadgetHandlePtr;
                      id : INTEGER) : GadgetsPtr;
VAR return,h : GadgetsPtr;
    rem      : NewRememberPtr;
BEGIN
  return:=NIL;
  rem:=gh^.gadgets;
  WHILE rem#NIL DO
    h:=GetAddress(rem);
    rem:=rem^.next;
    IF h^.gadget.gadgetID=id THEN
      return:=h;
      rem:=NIL;
    END;
  END;
  RETURN return;
END GetIDGadget;



PROCEDURE GetGadgetStructure(g : GadgetsPtr) : GadgetPtr;
BEGIN
  IF g#NIL THEN
    RETURN ADDRESS(g);
  ELSE
    RETURN NIL;
  END;
END GetGadgetStructure;



PROCEDURE SetDefaultGadgetFont(gh : GadgetHandlePtr);
BEGIN
  IF gh#NIL THEN
    IF gh^.actFont#NIL THEN
      CloseFont(gh^.actFont);
      gh^.actFont:=NIL;
    END;
  END;
END SetDefaultGadgetFont;



PROCEDURE SetGadgetFont(gh     : MenuHandlePtr;
                        font   : ARRAY OF CHAR;
                        height : CARDINAL;
                        styles : FontStyleSet) : BOOLEAN;
VAR get,sub,h : INTEGER;
    ok        : BOOLEAN;
    at        : POINTER TO FAttr;

BEGIN
  IF gh#NIL THEN
    SetDefaultMenuFont(gh);
    at:=NewAllocRemember(gh^.fontAttr,SIZE(FAttr),FALSE);
    Copy(at^.name,font); Concat(at^.name,".font");
    WITH at^.attr DO
      ySize:=height; style:=styles; flags:=FontFlagSet{};
      name:=ADR(at^.name);
    END;
    gh^.actFontAttr:=ADR(at^.attr);
    WITH gh^ DO
      actFont:=OpenDiskFont(gh^.actFontAttr);
      IF actFont#NIL THEN
        RETURN TRUE;
      ELSE
        RETURN FALSE;
      END;
    END;
  ELSE
    RETURN FALSE;
  END;
END SetGadgetFont;



PROCEDURE InitGadgetList(window       : WindowPtr;
                         requester    : RequesterPtr;
                         standardFont : ARRAY OF CHAR;
                         height       : CARDINAL;
                         styles       : FontStyleSet) : GadgetHandlePtr;
VAR gh  : GadgetHandlePtr;
    err : BOOLEAN;
    str : POINTER TO ARRAY[0..31] OF CHAR;
BEGIN
  gh:=NewAllocRemember(rememberGadgets,SIZE(GadgetHandle),FALSE);
  IF gh#NIL THEN
    gh^.window:=window;
    gh^.requester:=requester;
    gh^.gadgets:=NIL;
    gh^.fontAttr:=NIL;
    gh^.actFontAttr:=NIL;
    gh^.actFont:=NIL;
    AllocMem(gh^.defFontName,32,FALSE);
    IF gh^.defFontName#NIL THEN
      str:=ADDRESS(gh^.defFontName);
      Copy(str^,standardFont); Concat(str^,endFontname);
      WITH gh^.defFontAttr DO
        ySize:=height; style:=styles; flags:=FontFlagSet{}; name:=str;
      END;
      gh^.defFont:=OpenDiskFont(ADR(gh^.defFontAttr));
      IF gh^.defFont=NIL THEN
        str^:=stdFont+endFontname;
        WITH gh^.defFontAttr DO
          ySize:=stdHeight; style:=FontStyleSet{}; flags:=FontFlagSet{};
          name:=str;
        END;
        gh^.defFont:=OpenDiskFont(ADR(gh^.defFontAttr));
      END;
    ELSE
      CutRememberStructure(rememberGadgets,gh,TRUE);
    END;
  END;
  RETURN gh;
END InitGadgetList;



PROCEDURE AddBoolGadget(gh       : GadgetHandlePtr;
                        x,y      : INTEGER;
                        w,h      : INTEGER;
                        id       : INTEGER;
                        b1,b2    : ADDRESS;
                        flags    : BoolGadgetFlagSet;
                        mode     : DrawModeSet;
                        c1,c2    : SHORTCARD;
                        txt      : ARRAY OF CHAR;
                        image    : BOOLEAN) : GadgetsPtr;
VAR g   : GadgetsPtr;
    fl  : GadgetFlagSet;
    a   : ActivationFlagSet;
    h1  : INTEGER;
    idc : IDCMPFlagSet;
BEGIN
  g:=NIL;
  IF gh#NIL THEN
    IF GetIDGadget(gh,id)=NIL THEN
      g:=NewAllocRemember(gh^.gadgets,SIZE(Gadgets),FALSE);
      IF g#NIL THEN
        WITH g^ DO
          AllocMem(text,HIGH(txt)+2,FALSE);
          IF (text#NIL) THEN
            CopyMem(ADR(txt),text,HIGH(txt)+1);
            AllocMem(data,SIZE(IntuiText),FALSE);
            IF data#NIL THEN
              handler:=gh;
              type:=boolean;
              fl:=GadgetFlagSet{};
              IF x<0 THEN
                INCL(fl,gRelRight);
              END;
              IF y<0 THEN
                INCL(fl,gRelBottom);
              END;
              IF w<0 THEN
                INCL(fl,gRelWidth);
              END;
              IF h<0 THEN
                INCL(fl,gRelHeight);
              END;
              IF image THEN
                INCL(fl,gadgImage);
              END;
              IF b2#NIL THEN
                INCL(fl,gadgHImage);
              ELSIF bgInversid IN flags THEN
              ELSIF bgBox IN flags THEN
                INCL(fl,gadgHBox);
              ELSE
                INCL(fl,gadgHBox);
                INCL(fl,gadgHImage);
              END;
              IF bgSelected IN flags THEN
                INCL(fl,selected);
                INCL(flags,bgToggle);
              END;
              IF bgDisabled IN flags THEN
                INCL(fl,gadgDisabled);
              END;
              a:=ActivationFlagSet{relVerify,gadgImmediate,boolExtend};
              IF bgToggle IN flags THEN
                INCL(a,toggleSelect);
              END;
              WITH gadget DO
                nextGadget:=NIL; leftEdge:=x; topEdge:=y; width:=w;
                height:=h; flags:=fl; activation:=a;
                gadgetType:=boolGadget;
                IF gh^.requester#NIL THEN
                  INC(gadgetType,reqGadget);
                ELSE
                  IF gh^.window#NIL THEN
                    IF gimmeZeroZero IN gh^.window^.flags THEN
                      INC(gadgetType,gzzGadget);
                    END;
                  END;
                END;
                gadgetRender:=b1;
                selectRender:=b2;
                gadgetText:=data;
                IF gh^.actFont#NIL THEN
                  h1:=gh^.actFont^.ySize;
                ELSE
                  h1:=gh^.defFont^.ySize;
                END;
                WITH gadgetText^ DO
                  frontPen:=c1; backPen:=c2; drawMode:=mode;
                  IF gh^.actFont#NIL THEN
                    iTextFont:=gh^.actFontAttr;
                  ELSE
                    iTextFont:=ADR(gh^.defFontAttr);
                  END;
                  topEdge:=height/2-h1/2;
                  iText:=text; nextText:=NIL;
                  leftEdge:=width/2-IntuiTextLength(gadgetText)/2;
                END;
                specialInfo:=ADR(bool);
                bool.flags:=BITSET{};
                mutualExclude:=LONGSET{};
                gadgetID:=id;
              END;
              IF gh^.window#NIL THEN
                InclIDCMPFlag(gh^.window,gadgetUp);
                InclIDCMPFlag(gh^.window,gadgetDown);
                IF AddGList(gh^.window,ADDRESS(g),-1,1,gh^.requester)=NIL THEN END;
              END;
            ELSE
              Deallocate(text);
              CutRememberStructure(gh^.gadgets,g,TRUE);
            END;
          ELSE
            CutRememberStructure(gh^.gadgets,g,TRUE);
          END;
        END;
      END;
    END;
  END;
  RETURN g;
END AddBoolGadget;



PROCEDURE AddBorderBoolGadget(gh       : GadgetHandlePtr;
                              x,y      : INTEGER;
                              w,h      : INTEGER;
                              id       : INTEGER;
                              b1,b2    : BorderPtr;
                              flags    : BoolGadgetFlagSet;
                              mode     : DrawModeSet;
                              c1,c2    : SHORTCARD;
                              txt      : ARRAY OF CHAR) : GadgetsPtr;
BEGIN
  RETURN AddBoolGadget(gh,x,y,w,h,id,b1,b2,flags,mode,c1,c2,txt,FALSE);
END AddBorderBoolGadget;



PROCEDURE AddImageBoolGadget(gh       : GadgetHandlePtr;
                             x,y      : INTEGER;
                             w,h      : INTEGER;
                             id       : INTEGER;
                             i1,i2    : ImagePtr;
                             flags    : BoolGadgetFlagSet;
                             mode     : DrawModeSet;
                             c1,c2    : SHORTCARD;
                             txt      : ARRAY OF CHAR) : GadgetsPtr;
BEGIN
  RETURN AddBoolGadget(gh,x,y,w,h,id,i1,i2,flags,mode,c1,c2,txt,TRUE);
END AddImageBoolGadget;



PROCEDURE AddBoolGadgetMask(g    : GadgetsPtr;
                            mask : ADDRESS);
BEGIN
  IF (g#NIL) AND (mask#NIL) THEN
    IF g^.type=boolean THEN
      g^.bool.flags:=BITSET{0};
      g^.bool.mask:=mask;
    END;
  END;
END AddBoolGadgetMask;



PROCEDURE AddPropGadget(gh       : GadgetHandlePtr;
                        x,y      : INTEGER;
                        w,h      : INTEGER;
                        id       : INTEGER;
                        im1,im2  : ImagePtr;
                        flags    : PropGadgetFlagSet;
                        xr,yr    : CARDINAL;
                        xd,yd    : CARDINAL;
                        xp,yp    : CARDINAL) : GadgetsPtr;
VAR g   : GadgetsPtr;
    fl  : GadgetFlagSet;
    a   : ActivationFlagSet;
    pf  : PropInfoFlagSet;
    idc : IDCMPFlagSet;
BEGIN
  g:=NIL;
  IF gh#NIL THEN
    IF GetIDGadget(gh,id)=NIL THEN
      g:=NewAllocRemember(gh^.gadgets,SIZE(Gadgets),FALSE);
      IF g#NIL THEN
        WITH g^ DO
          IF xr>0 THEN xi:=maxPot/xr+1; ELSE xi:=0; END;
          IF yr>0 THEN yi:=maxPot/yr+1; ELSE yi:=0; END;
          xm:=xr-1;
          ym:=yr-1;
          handler:=gh;
          type:=proport;
          fl:=GadgetFlagSet{};
          IF x<0 THEN
            INCL(fl,gRelRight);
          END;
          IF y<0 THEN
            INCL(fl,gRelBottom);
          END;
          IF w<0 THEN
            INCL(fl,gRelWidth);
          END;
          IF h<0 THEN
            INCL(fl,gRelHeight);
          END;
          IF pgInversid IN flags THEN
          ELSE
            INCL(fl,gadgHBox);
            INCL(fl,gadgHImage);
          END;
          IF (im1#NIL) THEN
            INCL(fl,gadgImage);
          END;
          IF im2#NIL THEN
            INCL(fl,gadgHImage);
          END;
          IF pgDisabled IN flags THEN
            INCL(fl,gadgDisabled);
          END;
          pf:=PropInfoFlagSet{};
          IF pgBorderless IN flags THEN
            INCL(pf,propBorderless);
          END;
          IF (im1=NIL) THEN
            INCL(pf,autoKnob);
            im1:=GetColorImage(255,255,0,0,2,NIL);
          END;
          IF xr>0 THEN
            INCL(pf,freeHoriz);
          END;
          IF yr>0 THEN
            INCL(pf,freeVert);
          END;
          a:=ActivationFlagSet{relVerify,gadgImmediate};
          IF pgFollow IN flags THEN
            INCL(a,followMouse);
          END;
          WITH gadget DO
            leftEdge:=x; topEdge:=y;
            IF w<knobHmin THEN w:=knobHmin; END;
            IF h<knobVmin THEN h:=knobVmin; END;
            width:=w; height:=h;
            gadgetID:=id; mutualExclude:=LONGSET{}; specialInfo:=ADR(prop);
            gadgetRender:=im1; selectRender:=im2;
            gadgetType:=propGadget; gadgetText:=NIL;
            IF gh^.requester#NIL THEN
              INC(gadgetType,reqGadget);
            ELSE
              IF gh^.window#NIL THEN
                IF gimmeZeroZero IN gh^.window^.flags THEN
                  INC(gadgetType,gzzGadget);
                END;
              END;
            END;
            activation:=a; flags:=fl;
          END;
          IF xd>=xr THEN xd:=xr; END;
          IF yd>=yr THEN yd:=yr; END;
          IF xp>=xr THEN xp:=xr-1; END;
          IF yp>=yr THEN yp:=yr-1; END;
          WITH prop DO
            flags:=pf;
            IF (xr>0) AND (xd>0) THEN
              horizBody:=maxBody/(xr/xd);
              IF xr>1 THEN
                horizPot:=(maxPot/xr)*xp;
              ELSE
                horizPot:=0;
              END;
            END;
            IF (yr>0) AND (yd>0) THEN
              vertBody:=maxBody/(yr/yd);
              IF yr>1 THEN
                vertPot:=(maxPot/yr)*yp;
              ELSE
                vertPot:=0;
              END;
            END;
          END;
          IF gh^.window#NIL THEN
            InclIDCMPFlag(gh^.window,gadgetUp);
            InclIDCMPFlag(gh^.window,gadgetDown);
            IF pgFollow IN flags THEN
              InclIDCMPFlag(gh^.window,mouseMove);
            END;
            IF AddGList(gh^.window,ADDRESS(g),-1,1,gh^.requester)=NIL THEN END;
          END;
        END;
      END;
    END;
  END;
  RETURN g;
END AddPropGadget;



PROCEDURE AddStringGadget(gh     : GadgetHandlePtr;
                          x,y    : INTEGER;
                          w,h    : INTEGER;
                          id     : INTEGER;
                          b      : BorderPtr;
                          max    : INTEGER;
                          dp,bp  : INTEGER;
                          flags  : StringGadgetFlagSet;
                          keyMap : KeyMapPtr;
                          text   : ARRAY OF CHAR;
                          li     : LONGINT) : GadgetsPtr;
VAR g   : GadgetsPtr;
    a   : ActivationFlagSet;
    fl  : GadgetFlagSet;
    idc : IDCMPFlagSet;
BEGIN
  g:=NIL;
  IF gh#NIL THEN
    IF GetIDGadget(gh,id)=NIL THEN
      g:=NewAllocRemember(gh^.gadgets,SIZE(Gadgets),FALSE);
      IF g#NIL THEN
        AllocMem(g^.str.buffer,256,FALSE);
        AllocMem(g^.str.undoBuffer,256,FALSE);
        IF (g^.str.buffer#NIL) AND (g^.str.undoBuffer#NIL) THEN
          CopyMem(ADR(text),g^.str.buffer,255);
          WITH g^ DO
            handler:=gh;
            type:=string;
            fl:=GadgetFlagSet{};
            IF x<0 THEN
              INCL(fl,gRelRight);
            END;
            IF y<0 THEN
              INCL(fl,gRelBottom);
            END;
            IF w<0 THEN
              INCL(fl,gRelWidth);
            END;
            IF h<0 THEN
              INCL(fl,gRelHeight);
            END;
            IF sgDisabled IN flags THEN
              INCL(fl,gadgDisabled);
            END;
            IF sgBox IN flags THEN
              INCL(fl,gadgHBox);
            END;
            a:=ActivationFlagSet{relVerify,gadgImmediate};
            IF sgCentered IN flags THEN
              INCL(a,stringCenter);
            ELSIF sgRight IN flags THEN
              INCL(a,stringRight);
            END;
            IF sgLongint IN flags THEN
              INCL(a,longint);
            END;
            IF keyMap#NIL THEN
              INCL(a,altKeyMap);
            END;
            WITH str DO
              INC(max);
              IF max<2 THEN max:=2; END; IF max>254 THEN max:=255; END;
              IF dp<0 THEN dp:=0; END; IF dp>=max THEN dp:=max-1; END;
              IF bp<0 THEN bp:=0; END; IF bp>=max THEN bp:=max-1; END;
              maxChars:=max; dispPos:=dp; bufferPos:=bp;
              altKeyMap:=keyMap;
            END;
            WITH gadget DO
              nextGadget:=NIL; leftEdge:=x; topEdge:=y; width:=w;
              height:=h; flags:=fl; activation:=a;
              gadgetType:=strGadget;
              IF gh^.requester#NIL THEN
                INC(gadgetType,reqGadget);
              ELSE
                IF gh^.window#NIL THEN
                  IF gimmeZeroZero IN gh^.window^.flags THEN
                    INC(gadgetType,gzzGadget);
                  END;
                END;
              END;
              specialInfo:=ADR(str);
              gadgetRender:=b;
              selectRender:=NIL;
              gadgetText:=NIL;
              mutualExclude:=LONGSET{};
              gadgetID:=id;
            END;
            IF gh^.window#NIL THEN
              InclIDCMPFlag(gh^.window,gadgetUp);
              InclIDCMPFlag(gh^.window,gadgetDown);
              IF AddGList(gh^.window,ADDRESS(g),-1,1,gh^.requester)=NIL THEN END;
            END;
          END;
        ELSE
          IF g^.str.buffer#NIL THEN Deallocate(g^.str.buffer); END;
          IF g^.str.undoBuffer#NIL THEN Deallocate(g^.str.buffer); END;
          CutRememberStructure(gh^.gadgets,g,TRUE);
        END;
      END;
    END;
  END;
  RETURN g;
END AddStringGadget;



PROCEDURE DisplayGadget(g : GadgetsPtr);
VAR gh : GadgetHandlePtr;
BEGIN
  IF g#NIL THEN
    gh:=g^.handler;
    IF gh#NIL THEN
      RefreshGList(ADDRESS(g),gh^.window,gh^.requester,1);
    END;
  END;
END DisplayGadget;



PROCEDURE DisplayAllGadgets(gh : GadgetHandlePtr);
VAR rem : NewRememberPtr;
BEGIN
  IF gh#NIL THEN
    rem:=gh^.gadgets;
    WHILE rem#NIL DO
      DisplayGadget(GetAddress(rem));
      rem:=rem^.next;
    END;
  END;
END DisplayAllGadgets;



PROCEDURE GadgetEnable(g      : GadgetsPtr;
                       enable : BOOLEAN);
VAR gh : GadgetHandlePtr;
BEGIN
  IF g#NIL THEN
    gh:=g^.handler;
    IF gh#NIL THEN
      IF enable THEN
        OnGadget(ADDRESS(g),gh^.window,gh^.requester);
      ELSE
        OffGadget(ADDRESS(g),gh^.window,gh^.requester);
      END;
    END;
  END;
END GadgetEnable;



PROCEDURE ActivateStringGadget(gh  : GadgetHandlePtr;
                               g   : GadgetsPtr);
BEGIN
  IF (g#NIL) AND (gh#NIL) THEN
    IF g^.type=string THEN
      IF ActivateGadget(ADDRESS(g),gh^.window,gh^.requester) THEN END;
    END;
  END;
END ActivateStringGadget;



PROCEDURE GetGadgetSelection(win    : WindowPtr;
                             VAR id : INTEGER) : BOOLEAN;
VAR msg      : IntuiMessagePtr;
    msgclass : IDCMPFlagSet;
    msgcode  : CARDINAL;
    g        : GadgetPtr;
    return   : BOOLEAN;
BEGIN
  return:=FALSE;
  id:=-1;
  IF win#NIL THEN
    IF win^.userData#NIL THEN
      msg:=win^.userData;
      win^.userData:=NIL;
    ELSE
      msg:=GetMsg(win^.userPort);
    END;
    IF msg#NIL THEN
      msgclass:=msg^.class;
      msgcode:=msg^.code;
      g:=msg^.iAddress;
      ReplyMsg(msg);
      IF ((gadgetUp IN msgclass) OR (gadgetDown IN msgclass)) AND (g#NIL) THEN
        IF gadgetDown IN msgclass THEN
          return:=TRUE;
        END;
        id:=g^.gadgetID;
      END;
    END;
  END;
  RETURN return;
END GetGadgetSelection;



PROCEDURE GetPropPosition(g         : GadgetsPtr;
                          VAR xp,yp : CARDINAL);
BEGIN
  xp:=0; yp:=0;
  IF g#NIL THEN
    WITH g^ DO
      IF xi>0 THEN
        xp:=prop.horizPot/xi;
        IF xp>xm THEN xp:=xm; END;
      END;
      IF yi>0 THEN
        yp:=prop.vertPot/yi;
        IF yp>ym THEN yp:=ym; END;
      END;
    END;
  END;
END GetPropPosition;



PROCEDURE SetPropGadget(g     : GadgetsPtr;
                        xr,yr : CARDINAL;
                        xd,yd : CARDINAL;
                        xp,yp : CARDINAL);
VAR gh          : GadgetHandlePtr;
    hb,vb,hp,vp : CARDINAL;
BEGIN
  IF g#NIL THEN
    gh:=g^.handler;
    IF gh#NIL THEN
      IF xr>0 THEN
        hb:=maxBody/(xr/xd);
        IF xr>1 THEN
          hp:=(maxPot/(xr-1))*xp;
        ELSE
          hp:=0;
        END;
      END;
      IF yr>0 THEN
        vb:=maxBody/(yr/yd);
        IF yr>1 THEN
          vp:=(maxPot/(yr-1))*yp;
        ELSE
          vp:=0;
        END;
      END;
      NewModifyProp(ADDRESS(g),gh^.window,gh^.requester,g^.prop.flags,
                    hp,vp,hb,vb,1);
      IF xr>0 THEN g^.xi:=maxPot/xr+1; ELSE g^.xi:=0; END;
      IF yr>0 THEN g^.yi:=maxPot/yr+1; ELSE g^.yi:=0; END;
    END;
  END;
END SetPropGadget;



PROCEDURE GetStringContents(g       : GadgetsPtr;
                            VAR str : ARRAY OF CHAR;
                            VAR li  : LONGINT);
VAR ss : POINTER TO ARRAY[0..255] OF CHAR;
BEGIN
  IF g#NIL THEN
    IF g^.type=string THEN
      li:=g^.str.longInt;
      ss:=g^.str.buffer;
      Copy(str,ss^);
    END;
  END;
END GetStringContents;



PROCEDURE FreeGadget(gh     : GadgetHandlePtr;
                     VAR g  : GadgetsPtr);
VAR im : ImagePtr;
BEGIN
  IF (gh#NIL) AND (g#NIL) THEN
    IF RemoveGadget(gh^.window,ADDRESS(g))=NIL THEN END;
    IF g^.type=boolean THEN
      IF g^.data#NIL THEN Deallocate(g^.gadget.gadgetText^.iText); END;
      IF g^.text#NIL THEN Deallocate(g^.gadget.gadgetText); END;
    ELSIF g^.type=string THEN
      IF g^.str.buffer#NIL THEN Deallocate(g^.str.buffer); END;
      IF g^.str.undoBuffer#NIL THEN Deallocate(g^.str.buffer); END;
    ELSE
      IF autoKnob IN g^.prop.flags THEN
        im:=g^.gadget.gadgetRender; FreeImage(im);
      END;
    END;
    CutRememberStructure(gh^.gadgets,g,TRUE);
  END;
  g:=NIL;
END FreeGadget;



PROCEDURE FreeGadgetList(VAR gh : GadgetHandlePtr);
VAR rem : NewRememberPtr;
    g   : GadgetsPtr;
BEGIN
  IF gh#NIL THEN
    rem:=gh^.gadgets;
    WHILE rem#NIL DO
      g:=GetAddress(rem);
      FreeGadget(gh,g);
      rem:=rem^.next;
    END;
    SetDefaultGadgetFont(gh);
    CloseFont(gh^.defFont);
    NewFreeRemember(gh^.fontAttr,TRUE);
    Deallocate(gh^.defFontName);
    CutRememberStructure(rememberGadgets,gh,TRUE);
  END;
  gh:=NIL;
END FreeGadgetList;



VAR rememberRequester : NewRememberPtr;

TYPE SRequester    = RECORD
       req         : Requester;
       window      : WindowPtr;
       flags       : RequestFlagSet;
     END;
     SRequesterPtr = POINTER TO SRequester;


PROCEDURE GetRequester(window : WindowPtr;
                       x,y    : INTEGER;
                       w,h    : INTEGER;
                       border : BorderPtr;
                       text   : IntuiTextPtr;
                       gh     : GadgetHandlePtr;
                       bitMap : BitMapPtr;
                       flags  : RequestFlagSet;
                       fill   : SHORTCARD) : RequesterPtr;
VAR r     : SRequesterPtr;
    fl    : RequesterFlagSet;
    err   : BOOLEAN;
    rem   : NewRememberPtr;
    gg,go : GadgetsPtr;
BEGIN
  r:=NIL; gg:=NIL;
  IF window#NIL THEN
    r:=NewAllocRemember(rememberRequester,SIZE(SRequester),FALSE);
    IF r#NIL THEN
      r^.flags:=flags;
      r^.window:=window;
      IF gh#NIL THEN
        IF (gh^.window=NIL) AND (gh^.requester=NIL) THEN
          InclIDCMPFlag(window,gadgetUp);
          InclIDCMPFlag(window,gadgetDown);
          InclIDCMPFlag(window,mouseMove);
          rem:=gh^.gadgets; go:=NIL;
          WHILE rem#NIL DO
            gg:=GetAddress(rem);
            IF go#NIL THEN
              go^.gadget.nextGadget:=ADDRESS(gg);
            END;
            IF gg#NIL THEN
              INC(gg^.gadget.gadgetType,reqGadget);
            ELSE
              IF gimmeZeroZero IN window^.flags THEN
                INC(gg^.gadget.gadgetType,gzzGadget);
              END;
            END;
            rem:=rem^.next;
            go:=gg;
          END;
          rem:=gh^.gadgets;
          gg:=GetAddress(rem);
        END;
        gh^.window:=window;
        gh^.requester:=ADDRESS(r);
      END;
      fl:=RequesterFlagSet{};
      IF relDMRequester IN flags THEN
        INCL(fl,pointRel);
      END;
      IF bitMap#NIL THEN
        INCL(fl,preDrawn);
      END;
      IF noisy IN flags THEN
        INCL(fl,noisyReq);
      END;
      WITH r^.req DO
        width:=w; height:=h;
        IF pointRel IN fl THEN
          leftEdge:=0; topEdge:=0; relLeft:=x; relTop:=y;
        ELSE
          leftEdge:=x; topEdge:=y; relLeft:=0; relTop:=0;
        END;
        reqGadget:=ADDRESS(gg); reqBorder:=ADDRESS(border); reqText:=text;
        flags:=fl; backFill:=fill;
      END;
      InclIDCMPFlag(window,reqSet);
      InclIDCMPFlag(window,reqClear);
      ExclIDCMPFlag(window,menuPick);
      IF (relDMRequester IN flags) OR (absDMRequester IN flags) THEN
        err:=NOT SetDMRequest(window,ADDRESS(r));
      ELSE
        err:=NOT Request(ADDRESS(r),window);
      END;
      IF err THEN
        CutRememberStructure(rememberRequester,r,TRUE);
        r:=NIL;
      END;
    END;
  END;
  RETURN ADDRESS(r);
END GetRequester;



PROCEDURE GetReqRastPort(req : RequesterPtr) : RastPortPtr;
VAR rp : RastPortPtr;
BEGIN
  rp:=NIL;
  IF req#NIL THEN
    IF req^.reqLayer#NIL THEN
      rp:=req^.reqLayer^.rp;
    END;
  END;
  RETURN rp;
END GetReqRastPort;



PROCEDURE EndDMRequester(req : RequesterPtr);
VAR sr : SRequesterPtr;
BEGIN
  sr:=ADDRESS(req);
  IF sr#NIL THEN
    IF (relDMRequester IN sr^.flags) OR (absDMRequester IN sr^.flags) THEN
      EndRequest(req,sr^.window);
    END;
  END;
END EndDMRequester;



PROCEDURE FreeRequester(VAR req : RequesterPtr);
VAR sr : SRequesterPtr;
BEGIN
  IF req#NIL THEN
    sr:=ADDRESS(req);
    IF (relDMRequester IN sr^.flags) OR (absDMRequester IN sr^.flags) THEN
      IF NOT ClearDMRequest(sr^.window) THEN
        REPEAT
          EndRequest(req,sr^.window);
        UNTIL ClearDMRequest(sr^.window);
      END;
    ELSE
      EndRequest(req,sr^.window);
    END;
    CutRememberStructure(rememberRequester,req,TRUE);
  END;
END FreeRequester;



PROCEDURE GetIntuiMessage(window  : WindowPtr;
                          VAR msg : IntuiMessage) : BOOLEAN;
VAR imsg : IntuiMessagePtr;
    return : BOOLEAN;
BEGIN
  return:=FALSE;
  IF window#NIL THEN
    IF window^.userData#NIL THEN
      imsg:=window^.userData;
      window^.userData:=NIL;
    ELSE
      imsg:=GetMsg(window^.userPort);
    END;
    IF imsg#NIL THEN
      msg:=imsg^;
      ReplyMsg(imsg);
      return:=TRUE;
    END;
  END;
  RETURN return;
END GetIntuiMessage;



VAR iBase : IntuitionBasePtr;

PROCEDURE GetActiveWindow() : WindowPtr;
BEGIN
  IF iBase#NIL THEN
    RETURN iBase^.activeWindow;
  ELSE
    RETURN NIL;
  END;
END GetActiveWindow;



PROCEDURE GetActiveScreen() : ScreenPtr;
BEGIN
  IF iBase#NIL THEN
    RETURN iBase^.activeScreen;
  ELSE
    RETURN NIL;
  END;
END GetActiveScreen;



VAR gh  : GadgetHandlePtr;
    mh  : MenuHandlePtr;
    wh  : WindowHandlePtr;
    sh  : ScreenHandlePtr;
    rq  : RequesterPtr;
    mem : ADDRESS;
    rem : NewRememberPtr;

BEGIN

  rememberScreen:=NIL;
  rememberWindow:=NIL;
  rememberImage:=NIL;
  rememberBorder:=NIL;
  rememberText:=NIL;
  rememberMenu:=NIL;
  rememberSText:=NIL;
  rememberGadgets:=NIL;
  rememberRequester:=NIL;

  DAString[0]:=CHR(187); DAString[1]:=CHAR(0);

  iBase:=ADR(IntuitionL);

CLOSE

  rem:=rememberGadgets;
  WHILE rem#NIL DO
    gh:=GetAddress(rem);
    IF gh#NIL THEN
      FreeGadgetList(gh);
    END;
    rem:=rem^.next;
  END;
  NewFreeRemember(rememberGadgets,TRUE);

  rem:=rememberMenu;
  WHILE rem#NIL DO
    mh:=GetAddress(rem);
    FreeMenu(mh);
    rem:=rem^.next;
  END;
  NewFreeRemember(rememberMenu,TRUE);

  rem:=rememberRequester;
  WHILE rem#NIL DO
    rq:=GetAddress(rem);
    FreeRequester(rq);
    rem:=rem^.next;
  END;
  NewFreeRemember(rememberRequester,TRUE);

  rem:=rememberWindow;
  WHILE rem#NIL DO
    wh:=GetAddress(rem);
    DeleteWindow(wh^.window);
    rem:=rem^.next;
  END;
  NewFreeRemember(rememberWindow,TRUE);

  rem:=rememberScreen;
  WHILE rem#NIL DO
    sh:=GetAddress(rem);
    DeleteScreen(sh^.screen);
    rem:=rem^.next;
  END;
  NewFreeRemember(rememberScreen,TRUE);

  NewFreeRemember(rememberImage,TRUE);
  NewFreeRemember(rememberBorder,TRUE);
  NewFreeRemember(rememberText,TRUE);
  NewFreeRemember(rememberSText,TRUE);

  mem:=NIL;
  Forbid;
    AllocMem(mem,Available(FALSE)+1,FALSE);
    IF mem#NIL THEN
      Deallocate(mem);
    END;
  Permit;

END IntuitionSupport.