(* ------------------------------------------------------------------------
  :Program.       IntuisupDemo
  :Contents.      Demonstrates use of Torsten Jürgeleits intuisup.library
  :Author.        Johann Semsrott
  :Address.       Märkerweg 50d
  :Address.       D-2000 Hamburg 61 (Germany)
  :Address.       Tel.: 040/552 37 83
  :History.       v1.1 16-Aug-92
  :Copyright.     Freeware
  :Language.      Modula
  :Translator.    M2Amiga V4.0d
  :Imports.       intuisup
  :Remark.        Thanks to Torsten for his great library
  :Bugs.          ?
------------------------------------------------------------------------ *)

MODULE IntuisupDemo;

FROM Arts         IMPORT  BreakPoint,Assert;
FROM SYSTEM       IMPORT  ADDRESS,ADR,CAST,ASSEMBLE,BITSET;
FROM Call         IMPORT  Return;
FROM ExecD        IMPORT  List,ListPtr,Node,NodePtr,MemReqs,MemReqSet;
FROM ExecL        IMPORT  AllocMem,AddTail,Remove,FreeMem,RemHead,WaitPort;
FROM String       IMPORT  Concat;
FROM DiskFontL    IMPORT  OpenDiskFont;
FROM DosL         IMPORT  Delay;
FROM ExecSupport  IMPORT  NewList;
FROM GraphicsD    IMPORT  TextAttr,TextAttrPtr,TextFontPtr,FontFlagSet,FontFlags,FontStyles,FontStyleSet;
FROM IntuitionL   IMPORT  SetWindowTitles,DisplayBeep,EndRefresh,BeginRefresh; 
FROM IntuitionD   IMPORT  IDCMPFlags,IDCMPFlagSet,Image,MenuItemPtr,
                          WindowFlags,WindowFlagSet,ScreenFlags,ScreenFlagSet,
                          IntuiMessagePtr,GadgetPtr,NewWindow,WindowPtr;
FROM intuisupD    IMPORT  Button,Check,MX,String,Integer,Slider,Scroller,Cycle,Count,Listview,Palette, 
                          RenderInfoPtr,RenderInfoFlags,RenderInfoFlagSet,
                          ConvertFlagSet,ConvertFlags,
                          ClrWindowFlags,ClrWindowFlagSet,
                          RWindowFlags,RWindowFlagSet,
                          BorderData,
                          GadgetData,GadgetDataPtr,GadgetDataFlags,GadgetDataFlagSet,
                          GadgetListPtr,ISUP,curValue,dtText,
                          TextDataFlagSet,TextDataFlags,
                          MenuListPtr,MenuData,MenuDataFlagSet,MenuDataFlags,
                          AutoRequesterFlags,AutoRequesterFlagSet;

FROM intuisupL    IMPORT  IGetRenderInfo,IFreeRenderInfo,IDrawBorder,
                          IConvertUnsignedDec,IConvertSignedDec,IConvertBin,IConvertHex,
                          IPrintText,
                          IOpenWindow,ICloseWindow,IClearWindow,IDisplayBorders,
                          ICreateGadgets,IDisplayGadgets,IRemoveGadgets,IFreeGadgets,IRefreshGadgets,
                          ISetGadgetAttributes,
                          IGadgetAddress,IGetMsg,IReplyMsg,
                          ICreateMenu,IAttachMenu,IMenuItemAddress,IRemoveMenu,
                          IFreeMenu,
                          IBuildLanguageTextArray,IFreeLanguageTextArray,
                          IAutoRequest;

CONST lButton = 068H; rButton = 069H;
      Winwidth= 620;  Winheight=250;
      msgLE= 0;       msgHE=8;      msgTE=Winheight-msgHE-5;    msgWI=Winwidth; 
      gadgets=50;     noFlag=GadgetDataFlagSet{};
    
TYPE  border=RECORD
        LE,TE,WI,HE:INTEGER;
      END;
    
  strPtr=POINTER TO ARRAY [0..79] OF CHAR;
VAR
  nw        :NewWindow;
  WinPtr    :WindowPtr;
  riPtr     :RenderInfoPtr;
  glPtr     :GadgetListPtr;
  mlPtr     :MenuListPtr;
  gd        :ARRAY [0..gadgets] OF GadgetData;
  bd        :ARRAY [0..gadgets] OF border;
  text      :ARRAY [0..gadgets+1] OF ADDRESS;
  gdFLAGS   :ARRAY [0..gadgets] OF GadgetDataFlagSet;
  gdNOFLAGS :ARRAY [0..gadgets] OF GadgetDataFlagSet;
  md        :ARRAY [1..18] OF MenuData;
  stFlags,textFlags   :GadgetDataFlagSet;
  gdf       :GadgetDataFlags;
  class     :IDCMPFlagSet;
  buffer,nr :ARRAY [0..79] OF CHAR;
  mx        :ARRAY [0..12] OF LONGINT;
  ltaptr,lta:ARRAY [0..2] OF ADDRESS;
  clrmodus  :ClrWindowFlagSet;
  TitleList :List;
  titlePtr  :ListPtr;
  buf       :strPtr;
  img       :ARRAY [1..4] OF Image;
  count     :BOOLEAN;
  ThinAttr  :TextAttr;
  ThinFont  :TextFontPtr;
  j         :ADDRESS;
  iptr      :MenuItemPtr;
  Value,n,n0,FLAGS:LONGCARD;
  value,nr1,nr2   :LONGINT;
  code,Menu,Item,SubItem,menuPen,aktivGadget,index  :CARDINAL;
  mouseX,mouseY,entries,language,i,countmode            :INTEGER;
  
