(*-------------------------------------------------------------------------
 :Program.       IntuiSupport.mod
 :Contents.      Easy programming of Intuition
 :Author.        Christian Stiens
 :Address.       Heustiege 2, W-4710 Lüdinghausen
 :Copyright.     public domain
 :Language.      Oberon-2
 :Translator.    Amiga Oberon V2.45d (inofficial ß-version)
 :History.       V1.1, 26-Aug-90: first release
 :History.       V1.2, 25-Jun-92: ported to Oberon, many improvements
 :History.       V1.3, 10-Dez-92: cosmetic changes
-------------------------------------------------------------------------*)

MODULE IntuiSupport;

  IMPORT
    e  := Exec,
    g  := Graphics,
    I  := Intuition,
    ol := OberonLib,
    rq := Requests,
    str:= Strings,
    u  := Utility,
    SYS:= SYSTEM;

  CONST
    autoBorder * = SYS.VAL(I.BorderPtr,1);

    stdWin  * = LONGSET{I.windowSizing,I.windowDrag,I.windowDepth,I.activate,I.gimmeZeroZero,I.windowClose};
    stdIdcmp* = LONGSET{I.closeWindow};
    stdGad  * = I.gadgHComp;
    stdAct  * = {I.gadgImmediate,I.relVerify};
    stdItem * = {I.itemText,I.highComp,I.itemEnabled};
    stdReq  * = {};
    stdHPrp * = {I.freeHoriz,I.autoKnob};
    stdVPrp * = {I.freeVert,I.autoKnob};
    std2Prp * = {I.freeVert,I.freeHoriz,I.autoKnob};

    topaz80 * = g.TextAttr(SYS.ADR("topaz.font"),8,SHORTSET{},SHORTSET{});
    topaz60 * = g.TextAttr(SYS.ADR("topaz.font"),9,SHORTSET{},SHORTSET{});

  TYPE
    BoolGadgetPtr * = UNTRACED POINTER TO BoolGadget;
    StrGadgetPtr  * = UNTRACED POINTER TO StrGadget;
    PropGadgetPtr * = UNTRACED POINTER TO PropGadget;

    BoolGadget * = STRUCT
      (gad * : I. Gadget)
      info * : I.BoolInfo;
    END;

    StrGadget * = STRUCT
      (gad * : I.Gadget)
      info * : I.StringInfo;
      ext  * : I.StringExtend;
    END;

    PropGadget * = STRUCT
      (gad * : I.Gadget)
      info * : I.PropInfo;
    END;

    NewWindowProc * = PROCEDURE (nw: I.NewWindowPtr);
    NewScreenProc * = PROCEDURE (ns: I.NewScreenPtr);

  VAR
    autoBorderProc  * : PROCEDURE (le,to,wi,he: INTEGER): I.BorderPtr;
    itemLeftEdge    * : INTEGER;
    itemTopEdge     * : INTEGER;
    blackPen        * : SHORTINT;
    whitePen        * : SHORTINT;
    gadgetFrontPen  * : SHORTINT;
    gadgetBackPen   * : SHORTINT;
    msgFilter       * : LONGSET;
    font            * : g.TextAttrPtr;
    createReqBorder * : BOOLEAN;
    createStrBorder * : BOOLEAN;
    magic             : LONGINT;
    firstMenu       - : I.MenuPtr;
    lastMenu        - : I.MenuPtr;
    lastItem        - : I.MenuItemPtr;
    lastSub         - : I.MenuItemPtr;


  CONST
    oom = "Out of memory";
    cos = "Can't open screen";
    ccs = "Can't close screen";
    cow = "Can't open window";
    pos = "Retry";
    neg = "Cancel";
    orq = "Oberon Request:";


  PROCEDURE CreateScreen * (title       : ARRAY OF CHAR;
                            le,to,wi,he : INTEGER;
                            depth       : INTEGER;
                            mode        : SET;
                            nsProc      : NewScreenProc): I.ScreenPtr;  (* $CopyArrays- *)
    VAR ns    : I.ExtNewScreen;
        scr   : I.ScreenPtr;
        tags2 : u.Tags2;
  BEGIN
    ns.ns.leftEdge:=le;
    ns.ns.topEdge:=to;
    ns.ns.width:=wi;
    ns.ns.height:=he;
    ns.ns.depth:=depth;
    ns.ns.detailPen:=0;
    ns.ns.blockPen:=1;
    ns.ns.defaultTitle:=SYS.ADR(title);
    IF title[0]=0X THEN ns.ns.defaultTitle:=NIL END;
    ns.ns.viewModes:=mode;
    ns.ns.type:=I.customScreen+{I.nsExtended};
    ns.ns.font:=font;
    ns.ns.gadgets:=NIL;
    ns.ns.customBitMap:=NIL;
    tags2 := u.Tags2(I.saPens,SYS.ADR("\xff\xff"),u.done,NIL);
    ns.extension := SYS.ADR(tags2);
    IF nsProc # NIL THEN nsProc(SYS.ADR(ns.ns)) END;
    scr:=I.OpenScreen(ns);
    rq.Assert(scr # NIL,cos);
    scr.userData := magic;
    RETURN scr;
  END CreateScreen;


  PROCEDURE CreateWindow * (title       : ARRAY OF CHAR;
                            le,to,wi,he : INTEGER;
                            scr         : I.ScreenPtr;
                            flags       : LONGSET;
                            idcmp       : LONGSET;
                            nwProc      : NewWindowProc): I.WindowPtr; (* $CopyArrays- *)
    VAR nw  : I.NewWindow;
        win : I.WindowPtr;
  BEGIN
    nw.leftEdge:=le;
    nw.topEdge:=to;
    nw.width:=wi;
    nw.height:=he;
    nw.detailPen:=-1;
    nw.blockPen:=-1;
    nw.idcmpFlags:=idcmp;
    nw.flags:=flags;
    nw.firstGadget:=NIL;
    nw.checkMark:=NIL;
    nw.title:=SYS.ADR(title);
    IF title[0]=0X THEN nw.title:=NIL END;
    nw.bitMap:=NIL;
    nw.minWidth :=90;
    nw.minHeight:=40;
    nw.maxWidth :=-1;
    nw.maxHeight:=-1;
    IF scr=NIL THEN
      nw.type:={I.wbenchScreen};
      nw.screen:=NIL
    ELSE
      nw.type:=I.customScreen;
      nw.screen:=scr;
    END;
    IF nwProc # NIL THEN nwProc(SYS.ADR(nw)) END;
    win:=I.OpenWindow(nw);
    rq.Assert(win # NIL,cow);
    win.userData := magic;
    RETURN win;
  END CreateWindow;


  PROCEDURE GetIMsg * (win:     I.WindowPtr;
                       VAR mes: I.IntuiMessage;
                       wait:    BOOLEAN);
    VAR msg: I.IntuiMessagePtr;
        waited: BOOLEAN;
  BEGIN
    waited := NOT wait;
    msg := e.GetMsg(win.userPort);
    IF (msg = NIL) & wait THEN
      e.WaitPort(win.userPort);
      msg := e.GetMsg(win.userPort);
      waited := TRUE;
    END;
    IF msg # NIL THEN
      LOOP
        mes := msg^;
        e.ReplyMsg(msg);
        IF (mes.class * msgFilter) = LONGSET{} THEN EXIT END;
        msg := e.GetMsg(win.userPort);
        IF msg = NIL THEN
          IF NOT waited THEN mes.class := LONGSET{} END;
          EXIT;
        END;
      END;
    ELSE
      mes.class := LONGSET{}
    END;
  END GetIMsg;


  PROCEDURE AutoBorder * (le,to,wi,he:INTEGER): I.BorderPtr;
    VAR b1,b2: I.BorderPtr;
        dat: UNTRACED POINTER TO ARRAY 24 OF g.Point;
  BEGIN
    IF NOT createReqBorder THEN
      INC(le); INC(to); DEC(wi,2); DEC(he,2);
    END;
    IF createStrBorder THEN
      DEC(le,4); DEC(to,2); INC(wi,8); INC(he,4);
    END;
    ol.New(b1,SIZE(I.Border)*2 + SIZE(dat^));
    b2  := SYS.VAL(e.APTR,SYS.VAL(LONGINT,b1) + SIZE(b1^));
    dat := SYS.VAL(e.APTR,SYS.VAL(LONGINT,b2) + SIZE(b2^));
    dat[1].y:=he-1;  dat[2].y:=he-2;  dat[3].x:=1;     dat[3].y:=he-2;
    dat[4].x:=1;     dat[5].x:=wi-2;  dat[6].x:=wi-3;  dat[7].x:=wi-3;
    dat[7].y:=he-2;  dat[8].x:=wi-3;  dat[8].y:=2;     dat[9].x:=wi-4;
    dat[9].y:=2;     dat[10].x:=wi-4; dat[10].y:=he-2; dat[11].x:=3;
    dat[11].y:=he-2; dat[12].x:=wi-1; dat[12].y:=he-1; dat[13].x:=wi-1;
    dat[14].x:=wi-1; dat[14].y:=1;    dat[15].x:=wi-2; dat[15].y:=1;
    dat[16].x:=wi-2; dat[16].y:=he-1; dat[17].x:=1;    dat[17].y:=he-1;
    dat[18].x:=2;    dat[18].y:=he-1; dat[19].x:=2;    dat[19].y:=1;
    dat[20].x:=3;    dat[20].y:=1;    dat[21].x:=3;    dat[21].y:=he-3;
    dat[22].x:=3;    dat[22].y:=1;    dat[23].x:=wi-4; dat[23].y:=1;
    b1.leftEdge:=le; b1.topEdge:=to;
    b1.frontPen:=whitePen; b1.backPen:=whitePen;
    b1.drawMode:=g.jam2; b1.count:=12; b1.nextBorder := b2; b1.xy:=dat;
    b2.leftEdge:=le; b2.topEdge:=to;
    b2.frontPen:=blackPen; b2.backPen:=blackPen;
    b2.drawMode:=g.jam2; b2.count:=12; b2.xy:=SYS.ADR(dat[12]);
    IF NOT createStrBorder THEN b1.count := 6; b2.count := 6 END;
    RETURN b1
  END AutoBorder;


  PROCEDURE CreateBorder * (le,to: INTEGER;
                            fp,bp: SHORTINT;
                            dm:    SHORTSET;
                            count: SHORTINT;
                            xy:    ARRAY OF g.Point;
                            next:  I.BorderPtr): I.BorderPtr; (* $CopyArrays- *)
    VAR bord: I.BorderPtr;
  BEGIN
    NEW(bord);
    bord.leftEdge := le; bord.topEdge  := to;
    bord.frontPen := fp; bord.backPen  := bp;
    bord.drawMode := dm;
    bord.count := count;
    bord.xy := SYS.ADR(xy);
    bord.nextBorder := next;
    RETURN bord;
  END CreateBorder;


  PROCEDURE SizeBorder * (border: I.BorderPtr; dx,dy: INTEGER);
    VAR minX,maxX,minY,maxY: INTEGER;
        x,y,medX,medY : INTEGER;
        i : INTEGER;
        brd   : I.BorderPtr;
        vects : UNTRACED POINTER TO ARRAY 256 OF g.Point;
  BEGIN
    minX := MAX(INTEGER); minY := MAX(INTEGER);
    maxX := MIN(INTEGER); maxY := MIN(INTEGER);
    brd := border;
    WHILE brd # NIL DO
      vects := brd.xy;
      i := 0; WHILE i < brd.count DO
        x := vects[i].x; y := vects[i].y;
        IF x < minX THEN minX := x END;
        IF x > maxX THEN maxX := x END;
        IF y < minY THEN minY := y END;
        IF y > maxY THEN maxY := y END;
        INC(i)
      END;
      brd := brd.nextBorder;
    END;
    medX := (minX + maxX) DIV 2;
    medY := (minY + maxY) DIV 2;
    brd := border;
    WHILE brd # NIL DO
      vects := brd.xy;
      i := 0; WHILE i < brd.count DO
        IF vects[i].x > medX THEN INC(vects[i].x,dx) END;
        IF vects[i].y > medY THEN INC(vects[i].y,dy) END;
        INC(i)
      END;
      brd := brd.nextBorder;
    END;
  END SizeBorder;


  PROCEDURE CreateIntuiText * (fp,bp: SHORTINT;
                               dm:    SHORTSET;
                               le,to: INTEGER;
                               font:  g.TextAttrPtr;
                               text:  ARRAY OF CHAR;
                               next:  I.IntuiTextPtr): I.IntuiTextPtr; (* $CopyArrays- *)
    VAR it: I.IntuiTextPtr;
  BEGIN
    NEW(it);
    it.frontPen := fp;
    it.backPen  := bp;
    it.drawMode := dm;
    it.leftEdge := le;
    it.topEdge  := to;
    it.iTextFont:= font;
    it.iText    := SYS.ADR(text);
    it.nextText := next;
    RETURN it
  END CreateIntuiText;


  PROCEDURE CreateImage * (le,to,wi,he:          INTEGER;
                           depth:                INTEGER;
                           data:                 ARRAY OF SYS.BYTE;
                           planePick,planeOnOff: SHORTSET;
                           next:                 I.ImagePtr): I.ImagePtr; (* $CopyArrays- *)
    VAR im: I.ImagePtr;
  BEGIN
    NEW(im);
    im.leftEdge := le;
    im.topEdge  := to;
    im.width    := wi;
    im.height   := he;
    im.depth    := depth;
    im.imageData := SYS.ADR(data);
    im.planePick := planePick;
    im.planeOnOff:= planeOnOff;
    im.nextImage := next;
    RETURN im
  END CreateImage;


  PROCEDURE Swap(VAR a,b: SHORTINT);
    VAR temp: SHORTINT;
  BEGIN
    temp := a; a := b; b := temp;
  END Swap;


  PROCEDURE AddGadget * (win: I.WindowPtr; gad: I.GadgetPtr);
  BEGIN
    SYS.SETREG(0,I.AddGadget(win,gad^,-1));
  END AddGadget;


  PROCEDURE OffGadget * (VAR gad: I.Gadget; win: I.WindowPtr);
    VAR pos:INTEGER;
  BEGIN
    pos:=I.RemoveGadget(win,gad);
    INCL(gad.flags,I.gadgDisabled);
    SYS.SETREG(0,I.AddGadget(win,gad,pos));
    I.RefreshGList(SYS.ADR(gad),win,NIL,1);
  END OffGadget;


  PROCEDURE OnGadget * (VAR gad: I.Gadget; win: I.WindowPtr);
    VAR fgPen: SHORTINT;
        pos:INTEGER;
  BEGIN
    pos:=I.RemoveGadget(win,gad);
    EXCL(gad.flags,I.gadgDisabled);
    SYS.SETREG(0,I.AddGadget(win,gad,pos));
    fgPen := win.rPort.fgPen;
    g.SetAPen(win.rPort,0);
    g.RectFill(win.rPort,gad.leftEdge,gad.topEdge,gad.leftEdge+gad.width-1,gad.topEdge+gad.height-1);
    g.SetAPen(win.rPort,fgPen);
    I.RefreshGList(SYS.ADR(gad),win,NIL,1);
  END OnGadget;


  PROCEDURE CreateBoolGadget * (id:          INTEGER;
                                le,to,wi,he: INTEGER;
                                text:        ARRAY OF CHAR;
                                render:      e.APTR;
                                sRender:     e.APTR;
                                gadFlags:    SET;
                                actFlags:    SET): BoolGadgetPtr; (* $CopyArrays- *)
    VAR tWi,tHe: INTEGER;
        str: e.STRPTR;
        gad: BoolGadgetPtr;
        iTex:I.IntuiTextPtr;
        size: LONGINT;
  BEGIN
    size := SIZE(BoolGadget);
    IF ~ (I.boolExtend IN actFlags) THEN DEC(size,SIZE(I.BoolInfo)) END;
    ol.New(gad,size);
    gad.gad.leftEdge:=le; gad.gad.topEdge:=to; gad.gad.width:= wi; gad.gad.height:=he;
    gad.gad.flags:=gadFlags;
    gad.gad.activation:=actFlags;
    IF render=autoBorder THEN
      gad.gad.gadgetRender:=autoBorderProc(-1,-1,wi+2,he+2);
    ELSE
      gad.gad.gadgetRender:=render
    END;
    IF sRender=autoBorder THEN
      Swap(blackPen,whitePen);
      gad.gad.selectRender:=autoBorderProc(-1,-1,wi+2,he+2);
      Swap(blackPen,whitePen);
    ELSE
      gad.gad.selectRender:=sRender
    END;
    IF text="" THEN
      gad.gad.gadgetText := NIL;
    ELSIF gadFlags * I.labelMask # {} THEN
      gad.gad.gadgetText := SYS.ADR(text);
    ELSE
      str:=SYS.ADR(text);
      iTex:=CreateIntuiText(gadgetFrontPen,gadgetBackPen,g.jam2,0,0,font,str^,NIL);
      tWi:=I.IntuiTextLength(iTex^);
      IF font=NIL THEN tHe:=8 ELSE tHe:=font.ySize END;
      iTex.leftEdge := (wi-tWi) DIV 2;
      iTex.topEdge := (he-tHe) DIV 2;
      gad.gad.gadgetText:=iTex;
    END;
    gad.gad.gadgetType:=I.boolGadget;
    gad.gad.gadgetID:=id;
    IF I.boolExtend IN actFlags THEN
      gad.gad.specialInfo := SYS.ADR(gad.info)
    END;
    RETURN gad
  END CreateBoolGadget;


  PROCEDURE SetBoolMask * (gad: BoolGadgetPtr; mask: ARRAY OF SYS.BYTE); (* $CopyArrays- *)
  BEGIN
    IF I.boolExtend IN gad.gad.activation THEN
      gad.info.flags := {I.boolMask};
      gad.info.mask := SYS.ADR(mask);
    END;
  END SetBoolMask;


  PROCEDURE CreateStrGadget * (id:          INTEGER;
                               le,to,wi,he: INTEGER;
                               maxChars:    INTEGER;
                               buffer:      ARRAY OF CHAR;
                               text:        ARRAY OF CHAR;
                               render:      e.APTR;
                               gadFlags:    SET;
                               actFlags:    SET): StrGadgetPtr; (* $CopyArrays- *)
    VAR gad:  StrGadgetPtr;
        tWi:  INTEGER;
        st:   e.STRPTR;
        iTex: I.IntuiTextPtr;
        size: LONGINT;
        n:    LONGINT;
  BEGIN
    size := SIZE(StrGadget);
    IF ~((I.stringExtend IN gadFlags)OR(I.actStringExtend IN actFlags))THEN
      DEC(size,SIZE(I.StringExtend))
    END;
    ol.New(gad,size+LONG(maxChars)*2);
    gad.info.buffer := SYS.VAL(e.APTR,SYS.VAL(LONGINT,gad) + size);
    gad.info.undoBuffer := SYS.VAL(e.APTR,SYS.VAL(LONGINT,gad.info.buffer) + LONG(maxChars));
    gad.info.maxChars:=maxChars;
    gad.gad.leftEdge:=le; gad.gad.topEdge:=to;
    gad.gad.width:=wi; gad.gad.height:=he;
    gad.gad.flags:=gadFlags;
    gad.gad.activation:=actFlags;
    n := str.Length(buffer);
    IF n >= maxChars THEN n := maxChars-1 END;
    IF n > 0 THEN e.CopyMem(buffer,gad.info.buffer^,n) END;
    IF render=autoBorder THEN
      createStrBorder := TRUE;
      gad.gad.gadgetRender := autoBorderProc(-2,-2,wi+4,he+4);
      createStrBorder := FALSE;
    ELSE
      gad.gad.gadgetRender := render
    END;
    IF text="" THEN
      gad.gad.gadgetText:=NIL
    ELSE
      st:=SYS.ADR(text);
      iTex:=CreateIntuiText(gadgetFrontPen,gadgetBackPen,g.jam2,0,0,font,st^,NIL);
      tWi:=I.IntuiTextLength(iTex^);
      iTex.leftEdge := -tWi-8;
      gad.gad.gadgetText:=iTex;
    END;
    gad.gad.gadgetType:=I.strGadget;
    gad.gad.specialInfo:=SYS.ADR(gad.info);
    gad.gad.gadgetID:=id;
    IF (I.stringExtend IN gadFlags) OR (I.actStringExtend IN actFlags) THEN
      gad.info.extension := SYS.ADR(gad.ext);
    END;
    RETURN gad
  END CreateStrGadget;


  PROCEDURE SetStrExt * (gad:         StrGadgetPtr;
                         font:        g.TextFontPtr;
                         fp,bp:       SHORTINT;
                         actFp,actBp: SHORTINT;
                         initialMode: LONGSET;
                         editHook:    u.HookPtr);
  BEGIN
    IF (I.stringExtend IN gad.gad.flags) OR (I.actStringExtend IN gad.gad.activation) THEN
      gad.info.extension := SYS.ADR(gad.ext);
      gad.ext.font := font;
      gad.ext.pens[0] := fp;
      gad.ext.pens[1] := bp;
      gad.ext.activePens[0] := actFp;
      gad.ext.activePens[1] := actBp;
      gad.ext.initialMode := initialMode;
      gad.ext.editHook := editHook;
      IF editHook # NIL THEN
        ol.New(gad.ext.workBuffer,gad.info.maxChars);
      END;
    END;
  END SetStrExt;


  PROCEDURE GadgetText * (gad: StrGadgetPtr): e.APTR;
  BEGIN
    RETURN gad.info.buffer;
  END GadgetText;


  PROCEDURE GadgetVal * (gad: StrGadgetPtr): LONGINT;
  BEGIN
    RETURN gad.info.longInt;
  END GadgetVal;


  PROCEDURE HorizPot * (gad:PropGadgetPtr; steps:INTEGER): INTEGER;
  BEGIN
    RETURN SHORT(SYS.LSH(I.UIntToLong(gad.info.horizPot)*I.UIntToLong(steps),-16))
  END HorizPot;


  PROCEDURE VertPot * (gad:PropGadgetPtr; steps:INTEGER): INTEGER;
  BEGIN
    RETURN SHORT(SYS.LSH(I.UIntToLong(gad.info.vertPot)*I.UIntToLong(steps),-16))
  END VertPot;


  PROCEDURE Pot * (val,steps: INTEGER): LONGINT;
  BEGIN
    IF steps <= 1 THEN RETURN 0
    ELSE RETURN (I.UIntToLong(I.maxPot) * I.UIntToLong(val)) DIV I.UIntToLong(steps-1)
    END;
  END Pot;


  PROCEDURE Body * (steps:INTEGER): LONGINT;
  BEGIN
    IF steps <= 0 THEN RETURN 0
    ELSE RETURN I.UIntToLong(I.maxBody) DIV I.UIntToLong(steps) END;
  END Body;


  PROCEDURE SetProp * (gad                  : PropGadgetPtr;
                       win                  : I.WindowPtr;
                       req                  : I.RequesterPtr;
                       horizVal,vertVal     : INTEGER;
                       horizSteps,vertSteps : INTEGER);
    VAR
      horizBody,vertBody: LONGINT;
  BEGIN
    IF horizSteps = 0 THEN horizBody := I.UIntToLong(gad.info.horizBody)
                      ELSE horizBody := Body(horizSteps) END;
    IF vertSteps  = 0 THEN vertBody  := I.UIntToLong(gad.info.vertBody)
                      ELSE vertBody  := Body(vertSteps)  END;
    IF (win = NIL) & (req = NIL) THEN
      (* $RangeChk- *)
      gad.info.horizPot  := SHORT(Pot(horizVal,horizSteps));
      gad.info.vertPot   := SHORT(Pot(vertVal,vertSteps));
      gad.info.horizBody := SHORT(horizBody);
      gad.info.vertBody  := SHORT(vertBody);
      (* $RangeChk= *)
    ELSE
      I.NewModifyProp(gad^,win,req,gad.info.flags,
                      Pot(horizVal,horizSteps), Pot(vertVal,vertSteps),
                      horizBody,vertBody,1);
    END;
  END SetProp;


  PROCEDURE CreatePropGadget * (id:          INTEGER;
                                le,to,wi,he: INTEGER;
                                horizSteps,vertSteps: INTEGER;
                                knop:        I.ImagePtr;
                                gadFlags:    SET;
                                actFlags:    SET;
                                propFlags:   SET): PropGadgetPtr;
    VAR autoknob: I.ImagePtr;
        gad: PropGadgetPtr;
  BEGIN
    NEW(gad);
    gad.info.flags:=propFlags;
    gad.info.horizBody:=SHORT(Body(horizSteps));
    gad.info.vertBody :=SHORT(Body(vertSteps));
    gad.gad.leftEdge:=le; gad.gad.topEdge:=to; gad.gad.width:=wi; gad.gad.height:=he;
    gad.gad.flags:=gadFlags; gad.gad.activation:=actFlags; gad.gad.gadgetType:=I.propGadget;
    IF knop#NIL THEN
      gad.gad.gadgetRender:=knop
    ELSE
      NEW(autoknob);
      gad.gad.gadgetRender:=autoknob;
    END;
    gad.gad.specialInfo:=SYS.ADR(gad.info); gad.gad.gadgetID:=id;
    RETURN gad
  END CreatePropGadget;


  PROCEDURE CreateRequester * (le,to,wi,he: INTEGER;
                               relLe,relTo: INTEGER;
                               border     : I.BorderPtr;
                               text       : I.IntuiTextPtr;
                               flags      : SET;
                               backFill   : SHORTINT): I.RequesterPtr;
    VAR req: I.RequesterPtr;
  BEGIN
    NEW(req);
    req.leftEdge := le;
    req.topEdge := to;
    req.width := wi;
    req.height := he;
    req.relLeft := relLe;
    req.relTop := relTo;
    IF border=autoBorder THEN
      createReqBorder := TRUE;
      req.reqBorder := autoBorderProc(0,0,wi,he);
      createReqBorder := FALSE;
    ELSE
      req.reqBorder := border;
    END;
    req.reqText := text;
    req.flags := flags;
    req.backFill := backFill;
    RETURN req
  END CreateRequester;


  PROCEDURE AddReqGadget * (req:I.RequesterPtr; gad:I.GadgetPtr);
  BEGIN
    gad.nextGadget := req.reqGadget;
    req.reqGadget := gad;
  END AddReqGadget;


  PROCEDURE DefMenu * (name:        ARRAY OF CHAR;
                       le,to,wi,he: INTEGER;
                       enable:      BOOLEAN);    (* $CopyArrays- *)
    VAR menu: I.MenuPtr;
  BEGIN
    NEW(menu);
    menu.leftEdge:=le; menu.topEdge:=to; menu.width:=wi; menu.height:=he;
    IF enable THEN menu.flags:={I.menuEnabled} END;
    menu.menuName:=SYS.ADR(name);
    IF lastMenu=NIL THEN firstMenu:=menu ELSE lastMenu.nextMenu:=menu END;
    lastMenu:=menu; lastItem:=NIL;
  END DefMenu;


  PROCEDURE DefItem * (fill:        ARRAY OF SYS.BYTE;
                       le,to,wi,he: INTEGER;
                       itemPen:     SHORTINT;
                       mutEx:       LONGSET;
                       cmd:         CHAR;
                       flags:       SET);   (* $CopyArrays- *)
    VAR item: I.MenuItemPtr;
        str : e.STRPTR;
  BEGIN
    NEW(item);
    item.leftEdge:=le; item.topEdge:=to; item.width:=wi; item.height:=he;
    item.flags:=flags;
    item.mutualExclude:=mutEx;
    IF I.itemText IN flags THEN
      str:=SYS.ADR(fill);
      item.itemFill:=CreateIntuiText(itemPen,0,g.jam1,itemLeftEdge,itemTopEdge,font,str^,NIL);
    ELSE
      item.itemFill:=SYS.ADR(fill);
    END;
    item.command:=cmd;
    IF lastItem=NIL THEN lastMenu.firstItem:=item
                    ELSE lastItem.nextItem:=item END;
    lastItem:=item; lastSub:=NIL;
  END DefItem;


  PROCEDURE DefSub * (fill:        ARRAY OF SYS.BYTE;
                      le,to,wi,he: INTEGER;
                      itemPen:     SHORTINT;
                      mutEx:       LONGSET;
                      cmd:         CHAR;
                      flags:       SET);    (* $CopyArrays- *)
    VAR item: I.MenuItemPtr;
        str : e.STRPTR;
  BEGIN
    NEW(item);
    item.leftEdge:=le; item.topEdge:=to; item.width:=wi; item.height:=he;
    item.flags:=flags;
    item.mutualExclude:=mutEx;
    IF I.itemText IN flags THEN
      str:=SYS.ADR(fill);
      item.itemFill:=CreateIntuiText(itemPen,0,g.jam1,itemLeftEdge,itemTopEdge,font,str^,NIL);
    ELSE
      item.itemFill:=SYS.ADR(fill);
    END;
    item.command:=cmd;
    IF lastSub=NIL THEN lastItem.subItem:=item
                   ELSE lastSub.nextItem:=item END;
    lastSub:=item;
  END DefSub;


  PROCEDURE LastItem * (): I.MenuItemPtr;
  BEGIN
    IF lastSub = NIL THEN RETURN lastItem
                     ELSE RETURN lastSub END;
  END LastItem;


  PROCEDURE InstallMenuStrip * (win: I.WindowPtr): I.MenuPtr;
  BEGIN
    IF ~ I.SetMenuStrip(win,firstMenu^) THEN HALT(20) END;
    lastMenu := NIL;
    RETURN firstMenu
  END InstallMenuStrip;


  PROCEDURE DeleteWindow * (VAR win: I.WindowPtr);
  BEGIN
    IF win # NIL THEN
      IF win.menuStrip # NIL THEN I.ClearMenuStrip(win) END;
      I.CloseWindow(win);
      win := NIL;
    END;
  END DeleteWindow;


  PROCEDURE DeleteScreen * (VAR scr: I.ScreenPtr): BOOLEAN;
    VAR ok: BOOLEAN;
  BEGIN
    ok := TRUE;
    IF scr # NIL THEN
      IF I.int.libNode.version >= 36 THEN
        ok := I.CloseScreen(scr);
      ELSE
        ok := scr.firstWindow=NIL;
        IF ok THEN I.OldCloseScreen(scr) END;
      END;
      IF ok THEN scr := NIL END;
    END;
    RETURN ok;
  END DeleteScreen;


  PROCEDURE Cleanup;
    VAR win,nextwin: I.WindowPtr;
        scr,nextscr: I.ScreenPtr;
        ok: BOOLEAN;
  BEGIN
    REPEAT
      ok := TRUE;
      e.Forbid;
      LOOP
        scr := I.int.firstScreen;
        WHILE scr # NIL DO
          nextscr := scr.nextScreen;
          win := scr.firstWindow;
          WHILE win # NIL DO
            nextwin := win.nextWindow;
            IF win.userData=SYS.VAL(e.APTR,magic) THEN DeleteWindow(win) END;
            win := nextwin;
          END;
          IF scr.userData=SYS.VAL(e.APTR,magic) THEN
            IF NOT DeleteScreen(scr) THEN ok:=FALSE; EXIT END;
          END;
          scr := nextscr;
        END;
        EXIT;
      END;
      e.Permit;
      IF NOT ok THEN
        IF rq.Request(orq,ccs,"",pos) THEN END;
      END;
    UNTIL ok;
  END Cleanup;



BEGIN

  createReqBorder := FALSE;
  createStrBorder := FALSE;
  lastMenu        := NIL;
  font            := SYS.ADR(topaz80);
  autoBorderProc  := AutoBorder;
  itemLeftEdge    := 2;
  itemTopEdge     := 1;
  gadgetFrontPen  := 1;
  gadgetBackPen   := 0;
  blackPen        := 1;
  whitePen        := 2;
  msgFilter       := LONGSET{};
  magic           := SYS.VAL(LONGINT,ol.Me) + SYS.VAL(LONGINT,"ISUP");

CLOSE

  Cleanup;

END IntuiSupport.