(*$ EntryExitCode:=FALSE *)
PROCEDURE startDat;       (* Imagedaten für Gadget 15 (normal image) *)

BEGIN
   (* Plane 1 *)
   ASSEMBLE (DC.W  $FFFF, $FF00, $8000, $0100, $8060, $0100, $8078, $0100 END);
   ASSEMBLE (DC.W  $807E, $0100, $807F, $8100, $807E, $0100, $8078, $0100 END);
   ASSEMBLE (DC.W  $8060, $0100, $8000, $0100, $8000, $0100, $FFFF, $FF00 END);
   (* Plane 2 *)
   ASSEMBLE (DC.W  $0000, $0000, $7FFF, $FE00, $7FFF, $FE00, $7FFF, $FE00 END);
   ASSEMBLE (DC.W  $7FFF, $FE00, $7FFF, $FE00, $7FFF, $FE00, $7FFF, $FE00 END);
   ASSEMBLE (DC.W  $7FFF, $FE00, $7FFF, $FE00, $7FFF, $FE00, $0000, $0000 END);
END startDat;

(*$ EntryExitCode:=FALSE *)
PROCEDURE stopDat;        (* Imagedaten für Gadget 15 (select image) *)

BEGIN
   (* Plane 1 *)
   ASSEMBLE (DC.W  $FFFF, $FF00, $8000, $0100, $8000, $0100, $80FE, $0100 END);
   ASSEMBLE (DC.W  $80FE, $0100, $80FE, $0100, $80FE, $0100, $80FE, $0100 END);
   ASSEMBLE (DC.W  $80FE, $0100, $8000, $0100, $8000, $0100, $FFFF, $FF00 END);
   (* Plane 2 *)
   ASSEMBLE (DC.W  $0000, $0000, $7FFF, $FE00, $7FFF, $FE00, $7FFF, $FE00 END);
   ASSEMBLE (DC.W  $7FFF, $FE00, $7FFF, $FE00, $7FFF, $FE00, $7FFF, $FE00 END);
   ASSEMBLE (DC.W  $7FFF, $FE00, $7FFF, $FE00, $7FFF, $FE00, $0000, $0000 END);
END stopDat;

(*$ EntryExitCode:=FALSE *)
PROCEDURE knobhDat;       (* Imagedaten für Gadget 8 (horiz. slider knob) *)
BEGIN
   (* Plane 1 *)
   ASSEMBLE (DC.W  $0400, $0E00, $0E00, $6EC0, $9F20, $9F20, $6EC0, $0E00 END);
   ASSEMBLE (DC.W  $0E00, $0400 END);
END knobhDat;

(*$ EntryExitCode:=FALSE *)
PROCEDURE knobvDat;       (* Imagedaten für Gadget 10 (vert. slider knob) *)
BEGIN
   (* Plane 1 *)
   ASSEMBLE (DC.W  $1800, $2400, $2400, $1800, $7E00, $FF00, $7E00, $1800 END);
   ASSEMBLE (DC.W  $2400, $2400, $1800 END);
END knobvDat;

PROCEDURE InitIMAGES;
VAR i:  INTEGER;
BEGIN
  FOR i:=1 TO 4 DO
    WITH img[i] DO
      leftEdge  := 0;
      topEdge   := 0;
      IF i<3 THEN depth:= 2;planePick := 3;
             ELSE depth:=1;planePick  := 1;END; 
      planeOnOff  := 0;
      nextImage := NIL;
      CASE i OF
        1:imageData:=ADR(startDat);height:=12;width:=24;|
        2:imageData:=ADR(stopDat);height:=12;width:=24;|
        3:imageData:=ADR(knobhDat);height:=10;width:=11;|
        4:imageData:=ADR(knobvDat);height:=11;width:=8;|
      END;
    END;
  END;
END InitIMAGES;

PROCEDURE SetRequester; (* erzeugt einen AutoRequest, *)
VAR lang  :ADDRESS; (* die darzustellenden Texte werden aus einer LANGUAGE-Datei ge-*)
BEGIN               (* laden; die Nummern 61..64 geben den Offset ab Dateianfang an *)
  lang:=lta[language];
  IF IAutoRequest (WinPtr,61,62,63,64,IDCMPFlagSet{diskInserted},IDCMPFlagSet{},
           AutoRequesterFlagSet{rbackFill,rtextCenter,rhotkey,rbeep,rmovePointerPos,
           rdrawRaster},lang)
  THEN END;
(*  IF IAutoRequest (WinPtr,ADR("Auto-Requester"),
            ADR("Testzeile 1\\n\\nTestzeile 2\\nTestzeile 3\\n\\nTestzeile 4"),
            ADR("_OK!"),ADR("_Nein!"),IDCMPFlagSet{diskInserted},IDCMPFlagSet{},
            AutoRequesterFlagSet{rbackFill,rtextCenter,rhotkey,rbeep,rmovePointerPos,rdrawRaster},
            NIL)
  THEN END;*)   (* Alternative: Texte sind fest vorgegeben *)
END SetRequester;

PROCEDURE OpenThinFont():BOOLEAN;       (* schmalen Font für Gadget 5 laden *)
BEGIN
  WITH ThinAttr DO
    name:=ADR("thin609.font");
    ySize:=8;
    flags:=FontFlagSet{diskFont};
    style:=FontStyleSet{};
  END;
  ThinFont:=OpenDiskFont(ADR(ThinAttr));
  IF ThinFont=NIL THEN  (* falls nicht gefunden, Requester bringen *)
    RETURN IAutoRequest (WinPtr,ADR("Auto- Requester"),
          ADR("Font\\n\\nThin609\\n\\nist nicht vorhanden.\\n\\nMit topaz weitermachen?"),
          ADR("_Ja!"),ADR("_Nein"),IDCMPFlagSet{},IDCMPFlagSet{},
          AutoRequesterFlagSet{rbackFill,rtextCenter,rhotkey,rbeep,rmovePointerPos,rdrawRaster},
          NIL);
  END;
  RETURN TRUE;
END OpenThinFont;

PROCEDURE FreeTestList;   (* Liste (z.B. für ein ListView-Gadget) wieder freigeben *)
VAR node  :NodePtr;
BEGIN
  node:=RemHead(titlePtr);
  WHILE node#NIL DO
    FreeMem(node,SIZE(Node));
    node:=RemHead(titlePtr);
  END;
END FreeTestList;

PROCEDURE BuildTestList():BOOLEAN;  (* Liste für ein ListView-Gadget aufbauen *)
VAR t   :POINTER TO ADDRESS;  (* Das gdNOFLAGS-Array enthält die für den *)
  node  :NodePtr;             (* jeweiligen Gadgettyp relevanten Flags *)
BEGIN
  stFlags:=GadgetDataFlagSet{disabled,noBorder,highComp,hotKey,noText,gdcolor2,movePointer,noClear};
  textFlags:=GadgetDataFlagSet{textLeft,textRight,textAbove,textBelow};
  text[0]:=ADR("Button");             gdNOFLAGS[0]:=stFlags+textFlags+GadgetDataFlagSet{buttonToggle};                                     
  text[1]:=ADR("\001Button (toggle)");gdNOFLAGS[1]:=stFlags+textFlags+GadgetDataFlagSet{buttonToggle};                                     
  text[2]:=ADR("\001Button (Image)"); gdNOFLAGS[2]:=stFlags+textFlags+GadgetDataFlagSet{buttonToggle,buttonImage};                                     
  text[3]:=ADR("Check");              gdNOFLAGS[3]:=stFlags+textFlags;                                                                                 
  text[4]:=ADR("Mutual Exclude");     gdNOFLAGS[4]:=stFlags+GadgetDataFlagSet{textLeft,textRight};                                                                                 
  text[5]:=ADR("String");             gdNOFLAGS[5]:=stFlags+textFlags+GadgetDataFlagSet{autoActivate,inputCenter,inputRight};                          
  text[6]:=ADR("Integer");            gdNOFLAGS[6]:=stFlags+textFlags+GadgetDataFlagSet{autoActivate,inputCenter,inputRight,unsignDec,signDec,hex,bin};
  text[7]:=ADR("Integer");            gdNOFLAGS[7]:=stFlags+textFlags+GadgetDataFlagSet{autoActivate,inputCenter,inputRight,unsignDec,signDec,hex,bin};
  text[8]:=ADR("Slider (horiz.)");    gdNOFLAGS[8]:=stFlags+textFlags+GadgetDataFlagSet{sliderImage,vertOrient};                                                  
  text[9]:=ADR("Scroller (horiz.)");  gdNOFLAGS[9]:=stFlags+textFlags+GadgetDataFlagSet{noArrows,vertOrient};                                         
  text[10]:=ADR("Slider (vert.)");    gdNOFLAGS[10]:=stFlags+textFlags+GadgetDataFlagSet{sliderImage,vertOrient};                                                 
  text[11]:=ADR("Scroller (vert.)");  gdNOFLAGS[11]:=stFlags+textFlags+GadgetDataFlagSet{noArrows,vertOrient};                                        
  text[12]:=ADR("Cycle");             gdNOFLAGS[12]:=stFlags+textFlags;                                                                                
  text[13]:=ADR("\001Cycle (hiComp)");gdNOFLAGS[13]:=stFlags+textFlags;                                                                                
  text[14]:=ADR("Count");             gdNOFLAGS[14]:=stFlags+textFlags+GadgetDataFlagSet{countSignDec};                                                
  text[15]:=ADR("Listview");          gdNOFLAGS[15]:=stFlags+GadgetDataFlagSet{readOnly,showSelected,listViewColor};                         
  text[16]:=ADR("Palette");           gdNOFLAGS[16]:=stFlags+GadgetDataFlagSet{noIndicator,indicatorTop};                                    
  t:=ADR(text[0]);
          (* benötigt wird jeweils ein Zeiger auf den Anfang eines darzustel- *)
          (* lenden Strings; das Ende der Liste wird durch NIL gekennzeichnet.*)
          (* Da die Arrayelemente hintereinanderliegen und automatisch mit '0'*)
          (* vorbesetzt sind, braucht man nur ein Element mehr als Strings    *)
          (* vorhanden sind zu deklarieren. *)
  titlePtr:=ADR(TitleList);
  NewList(titlePtr);                      (* Listenkopf einrichten *)
  WHILE t^#NIL DO 
    node:=AllocMem(SIZE(Node),MemReqSet{public,memClear});  (* Speicher reservieren *)
    IF node #NIL THEN
      node^.name:=t^;         (* Adresse in Knoten eintragen *)
      AddTail(titlePtr,node); (* Knoten am Ende der Liste anfügen *)
      INC(t,4);
    ELSE
      FreeTestList;           (* unvollständige Liste wieder entfernen *)
      Assert(node#NIL,ADR("Speichermangel!"));
      RETURN FALSE;
    END;
  END;
  RETURN TRUE;
END BuildTestList;

PROCEDURE GetIMes(WinPtr:WindowPtr; VAR code:CARDINAL;
                  VAR value:LONGINT;
                  VAR class:IDCMPFlagSet):BOOLEAN;
VAR msg :IntuiMessagePtr;
BEGIN
  msg:=IGetMsg(WinPtr^.userPort);
  IF msg#NIL THEN
    code:=msg^.code;
    value:=msg^.iAddress;
    class:=msg^.class;
    mouseX:=msg^.mouseX;
    mouseY:=msg^.mouseY;
    IReplyMsg(msg);
    IF ISUP=class THEN RETURN TRUE;   (* Ausstieg, wenn intuisup-Meldung vorliegt *)
(*    ELSIF (closeWindow IN class)  THEN value :=1000;  
      ELSIF (rawKey IN class)       THEN value := -2;
      ELSIF (vanillaKey IN class)   THEN value := -3;
      ELSIF (mouseMove IN class)    THEN value := -4;
      ELSIF (newSize IN class)      THEN value := 997;
      ELSIF (mouseButtons IN class) THEN
        IF code=lButton THEN value:=999; END;
        IF code=rButton THEN value:=998; END;
      ELSIF (intuiTicks IN class)   THEN RETURN FALSE;*)
    END;
  END;
  RETURN (msg#NIL);(* Ausstieg, wenn keine oder eine Standard-IDCMP-Meldung vorliegt *)
END GetIMes;


PROCEDURE ModifyMenuList(opt:INTEGER);(* opt:   Wirkung: *)
VAR ltptr   :ADDRESS;                 (* 0  Menu wird entfernt, Speicher wieder freigegeben *)
BEGIN                                 (* 1  wie 0, dann: Menu wird neu kreiiert *)
  IF opt<2 THEN                       (* 2  Menu wird erstmalig kreiiert *)
    IF mlPtr#NIL THEN
      WinPtr:=IRemoveMenu(mlPtr);
      IFreeMenu(mlPtr);
    END;
  END;
  IF opt>0 THEN
    ltptr:=lta[language];   (* ltptr: Zeiger auf die sprachenspez. Textdatei *)
    mlPtr:=ICreateMenu(riPtr,WinPtr,ADR(md[1]),NIL,ltptr);
    IF mlPtr#NIL THEN
      INC(menuPen);mlPtr^.mlTextPen1:=menuPen;mlPtr^.mlTextPen2:=1;
      IAttachMenu(WinPtr,mlPtr);
    ELSE Assert(mlPtr#NIL,ADR("No Menulist found!"));
    END;
  END;
END ModifyMenuList;

PROCEDURE ModifyGadgetList(opt:INTEGER);  (* siehe ModifyMenuList *)
VAR ltptr   :ADDRESS;
BEGIN
  IF opt<2 THEN
    IF glPtr#NIL THEN
      IRemoveGadgets(glPtr);
      IFreeGadgets(glPtr);
      IClearWindow(riPtr,WinPtr,0,0,Winwidth,Winheight,clrmodus);
    END;
  END;
  IF opt>0 THEN
    glPtr:=ICreateGadgets(riPtr,ADR(gd[0]),2,4,lta[language]);
    IF glPtr#NIL THEN IDisplayGadgets(WinPtr,glPtr);
                 ELSE Assert(glPtr#NIL,ADR("No Gadgetlist found!"));
    END;
  END;
END ModifyGadgetList;

PROCEDURE Setmd(Type,sel:INTEGER;key:BOOLEAN;mu:LONGCARD);
BEGIN       (* zum bequemeren Füllen der MenuData-Records *)
  WITH md[i] DO
    mdType:=Type;
    CASE sel OF
      0:mdFlags:=MenuDataFlagSet{};|
      1:mdFlags:=MenuDataFlagSet{attribute};|
      2:mdFlags:=MenuDataFlagSet{emptyLine};|
      3:mdFlags:=MenuDataFlagSet{attribute,selected};|
      4:mdFlags:=MenuDataFlagSet{highNone};|
      5:mdFlags:=MenuDataFlagSet{highBox};|
      6:mdFlags:=MenuDataFlagSet{mdColor2};|
      7:mdFlags:=MenuDataFlagSet{Disabled};|
      ELSE
    END;
    mdText:=j;                (* Offset in LANGUAGE-Textdatei *)
    IF key THEN
      INC(j);mdCommandKey:=j; (* Shortcut aus der nächsten Zeile  *)
    ELSE                      (* der LANGUAGE-Textdatei holen *)
      mdCommandKey:=NIL;
    END;
    mdMutualExclude :=mu; (* falls mu#0 werden die Items/SubItems, für die ein *)
                          (* Bit gesetzt ist, bei Anwahl dieses Items/SubItems *)
                          (* deselektiert *)
  END;
  INC(i); (* zum nächsten ARRAY-Element weiterschalten *)
  INC(j); (* Offset in LANGUAGE-Textdatei weiterschalten *)
END Setmd;

PROCEDURE InitMenu;
BEGIN
  i:=1;                 (* mit ARRAY-Element 1 beginnen *)
  j:=65;                (* Offset für ersten Text in LANGUAGE-Textdatei ist 65 *)
  Setmd(1,0,FALSE,0);   (* Menu 0 *)
  Setmd(2,3,TRUE,510);  (* Item 0.0 *)
  Setmd(2,1,TRUE,509);  (* Item 0.1 *)
  Setmd(2,4,FALSE,0);   (* Item 0.2 *)
  Setmd(3,0,TRUE,0);    (* Item 0.2.0 *)
  Setmd(3,0,TRUE,0);    (* Item 0.2.1 *)
  Setmd(2,5,FALSE,0);   (* Item 0.3 *)
  Setmd(1,0,FALSE,0);   (* Menu 1 *)
  Setmd(2,1,TRUE,0);    (* Item 1.0 *)
  Setmd(2,2,TRUE,0);    (* Item 1.1 *)
  Setmd(2,0,FALSE,0);   (* Item 1.2 *)
  Setmd(3,0,TRUE,0);    (* Item 1.2.0 *)
  Setmd(3,6,TRUE,0);    (* Item 1.2.1 *)
  Setmd(2,0,FALSE,0);   (* Item 1.3 *)
  Setmd(3,0,TRUE,0);    (* Item 1.3.0 *)
  Setmd(3,7,TRUE,0);    (* Item 1.3.1 *)
  Setmd(2,5,TRUE,0);    (* Item 1.4 *)
  ModifyMenuList(2);    (* Menüs erstmalig einrichten/anzeigen *)
END InitMenu;

PROCEDURE SetDefaultFlags;
BEGIN
  gdFLAGS[0]:=GadgetDataFlagSet{hotKey};
  gdFLAGS[1]:=GadgetDataFlagSet{hotKey,buttonToggle};
  gdFLAGS[2]:=GadgetDataFlagSet{hotKey,buttonToggle,buttonImage,textAbove,noBorder};
  gdFLAGS[3]:=GadgetDataFlagSet{hotKey,textRight};
  gdFLAGS[4]:=GadgetDataFlagSet{hotKey,textLeft};
  gdFLAGS[5]:=GadgetDataFlagSet{autoActivate,hotKey,textLeft};
  gdFLAGS[6]:=GadgetDataFlagSet{autoActivate,hotKey,signDec,textLeft};
  gdFLAGS[7]:=GadgetDataFlagSet{autoActivate,hotKey,signDec,textLeft};
  gdFLAGS[8]:=GadgetDataFlagSet{hotKey,gdcolor2,textAbove};
  gdFLAGS[9]:=GadgetDataFlagSet{hotKey,gdcolor2,textAbove};
  gdFLAGS[10]:=GadgetDataFlagSet{hotKey,gdcolor2,vertOrient,textLeft};
  gdFLAGS[11]:=GadgetDataFlagSet{hotKey,gdcolor2,vertOrient,textRight};
  gdFLAGS[12]:=GadgetDataFlagSet{hotKey,textAbove};
  gdFLAGS[13]:=GadgetDataFlagSet{hotKey,highComp,textAbove};
  gdFLAGS[14]:=GadgetDataFlagSet{hotKey,textLeft};
  gdFLAGS[15]:=GadgetDataFlagSet{hotKey,textAbove,showSelected,listViewColor};
  gdFLAGS[16]:=GadgetDataFlagSet{hotKey,indicatorTop,textAbove};
  FOR i:=0 TO 31 DO
    gdFLAGS[17+i]:=GadgetDataFlagSet{buttonToggle};
  END;
  gdFLAGS[49]:=GadgetDataFlagSet{hotKey,gdcolor2};
END SetDefaultFlags;

PROCEDURE SetGadgets(type:LONGINT;le,te,wi,he:INTEGER;ta:TextAttrPtr;
                     l1,l2,l3:LONGINT);
BEGIN       (* zum bequemeren Füllen der GadgetData-Records *)
  WITH gd[index] DO
    gdType    :=type;
    gdFlags   :=gdFLAGS[index];
    gdLeftEdge:=le;
    gdTopEdge :=te;
    gdWidth   :=wi;
    gdHeight  :=he;
    gdText    :=index+1;  (* Offset in LANGUAGE-Textdatei, Offset beginnt *)
    gdTextAttr:=ta;       (* mit 1, Array-Index aber mit 0 *)
    gdData1   :=l1;
    gdData2   :=l2;
    gdData3   :=l3;
  END;
  WITH bd[index] DO (* wird benötigt, um später bei Auswahl per Listview- *)
    LE:=le-3;TE:=te;WI:=wi+10;HE:=he+6; (* <---- Rahmenkoordinaten *) 
  END;              (* Gadget dieses mit einem wechseln Rahmen zu umgeben *)
  INC(index); (* zum nächsten Array-Element weiterschalten *) 
END SetGadgets;

PROCEDURE SetStringGadgets(type:LONGINT;le,te,wi,he:INTEGER;ta:TextAttrPtr;
                           l1:LONGINT;l2,l3:INTEGER;l4:ADDRESS);
BEGIN (* zum bequemeren Füllen der GadgetData-Records *)
  WITH gd[index] DO
    gdType    :=type;
    gdFlags   :=gdFLAGS[index];
    gdLeftEdge:=le;
    gdTopEdge :=te;
    gdWidth   :=wi;
    gdHeight  :=he;
    gdText    :=index+1;
    gdTextAttr:=ta;
    gdInputLen:=l1;
    gdInputActivateNext:=l2;
    gdInputActivatePrev:=l3;
    gdInputDefault:=l4;
  END;
  WITH bd[index] DO
    LE:=le-3;TE:=te;WI:=wi+10;HE:=he+6;
  END;
  INC(index);
END SetStringGadgets;

PROCEDURE SetTestGadgets;
BEGIN
  index:=0;
  SetGadgets(Button,150,84,120,14,NIL,0,0,0);
  SetGadgets(Button,484,135,116,14,NIL,0,0,0);
  SetGadgets(Button,530,80,24,14,NIL,0,ADR(img[1]),ADR(img[2]));
  SetGadgets(Check,240,10,20,14,NIL,0,0,0);
  SetGadgets(MX,10,10,130,42,NIL,2,0,ADR(mx[0]));
  SetStringGadgets(String,360,30,146,14,NIL,40,7,8,ADR("Library-Test"));
  SetStringGadgets(Integer,360,48,48,14,NIL,6,8,6,nr1);
  SetStringGadgets(Integer,360,66,48,14,NIL,6,6,7,nr2);
  SetGadgets(Slider,420,180,140,14,ADR(img[3]),-10,10,0);
  SetGadgets(Scroller,420,210,140,14,NIL,4,20,8);
  SetGadgets(Slider,440,50,14,110,ADR(img[4]),-20,20,0);
  SetGadgets(Scroller,460,50,14,110,NIL,2,40,8);
  SetGadgets(Cycle,420,10,86,14,NIL,2,0,ADR(mx[4]));
  SetGadgets(Cycle,484,50,116,14,NIL,2,0,ADR(mx[9]));
  SetGadgets(Count,360,84,60,14,NIL,nr1,nr2,(nr1+nr2) DIV 2);
  SetGadgets(Listview,10,68,130,50,ADR(ThinAttr),0,aktivGadget,ADR(TitleList));
  SetGadgets(Palette,150,10,80,72,NIL,3,0,1);
END SetTestGadgets;

PROCEDURE InitGadgets;
VAR i:  INTEGER;
BEGIN
  mx[0]:=51; mx[1]:=52; (* Offsets in LANGUAGE-Textdatei; dort stehen die Texte *)
  mx[2]:=53;            (* für das Mutual-Exclude-Gadget (Gadget 4) *)
  mx[3]:=0;             (* Ende-Markierung für MX-Texte *)
  mx[4]:=54; mx[5]:=55; (* Offsets in LANGUAGE-Textdatei; dort stehen die Texte *)
  mx[6]:=56; mx[7]:=57; (* für das Cycle-Gadget (Gadget 12) *)
  mx[8]:=0;             (* Ende-Markierung für Cycle-Texte *)
  mx[9]:=58; mx[10]:=59;(* desgl. für Cycle-Gadget 13 *)
  mx[11]:=60; mx[12]:=0;
  nr1:=600;nr2:=620;
  InitIMAGES;           (* Grafiken für Gadget 14 initialisieren *) 
  SetTestGadgets;
  FOR i:=0 TO 31 DO (* Gadgets zum Verändern der Flags der Testgadgets *)
    SetGadgets(Button,10+(i DIV 8)*95,116+(i MOD 8)*14,88,14,ADR(ThinAttr),0,0,0);
  END;
  SetGadgets(Button,150,100,180,14,NIL,0,0,0);
  (* gd[gadgets] bleibt leer (ist mit '0'en vorbesetzt) und dient daher als Abschluß *)
  (* der Gadgetliste *)
  ModifyGadgetList(2);  (* Gadgets erstmalig einrichten *)
END InitGadgets;

PROCEDURE InitWindow; (* Fenster öffnen *)
BEGIN
  WITH nw DO
    leftEdge :=0; topEdge :=50; width := Winwidth; height:=Winheight;
    type :=ScreenFlagSet{wbenchScreen};
    title:=ADR("Library-Test");
    idcmpFlags := IDCMPFlagSet {closeWindow,gadgetUp,gadgetDown,mouseButtons,
                                mouseMove,intuiTicks,vanillaKey,menuPick,newSize};
    flags := WindowFlagSet {windowClose,windowDrag, windowDepth,reportMouse,
                            windowSizing,activate};
    minWidth := 40; maxWidth := 640; minHeight :=40; maxHeight :=480;
  END;
  riPtr:=IGetRenderInfo(NIL,RenderInfoFlagSet{innerWindow});
  IF riPtr#NIL THEN 
    WinPtr:=IOpenWindow(riPtr,ADR(nw),RWindowFlagSet{renderPens,centerWindow})
  ELSE
    Assert(riPtr#NIL,ADR("Got no RenderInfo!"));
  END;
END InitWindow;

PROCEDURE CloseAll;
VAR i:  INTEGER;
BEGIN
  ModifyGadgetList(0);    (* Gadgets entfernen *)
  IF riPtr#NIL THEN
    IFreeRenderInfo(riPtr); 
  END;
  ModifyMenuList(0);      (* Menüleiste entfernen *)
  IF WinPtr#NIL THEN ICloseWindow(WinPtr,FALSE);END;
  WinPtr:=NIL;
  FOR i:=0 TO 2 DO
    IF lta[i]#NIL THEN IFreeLanguageTextArray(lta[i]);END;
  END;
  FreeTestList;
END CloseAll;

PROCEDURE SetTextArray;     (* LANGUAGE-Datei öffnen *) 
BEGIN
  IF lta[language]=NIL THEN
    lta[language]:=IBuildLanguageTextArray(ltaptr[language],entries);
    IF lta[language]=NIL THEN CloseAll;Return;END;
  END;
END SetTextArray;

PROCEDURE  ConvertNumber (Number:CARDINAL;VAR Menu,Item,SubItem:CARDINAL);
VAR  NumberBits : BITSET;   (* Menu-Ereignis auswerten *)
BEGIN
  NumberBits := CAST(BITSET,Number);
  Menu := CAST(CARDINAL,(NumberBits*BITSET{0,1,2,3,4}));
  Item := CAST(CARDINAL,(NumberBits*BITSET{5,6,7,8,9,10}));
  Item := Item/32;
  SubItem := CAST(CARDINAL,(NumberBits*BITSET{11,12,13,14,15}));
  SubItem := SubItem/2048
END  ConvertNumber;

PROCEDURE SetFlags;
VAR flg:GadgetDataFlags;
BEGIN
  n:=CAST(LONGCARD,gdFLAGS[aktivGadget]);
  IF n#FLAGS THEN (* wenn sich der Zustand der Flags gegenüber dem letzten *)
    FLAGS:=n;     (* Aufruf geändert hat, dann neu darstellen *)
    FOR i:=0 TO 31 DO
      j:=n MOD 2;n:= n DIV 2;
      flg:=VAL(GadgetDataFlags,i);
      IF flg IN gdNOFLAGS[aktivGadget] THEN
        Value:=ISetGadgetAttributes(glPtr,i+17,GadgetDataFlagSet{disabled},noFlag,j,curValue,NIL);
      ELSE
        Value:=ISetGadgetAttributes(glPtr,i+17,GadgetDataFlagSet{disabled},GadgetDataFlagSet{disabled},j,curValue,NIL);
      END;
    END;
  END;
END SetFlags;

PROCEDURE CheckInput;
VAR i,j :INTEGER;
BEGIN
  WaitPort(WinPtr^.userPort);
  IF GetIMes(WinPtr,code,value,class) THEN  (* IDCMP-Meldung holen *)
    IF (closeWindow IN class) THEN
      CloseAll;
    ELSIF (newSize IN class) THEN
      BeginRefresh(WinPtr);
      IRefreshGadgets(glPtr);
      EndRefresh(WinPtr,TRUE);
    ELSIF ISUP=class THEN (* stammt sie von intuisup ? *)
                (* ja, ---> auswerten *)
      IF code<17 THEN
        aktivGadget:=code;
        SetFlags; (* Zustand der Flags des angewählten Testgadgets darstellen *) 
        IF code #15 THEN    
          Value:=ISetGadgetAttributes(glPtr,15,noFlag,noFlag,curValue,aktivGadget,titlePtr);
          (* Im ListView-Fenster die Zeile des Gadgets hervorheben, das zuletzt aktiviert wurde *)
        END;
      END;
      CASE code OF
        0:SetRequester;|      (* AutoRequester aufrufen *)
        2:count:=value=1;|    (* Zähler an/aus *)
        3:IFreeRenderInfo(riPtr);
          gd[3].gdCheckSelected:=value;
          IF value=0 THEN
            riPtr:=IGetRenderInfo(NIL,RenderInfoFlagSet{innerWindow});
          ELSE
            riPtr:=IGetRenderInfo(NIL,RenderInfoFlagSet{innerWindow,backFill});
          END;
          ModifyGadgetList(1);SetFlags;|
        4:language:=value;SetTextArray; (* Neue LANGUAGE-Datei öffnen *)
          gd[4].gdMXActiveEntry:=value;
          ModifyMenuList(1);            (* Menüs neu einrichten/anzeigen *)
          ModifyGadgetList(1);          (* Gadgets neu einrichten *)
          i:=ISetGadgetAttributes(glPtr,4,GadgetDataFlagSet{},GadgetDataFlagSet{},2,language,ADR(mx[0]));|
        5:buf:=CAST(ADDRESS,value);     (* String entgegennehmen und in die Titelzeile setzen *)
          SetWindowTitles(WinPtr,buf,NIL);|
        6..7:IF code=6 THEN nr1:=value ELSE nr2:=value;END;
             i:=ISetGadgetAttributes(glPtr,14,GadgetDataFlagSet{},GadgetDataFlagSet{},nr1,nr2,(nr1+nr2) DIV 2);|
              (* obere/untere Grenze des Count-Gadgets neu setzen *)
        12:IClearWindow(riPtr,WinPtr,518,8,24,24,clrmodus); 
          IDrawBorder(riPtr,WinPtr,520,10,20,20,value+1);|  (* Rahmen zeichnen *)
        13:countmode:=value;| (* Zählmodus einstellen *)
        15:IClearWindow(riPtr,WinPtr,0,0,Winwidth,Winheight,clrmodus);
          IRefreshGadgets(glPtr);
          aktivGadget:=value;SetFlags;
          FOR j:=1 TO 20 DO (* angewähltes Gadget mit flackerndem Rahmen umgeben *)
            IDrawBorder(riPtr,WinPtr,bd[value].LE,bd[value].TE,bd[value].WI,bd[value].HE,1+(j MOD 4));Delay(10);
          END;|
        16:IF value=0 THEN BreakPoint(ADR("Breakpoint!!"));END;|    (* Funktioniert nur mit spez. Debugger *)
        17:IF value=1 THEN 
            Value:=ISetGadgetAttributes(glPtr,aktivGadget,GadgetDataFlagSet{disabled},GadgetDataFlagSet{disabled},curValue,curValue,curValue);
            INCL(gdFLAGS[aktivGadget],disabled);
           ELSE
            Value:=ISetGadgetAttributes(glPtr,aktivGadget,GadgetDataFlagSet{disabled},GadgetDataFlagSet{},curValue,curValue,curValue);
            EXCL(gdFLAGS[aktivGadget],disabled);
           END;|
        18..48:gdf:=VAL(GadgetDataFlags,code-17);
               IF value=1 THEN 
                  INCL(gdFLAGS[aktivGadget],gdf);
               ELSE
                  EXCL(gdFLAGS[aktivGadget],gdf);
               END;|
        49:IClearWindow(riPtr,WinPtr,0,0,Winwidth,Winheight,clrmodus);
          SetTestGadgets;
          Value:=ISetGadgetAttributes(glPtr,15,noFlag,noFlag,curValue,aktivGadget,titlePtr);
          ModifyGadgetList(1);
          FLAGS:=0;SetFlags;|
        ELSE
      END;
      IClearWindow(riPtr,WinPtr,msgLE,msgTE,msgLE+msgWI-12,msgTE+msgHE-1,clrmodus);
      i:=IConvertUnsignedDec(code,ADR(nr),ConvertFlagSet{});
      buffer:="Gadget :";Concat(buffer,nr);
      IF code=5 THEN
        Concat(buffer,"  Text:");
        buf:=CAST(ADDRESS,value);
        Concat(buffer,buf^);
      ELSE
        i:=IConvertSignedDec(value,ADR(nr),ConvertFlagSet{});
        Concat(buffer,"  Wert:");Concat(buffer,nr);
      END;
      i:=IPrintText(riPtr,WinPtr,ADR(buffer),0,msgTE,dtText,TextDataFlagSet{Center,Color2},NIL);
      (* ^------- Gadget-Meldungen darstellen -------^ *)
      (*  _______ Meldungen darstellen _____________ *)
      (* |                                          | *)
    ELSIF (menuPick IN class) THEN
      WHILE code#65535 DO
        IClearWindow(riPtr,WinPtr,msgLE,msgTE,msgLE+msgWI-12,msgTE+msgHE-1,clrmodus);
        iptr:=IMenuItemAddress(mlPtr,code);
        ConvertNumber(code,Menu,Item,SubItem);
        i:=IConvertUnsignedDec(Menu,ADR(nr),ConvertFlagSet{});
        buffer:="Menu :";Concat(buffer,nr);
        i:=IConvertUnsignedDec(Item,ADR(nr),ConvertFlagSet{});
        IF Item#63 THEN
          Concat(buffer,"  Item :");Concat(buffer,nr);
          i:=IConvertUnsignedDec(SubItem,ADR(nr),ConvertFlagSet{});
          IF SubItem#31 THEN
            Concat(buffer,"  SubItem :");Concat(buffer,nr);
          END;
        END;
        IF (Menu=0) AND (Item=3) THEN CloseAll;END;
        i:=IPrintText(riPtr,WinPtr,ADR(buffer),0,msgTE,dtText,TextDataFlagSet{Center,Color2},NIL);
        IF iptr#NIL THEN            (* liegt noch eine Menu-Wahl vor? *)
          code:=iptr^.nextSelect;
          IF code#65535 THEN Delay(50);DisplayBeep(NIL);END;    (* Ja! *)
        ELSE
          code:=65535;
        END;
      END;
    ELSIF (intuiTicks IN class) THEN
      IF count THEN     (* zählen? *)
        INC(n0);        (* ja! *)
        CASE countmode OF
          0:i:=IConvertSignedDec(n0,ADR(buffer),ConvertFlagSet{});|
          1:i:=IConvertHex(n0,ADR(buffer),ConvertFlagSet{});|
          2:i:=IConvertBin(n0,ADR(buffer),ConvertFlagSet{});|
        END;
        i:=IPrintText(riPtr,WinPtr,ADR(buffer),Winwidth-8,100,dtText,TextDataFlagSet{PlaceLeft,Backfill},NIL);
      END;
    END;
  END;
END CheckInput;

BEGIN
  clrmodus:=ClrWindowFlagSet{};aktivGadget:=0;
  entries:=92;language:=0;menuPen:=2;n0:=0;
  ltaptr[0]:=ADR("Language:german.language");
  ltaptr[1]:=ADR("Language:english.language");
  ltaptr[2]:=ADR("Language:french.language");
  SetTextArray;
  IF OpenThinFont() THEN
    IF BuildTestList() THEN END;
    InitWindow;
    SetDefaultFlags;
    InitGadgets;
    InitMenu;
    SetFlags;
    WHILE WinPtr#NIL DO
      CheckInput;
    END;
  ELSE
    CloseAll;
  END;
END IntuisupDemo.

(* Language:german.language *)
(* Language:english.language *)
(* Language:french.language *)