home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PROG_GEN / GUITLS38.ZIP / GUITOOLS.MOD < prev    next >
Text File  |  1994-02-16  |  80KB  |  2,179 lines
  1. (**********************************************************************
  2. :Program.    GUITools.mod
  3. :Contents.   Functions for creating and using GUIs
  4. :Author.     Carsten Ziegeler
  5. :Address.    Augustin-Wibbelt-Str.7, 33106 Paderborn, Germany
  6. :Phone.      05254/67439
  7. :Copyright.  Freeware, refer to GUITools-Documentation
  8. :Language.   Modula-2
  9. :Translator. M2Amiga V4.1
  10. :Remark.     OS 2.0 required
  11. :Remark.     see GUITools-Documentation for detailled information
  12. :History.    v38.0  Carsten Ziegeler  16-Feb-94
  13. ***********************************************************************)
  14.  
  15. (* ------------------------------------------------------------------------
  16.  
  17. Entwicklung:
  18.  
  19.    25.03.1993 : Erste Definitionsversuche
  20.    10.04.1993 : VollfunktionsfΣhige Version mit allen n÷tigen Prozeduren
  21.    22.05.1993 : Kleinere MΣngel behoben, Konstanten fⁿr OpenIntScreen
  22.                 Version 37.0
  23.    29.08.1993 : Kleinere Erweiterungen, Version 37.3  (First Release)
  24.    26.09.1993 : Keys-Support, alle Gadgets erhalten im userData-Feld
  25.                 eine GUIGadgetInfo-Struktur, die z.T. PUBLIC ist.
  26.                 Unterstⁿtzt alle Gadget-Kinds bis auf generic und palette
  27.                 bis OS 2.04 (V37.175)
  28.    12.11.1993 : Intern wird nun jeder GUIInfoPtr mit zugeh÷rigem Window
  29.                 gemerkt und bei CloseIntWindow ggf freigegeben !
  30.    18.11.1993 : OpenIntScreenTags, OpenIntWindowTags fⁿr mehr FlexibilitΣt
  31.                 DrawBox, kleinere Verbesserungen beim Key-Handling
  32.    28.11.1993 : Beginn der Implementation von Resizable-Gadgets
  33.    01.12.1993 : Neue Font-Behandlung fⁿr Menⁿs ! Ende der Resizeable-Gads
  34.    04.12.1993 : CreateGUIInfoTags
  35.    05.12.1993 : Hook-Funktion fⁿr Key-Equivalente
  36.    17.12.1993 : CreateSpecialGadget / Refresh-Funktionen / Drawinfo
  37.    20.12.1993 : Verbesserung einer Funktionen / neues Memory-Management
  38.    22.12.1993 : Fehlerbehebung bei menuPick, menuHelp
  39.    02.01.1994 : Unterstⁿtzt nun alle Gadgets, weitere Fehler behoben
  40.    03.01.1994 : ShowRequester
  41.    06.01.1994 : Volle Requester-Unterstⁿtzung, RemoveGadgets/RemoveMenu
  42.                 verbessert und erweitert
  43.    11.01.1994 : Fehler in RedrawGadgets behoben, nun volle SpecialGadgets-
  44.                 Unterstⁿtzung mit Refresh
  45.    12.01.1994 : Erste Optimierungen + Laufzeitverbesserungen
  46.    23.01.1994 : ErklΣrungen in den Definitionsmodule ins Englische ⁿbersetzt
  47.    28.01.1994 : Fehler in RemoveGadgets behoben (CreateContext fehlte )
  48.    29.01.1994 : RememberTags filtert nun doppelte TagItems korrekt aus. Das-
  49.                 selbe tun nun auch OpenIntWindowTags/OpenIntScreenTags.
  50.    31.01.1994 : Fehler bei Speicheranforderung behoben. DrawInfo war nicht
  51.                 LONG ALIGNED !
  52.    06.02.1994 : Overflow-Problem bei DrawGadget behoben
  53.    08.02.1994 : Speicherfehler bei RemoveMenu/SetGUI behoben
  54.                 RefreshWindowFrame ⁿber Tags eingefⁿhrt
  55.    09.02.1994 : Alle Tests erfolgreich durchgefⁿhrt. Shared-Library-Problem
  56.                 bei OpenIntWindow behoben
  57.    16.02.1994 : Original DrawInfo-Struktur - keine Kopie mehr
  58.                 Version 38.0  (Second Release)
  59.  
  60. (* --------------- Speicheranforderung von GUIInfo ----------------------- *)
  61.  
  62. In Wirklichkeit wird bedeutend mehr als nur die GUIInfo-Struktur angefordert.
  63. "Dahinter" stehen noch folgende Strukturen (V38.0)
  64.  
  65. GUIWindowInfo      dadurch kann ⁿber eine die globale Variable
  66.                    allWindowsWithGUI eine Verkettung aller GUIInfo-Strukts
  67.                    erreicht werden, so da▀ eine freigabe bei CloseIntWindow
  68.                    leicht m÷glich ist
  69.  
  70. Des weiteren folgen nun die "variablen" EintrΣge. Fⁿr jedes Gadget werden
  71. 4 Bytes fⁿr den GadgetPtr reserviert, so da▀ alle Gadgets dann in einem
  72. Array von GadgetPtr erreicht werden k÷nnen.
  73. Fⁿr jeden Menu-Eintrag wird eine NewMenu-Struktur reserviert.
  74.  
  75. maxGads * 4        Array von GadgetPtr
  76. maxMenus* SIZE(NewMenu) Array von NewMenu-Strukturen
  77.  
  78. REALGUILENGTH  gibt die wirkliche LΣnge an, die reserviert wird, aber OHNE
  79.                die variablen EintrΣge !
  80. GUIWININFO     gibt den Offset der GUIWindowInfo-Struktur an
  81. GUIEND         gibt den Offset fⁿr die variablen EintrΣge an
  82.  
  83.  
  84. (* ----------------- Bedeutung der Status-Flags -------------------------- *)
  85.  
  86. Die Flags belegen 16 Bit in sind in gui^.status abgelegt.
  87.  
  88. gadgetsSet         Sind Gadgets im Window gesetzt
  89. menuSet            Menⁿ angehΣngt
  90. rememberGadTags    Alle Tags der Gadgets merken, fⁿr RedrawGadgets
  91. redrawGads         Informiert SetGUI, RedrawGadgets(.., FALSE)
  92.                    Da nun SetGUI die deaktivierten Gadgets deaktivieren mu▀
  93.                    und das erste EntryGadget ggf zur Eingabe freigibt
  94. spezialGadsNoText  GUITools-Gadgets nur neu zeichnen, nicht aber den Text
  95.                    z.B fⁿr progressIndicator wenn sich nur Indicator Σndert
  96. restoreProcessWindow bei Aufruf von FreeGUIInfo wird der windowPtr-Eintrag
  97.                      der Process-Struktur restauriert
  98. setProcessWindow   Setzt bei CreateGUIInfoTags den windowPtr-Eintrag auf
  99.                    das window
  100. refreshWF          Soll auch RefreshWindowFrame bei EndRefresh benutzt werden
  101.  
  102. (* ---------------------- interne Darstellung von GUIGadgetInfo (V38.0) -- *)
  103.  
  104. ScanGadget :
  105.  
  106.      v3 enthΣlt immer noch die Gadget-Nummer
  107.  
  108.      mxKind       : v0  : gtmxActive
  109.                     v1  : Anzahl an Auswahlm÷glichkeiten
  110.      cycleKind    : v0  : gtcyActive
  111.                     v1  : Anzahl an Auswahlm÷glichkeiten
  112.      checkboxKind : v0B : enthΣlt Status
  113.      sliderKind   : v0S : gtslLevel
  114.                     v1S : gtslMax
  115.                     v2S : gtslMin
  116.      scrollerKind : v0S : gtscTop
  117.                     v1S : gtscVisible
  118.                     v2S : gtscTotal
  119.      listviewKind : v0  : gtlvSelected
  120.                     v1  : Anzahl der EintrΣge (65535 bei 0 EintrΣgen)
  121.      paletteKind  : v0  : gtpaColor
  122.                     v1  : 2^gtpaDepth
  123.                     v2  : gtpaColorOffset
  124.  
  125.      progressIndicatorKind : v0  : piMax
  126.                              v1  : piCurr
  127.      bevelboxKind          : v0B : recessed
  128.  
  129. (* -------------------- Arbeitsweise von RememberTags ------------------ *)
  130.  
  131.   INTERNE PROZEDUR, um die angegebenen Tags eines Gadgets zu merken, diese
  132.   werden in der im userData-Feld abgelegten Info-Struktur unter tags gemerkt,
  133.   nbrTags enthΣlt die Anzahl.
  134.   Die Tags, die Werte beinhalten, die ScanGadget sich merkt, werden ausge-
  135.   filtert. Es kann sein, da▀ schon eine Tag-Liste gemerkt wurde, dann wird
  136.   eine neue aus beiden erzeugt und die erste entfernt.
  137.   ZusΣtzlich wird ein weiteres Tag mit dem Wert tagMore angehΣngt !
  138.   impTags zeigt immer auf diesen tagMore-Tag bzw NIL
  139.   Des weiteren werden doppelte TagItems ausgefiltert.
  140.  
  141. (* ---------------- Making a shared library with M2LMC -------------------- *)
  142.  
  143. (M2LMC ⌐ C.Ziegeler is freeware. It helps converting "standard"-modules into
  144.  shared-libraries ! )
  145.  
  146. Please, do all this only with a copy of the needed files !!
  147.  
  148. Before you can convert GUITools with M2LMC you have to delete the following
  149. procedures in the GUITools.def and GUITools.mod - File:
  150.  
  151. - ShowRequesterP
  152. - SimpleReqP
  153.  
  154. After the conversion into a shared library with M2LMC you have to do some
  155. changes/replacements in the file GUIToolsLib.mod before compiling !
  156.  
  157. - ConvKMsgToGMsg : Change all calls of GadWithKey into GadWithKeyE  (2 x)
  158.  
  159. - OpenIntWindow:  Replace old procedure with this one:
  160.  
  161.   (*$ EntryExitCode:=FALSE *)
  162.   CONST wst = LONGCARD(waScreenTitle);
  163.   BEGIN
  164.     ASSEMBLE(MOVE.L A2, -(A7)   MOVE.L #0, -(A7)
  165.              MOVE.L #tagEnd, -(A7)   MOVE.L A0, -(A7)
  166.              MOVE.L #wst, -(A7)      MOVE.L A7, A2
  167.              BSR.S  OpenIntWindowTags
  168.              ADD.L  #16, A7          MOVE.L (A7)+, A2
  169.              RTS    END);
  170.  
  171. - OpenIntScreen: Replace old procedure with this one:
  172.  
  173.   (*$ EntryExitCode:=FALSE *)
  174.   BEGIN
  175.   ASSEMBLE(MOVE.L A2, -(A7)    MOVE.L #0, A2
  176.                         BSR.S OpenIntScreenTags
  177.                         MOVE.L (A7)+, A2    RTS END);
  178.  
  179. - SimpleReq: Replace old procedure with this one
  180.  
  181.   (*$ EntryExitCode:=FALSE *)
  182.   BEGIN
  183.     ASSEMBLE(MOVE.L A0, A1  MOVE.L A2, -(A7)   MOVE.L #0, A0   MOVE.L #0, A2
  184.              BSR.S ShowRequester   MOVE.L (A7)+, A2  RTS END);
  185.  
  186. --------------------------------------------------------------------------- *)
  187.  
  188. IMPLEMENTATION MODULE GUITools;
  189.  
  190.   (*$ NilChk:=FALSE  EntryClear:=FALSE  StackChk:=FALSE  RangeChk:=FALSE
  191.       OverflowChk:=FALSE  CaseChk:=FALSE  ReturnChk:=FALSE  LargeVars:=FALSE
  192.   *)
  193.  
  194.   FROM SYSTEM      IMPORT ADDRESS, ADR, CAST, LONGSET, TAG, WORD;
  195.   FROM DiskFontL   IMPORT OpenDiskFont;
  196.   FROM ExecD       IMPORT ListPtr, MemReqSet, MemReqs, MsgPort, NodePtr, Task;
  197.   FROM ExecL       IMPORT AllocMem, FindTask, Forbid, FreeMem, Permit, WaitPort;
  198.   FROM GadToolsD   IMPORT NewGadgetFlagSet, NewGadgetFlags, listviewKind,
  199.                           mxKind, genericKind, numKinds, integerKind, cycleKind,
  200.                           stringKind, sliderKind, scrollerKind, NewMenu, nmEnd,
  201.                           checkboxKind, GtTags, checkboxWidth, checkboxHeight,
  202.                           mxWidth, mxHeight, buttonKind, paletteKind;
  203.   FROM GraphicsD   IMPORT TextAttrPtr, TextFontPtr, TextAttr, FontFlagSet,
  204.                           FontStyleSet, FontFlags, jam1;
  205.   FROM GraphicsL   IMPORT OpenFont, CloseFont, SetAPen, RectFill;
  206.   FROM IntuiMacros IMPORT MenuNum, ItemNum, SubNum, MenuItemUserData;
  207.   FROM IntuitionD  IMPORT DrawInfoPtr, DrawInfo, Gadget, GadgetPtr, DrawPens,
  208.                           ScreenPtr, WindowPtr, IDCMPFlagSet, IDCMPFlags,
  209.                           WindowFlagSet, EasyStruct, EasyStructPtr,
  210.                           IntuiTextPtr, MenuItemPtr, IntuiMessagePtr,
  211.                           StringInfoPtr, GaTags, WaTags, publicScreen,
  212.                           SaTags, IntuiText, GadgetFlags, menuNull, noItem;
  213.   FROM String      IMPORT Copy, Occurs, noOccur;
  214.   FROM UtilityD    IMPORT Tag, TagItem, TagItemPtr, tagMore, tagEnd,
  215.                           tagFilterNOT, tagIgnore;
  216.   FROM UtilityL    IMPORT FindTagItem, NextTagItem, ToUpper, CloneTagItems,
  217.                           FreeTagItems, FilterTagItems;
  218.  
  219. IMPORT G : GadToolsL, I : IntuitionL;
  220.  
  221. TYPE
  222.   GUIWindowInfoPtr = POINTER TO GUIWindowInfo;
  223.   GUIWindowInfo = RECORD
  224.     next   : GUIWindowInfoPtr;
  225.     prev   : GUIWindowInfoPtr;
  226.     window : WindowPtr;
  227.     gui    : GUIInfoPtr;
  228.   END;
  229.   ProcessPtr = POINTER TO Process; (* erspart Import von DosD ! *)
  230.   Process = RECORD
  231.     t : Task;  m : MsgPort; p : WORD; unwichtig : ARRAY[0..13] OF LONGCARD;
  232.     windowPtr : WindowPtr;
  233.   END;
  234.   TAGARRAY = ARRAY[0..16] OF Tag;
  235.  
  236. CONST NOTREMEMBERTAGS = TAGARRAY{Tag(gtmxActive), Tag(gtcbChecked),
  237.                                  Tag(gtcyActive), Tag(gtslMin), Tag(gtslMax),
  238.           Tag(gtslLevel), Tag(gtscTop), Tag(gtscVisible), Tag(gtscTotal),
  239.           Tag(gtlvSelected), Tag(gtpaColorOffset), Tag(gtpaColor),
  240.           Tag(sgbbRecessed), Tag(sgpiCurrentValue), Tag(sgpiMaxValue),
  241.           Tag(gaDisabled), tagEnd};
  242.  
  243.       REALGUISIZE = SIZE(GUIInfo) + SIZE(GUIWindowInfo);
  244.       GUIWININFO  = SIZE(GUIInfo);
  245.       GUIEND      = GUIWININFO + SIZE(GUIWindowInfo);
  246.  
  247.       noKeyEqu = -1;
  248.  
  249.       gadgetsSet = 0;  menuSet = 1; rememberGadTags = 2; redrawGads = 3;
  250.       spezialGadsNoText = 4; restoreProcessWindow = 5; setProcessWindow = 6;
  251.       refreshWF = 7;
  252.  
  253.       SPEZIALGADSIZE = SIZE(Gadget) + SIZE(IntuiText);
  254.  
  255.       lvNotSel = 65535;
  256.  
  257. VAR allWindowsWithGUI : GUIWindowInfoPtr;
  258.  
  259.   PROCEDURE SetGUIError(gui : GUIInfoPtr; error : INTEGER);
  260.   BEGIN
  261.     IF gui^.firstError = guiSet THEN gui^.firstError := error END;
  262.   END SetGUIError;
  263.  
  264.   PROCEDURE CreateGUIInfo(window : WindowPtr;
  265.                           maxGads, maxMenus : INTEGER) : GUIInfoPtr;
  266.   VAR gui : GUIInfoPtr;
  267.   BEGIN
  268.     gui := CreateGUIInfoTags(window, maxGads, maxMenus, NIL);
  269.     IF gui # NIL THEN
  270.       gui^.menuFont := ADR(gui^.font);
  271.     END;
  272.     RETURN gui;
  273.   END CreateGUIInfo;
  274.  
  275.   PROCEDURE CreateGUIInfoTags(window   : WindowPtr;
  276.                               maxGads  : INTEGER;
  277.                               maxMenus : INTEGER;
  278.                               tags     : TagItemPtr) : GUIInfoPtr;
  279.   VAR gui    : GUIInfoPtr;
  280.       next   : TagItemPtr;
  281.       info   : DrawInfoPtr;
  282.       winInf : GUIWindowInfoPtr;
  283.       length : LONGINT;
  284.       error  : LONGINT;
  285.       i      : INTEGER;
  286.   BEGIN
  287.     gui   := NIL;
  288.     error := cgiNoError;
  289.  
  290.     IF window # NIL THEN
  291.  
  292.       length := REALGUISIZE;;
  293.       INC(length, maxGads * 4);
  294.       INC(length, maxMenus * SIZE(NewMenu));
  295.  
  296.       gui := AllocMem(length, MemReqSet{memClear, public});
  297.       IF gui # NIL THEN
  298.  
  299.         gui^.window := window;
  300.         WITH gui^ DO
  301.           firstError := guiSet;
  302.           gui^.screen := window^.wScreen;
  303.           FOR i := 0 TO 25 DO
  304.             keys[i] := noKeyEqu;
  305.           END;
  306.           prcwin   := CAST(ProcessPtr, FindTask(NIL))^.windowPtr;
  307.           gadgets := ADDRESS(gui);
  308.           INC(gadgets, GUIEND);
  309.           newMenus := ADDRESS(gui);
  310.           INC(newMenus, GUIEND);
  311.           INC(newMenus, maxGads*4);
  312.           menuFont := screen^.font;
  313.           port     := window^.userPort;
  314.           maxgads  := maxGads;
  315.           maxmenus := maxMenus;
  316.         END;
  317.         WITH gui^.font DO
  318.           name  := window^.rPort^.font^.message.node.name;
  319.           ySize := window^.rPort^.font^.ySize;
  320.           style := window^.rPort^.font^.style;
  321.           flags := window^.rPort^.font^.flags;
  322.         END;
  323.  
  324.         gui^.visual   := G.GetVisualInfoA(window^.wScreen, NIL);
  325.         IF gui^.visual # NIL THEN
  326.  
  327.           gui^.drawinfo := I.GetScreenDrawInfo(window^.wScreen);
  328.           IF gui^.drawinfo # NIL THEN
  329.  
  330.             IF (maxGads > 0) THEN
  331.               gui^.gad := G.CreateContext(gui^.gadlist);
  332.               WITH gui^.newgad DO
  333.                 textAttr   := ADR(gui^.font);
  334.                 visualInfo := gui^.visual;
  335.               END;
  336.               IF gui^.gadlist = NIL THEN
  337.                 error := cgiCreateContext;
  338.                 I.FreeScreenDrawInfo(gui^.screen, gui^.drawinfo);
  339.                 G.FreeVisualInfo(gui^.visual);
  340.                 FreeMem(gui, length);
  341.                 gui := NIL;
  342.               END;
  343.             END;
  344.  
  345.             IF maxMenus > 0 THEN
  346.               gui^.newMenus^[0].type := nmEnd;
  347.             END;
  348.           ELSE
  349.             error := cgiNoDrawInfo;
  350.             G.FreeVisualInfo(gui^.visual);
  351.             FreeMem(gui, length);
  352.             gui := NIL;
  353.           END;
  354.         ELSE
  355.           error := cgiNoVisualInfo;
  356.           FreeMem(gui, length);
  357.           gui := NIL;
  358.         END;
  359.       ELSE
  360.         error := cgiNoMemory;
  361.       END;
  362.     ELSE
  363.       error := cgiNoWindow;
  364.     END;
  365.  
  366.     IF gui # NIL THEN
  367.       winInf := ADDRESS(gui);
  368.       INC(winInf, GUIWININFO);
  369.       Forbid;
  370.         IF allWindowsWithGUI = NIL THEN
  371.           allWindowsWithGUI := winInf;
  372.         ELSE
  373.           winInf^.next := allWindowsWithGUI;
  374.           allWindowsWithGUI^.prev := winInf;
  375.           allWindowsWithGUI := winInf;
  376.         END;
  377.         winInf^.window := window;
  378.         winInf^.gui := gui;
  379.       Permit;
  380.     END;
  381.  
  382.     IF tags # NIL THEN
  383.       next := NextTagItem(tags);
  384.       WHILE next # NIL DO
  385.         IF gui # NIL THEN
  386.           IF    next^.tag = Tag(guiResizableGads) THEN
  387.             IF next^.data # 0 THEN
  388.               INCL(gui^.status, rememberGadTags);
  389.               INCL(gui^.status, refreshWF);
  390.             ELSE
  391.               EXCL(gui^.status, rememberGadTags);
  392.               EXCL(gui^.status, refreshWF);
  393.             END;
  394.           ELSIF next^.tag = Tag(guiFlags) THEN
  395.             gui^.flags := CAST(GUIInfoFlagSet, next^.data);
  396.           ELSIF next^.tag = Tag(guiGadFont) THEN
  397.             gui^.newgad.textAttr := TextAttrPtr(next^.data);
  398.           ELSIF next^.tag = Tag(guiMenuFont) THEN
  399.             gui^.menuFont := TextAttrPtr(next^.data);
  400.           ELSIF next^.tag = Tag(guiVanKeyFct) THEN
  401.             gui^.vanKeyHook := CAST(VanKeyFct, next^.data);
  402.           ELSIF next^.tag = Tag(guiSetProcessWindow) THEN
  403.             IF next^.data # 0 THEN
  404.               INCL(gui^.status, setProcessWindow);
  405.             ELSE
  406.               EXCL(gui^.status, setProcessWindow);
  407.             END;
  408.           ELSIF next^.tag = Tag(guiRestoreProcessWindow) THEN
  409.             IF next^.data # 0 THEN
  410.               INCL(gui^.status, restoreProcessWindow);
  411.             ELSE
  412.               EXCL(gui^.status, restoreProcessWindow);
  413.             END;
  414.           ELSIF next^.tag = Tag(guiRefreshWindowFrame) THEN
  415.             IF next^.data # 0 THEN
  416.               INCL(gui^.status, refreshWF);
  417.             ELSE
  418.               EXCL(gui^.status, refreshWF);
  419.             END;
  420.           END;
  421.         END;
  422.         IF next^.tag = Tag(guiCreateError) THEN
  423.           IF next^.data # 0 THEN
  424.             CAST(LINTPTR, next^.data)^ := error;
  425.           END;
  426.         END;
  427.         next := NextTagItem(tags);
  428.       END;
  429.     END;
  430.     IF (gui # NIL) AND (setProcessWindow IN gui^.status) THEN
  431.       CAST(ProcessPtr, FindTask(NIL))^.windowPtr := window;
  432.     END;
  433.     RETURN gui;
  434.   END CreateGUIInfoTags;
  435.  
  436.   PROCEDURE FreeGUIInfo(gui : GUIInfoPtr);
  437.   VAR winInf : GUIWindowInfoPtr;
  438.   BEGIN
  439.     IF gui # NIL THEN
  440.       winInf := ADDRESS(gui);
  441.       INC(winInf, GUIWININFO);
  442.       Forbid;
  443.         IF winInf^.prev = NIL THEN
  444.           allWindowsWithGUI := winInf^.next;
  445.         ELSE
  446.           winInf^.prev^.next := winInf^.next;
  447.         END;
  448.         IF winInf^.next # NIL THEN
  449.           winInf^.next^.prev := winInf^.prev;
  450.         END;
  451.       Permit;
  452.       RemoveGadgets(gui, TRUE);
  453.       RemoveMenu(gui, TRUE);
  454.       WITH gui^ DO
  455.         IF gadlist # NIL THEN G.FreeGadgets(gadlist) END;
  456.         IF restoreProcessWindow IN status THEN
  457.           CAST(ProcessPtr, FindTask(NIL))^.windowPtr := prcwin;
  458.         END;
  459.         IF visual # NIL THEN G.FreeVisualInfo(visual) END;
  460.         IF drawinfo # NIL THEN I.FreeScreenDrawInfo(screen, drawinfo) END;
  461.         FreeMem(gui, REALGUISIZE + maxgads*4 + maxmenus*SIZE(NewMenu));
  462.       END;
  463.     END;
  464.   END FreeGUIInfo;
  465.  
  466.   (* INTERNE PROZEDUR, um Gadget-Text zu berechnen darzustellen *)
  467.   PROCEDURE CalcText(gui : GUIInfoPtr; Gadget : GadgetPtr);
  468.   VAR text  : IntuiTextPtr;
  469.       flags : NewGadgetFlagSet;
  470.       length: LONGINT;
  471.       ysize : INTEGER;
  472.   BEGIN
  473.     text := Gadget^.gadgetText;
  474.     IF text^.iText # NIL THEN
  475.       flags := CAST(NewGadgetFlagSet, Gadget^.specialInfo);
  476.       WITH text^ DO
  477.         frontPen := gui^.drawinfo^.pens^[textPen];
  478.         backPen  := gui^.drawinfo^.pens^[backGroundPen];
  479.         drawMode := jam1;
  480.         leftEdge := Gadget^.leftEdge;
  481.         topEdge  := Gadget^.topEdge;
  482.         length   := I.IntuiTextLength(text);
  483.         ysize    := text^.iTextFont^.ySize;
  484.         IF    placetextLeft IN flags THEN
  485.           DEC(leftEdge, length+2);
  486.           INC(topEdge, (Gadget^.height - ysize) DIV 2);
  487.         ELSIF placetextRight IN flags THEN
  488.           INC(leftEdge, Gadget^.width+2);
  489.           INC(topEdge, (Gadget^.height - ysize) DIV 2);
  490.         ELSIF placetextAbove IN flags THEN
  491.           INC(leftEdge, (Gadget^.width - length) DIV 2);
  492.           DEC(topEdge, 2+ysize);
  493.         ELSIF placetextBelow IN flags THEN
  494.           INC(leftEdge, (Gadget^.width - length) DIV 2);
  495.           INC(topEdge, Gadget^.height+2);
  496.         ELSIF placetextIn    IN flags THEN
  497.           INC(leftEdge, (Gadget^.width - length) DIV 2);
  498.           INC(topEdge, (Gadget^.height - ysize) DIV 2);
  499.         END;
  500.         IF ngHighlabel IN flags THEN
  501.           frontPen := gui^.drawinfo^.pens^[highLightTextPen];
  502.         END;
  503.       END;
  504.     END;
  505.   END CalcText;
  506.  
  507.   (* INTERNE PROZEDUR, um die spezial-gadget-kinds zu zeichen *)
  508.   PROCEDURE DrawGadget(gui : GUIInfoPtr;
  509.                        Gadget: GadgetPtr;
  510.                        ginfo : GUIGadgetInfoPtr);
  511.   VAR oldAPen : INTEGER;
  512.       cut     : LONGINT;
  513.   BEGIN
  514.     IF    ginfo^.kind = progressIndicatorKind THEN
  515.       DrawBox(gui, Gadget^.leftEdge, Gadget^.topEdge,
  516.                    Gadget^.width, Gadget^.height, TRUE);
  517.       oldAPen := gui^.window^.rPort^.fgPen;
  518.       WITH Gadget^ DO
  519.         IF ginfo^.v1 > 0 THEN
  520.           cut := LONGINT(width-3) * LONGINT(ginfo^.v1S) DIV LONGINT(ginfo^.v0S);
  521.           SetAPen(gui^.window^.rPort, gui^.drawinfo^.pens^[fillPen]);
  522.           RectFill(gui^.window^.rPort, leftEdge + 2, topEdge + 1,
  523.                    leftEdge + cut, topEdge + height - 2);
  524.         END;
  525.         IF ginfo^.v1S < ginfo^.v0S THEN
  526.           SetAPen(gui^.window^.rPort, gui^.drawinfo^.pens^[backGroundPen]);
  527.           cut := LONGINT(width-3) * LONGINT(ginfo^.v1S) DIV LONGINT(ginfo^.v0S);
  528.           RectFill(gui^.window^.rPort, leftEdge + cut + 1,
  529.                    topEdge + 1, leftEdge + width - 3, topEdge + height - 2);
  530.         END;
  531.       END;
  532.       SetAPen(gui^.window^.rPort, oldAPen);
  533.     ELSIF ginfo^.kind = bevelboxKind THEN
  534.       DrawBox(gui, Gadget^.leftEdge, Gadget^.topEdge,
  535.               Gadget^.width, Gadget^.height, ginfo^.v0B);
  536.     END;
  537.     IF (~(spezialGadsNoText IN gui^.status)) AND
  538.        (Gadget^.gadgetText^.iText # NIL) THEN
  539.       I.PrintIText(gui^.window^.rPort, Gadget^.gadgetText, 0, 0);
  540.     END;
  541.   END DrawGadget;
  542.  
  543.   PROCEDURE SetGUI(gui : GUIInfoPtr) : INTEGER;
  544.   VAR Gadget : GadgetPtr;
  545.       buffer : ARRAY[0..1] OF TagItem;
  546.       i : INTEGER;
  547.   BEGIN
  548.     WITH gui^ DO
  549.       IF (firstError = guiSet) AND (~(gadgetsSet IN status)) AND
  550.          (gadlist # NIL) AND (gad # NIL) THEN
  551.         IF I.AddGList(window, gadlist, -1, -1, NIL) = 0 THEN END;
  552.         I.RefreshGList(gadlist, window, NIL, -1);
  553.         G.GTRefreshWindow(window, NIL);
  554.         IF (activateFirstEGad IN flags) AND (firstEGad # NIL) THEN
  555.           IF I.ActivateGadget(firstEGad, window, NIL) THEN END;
  556.         END;
  557.         INCL(status, gadgetsSet);
  558.  
  559.         Gadget := spezialGad;
  560.         WHILE Gadget # NIL DO
  561.           DrawGadget(gui, Gadget, Gadget^.userData);
  562.           Gadget := Gadget^.nextGadget;
  563.         END;
  564.  
  565.         IF redrawGads IN status THEN
  566.           FOR i := 0 TO actgad-1 DO
  567.             IF ~(CAST(GUIGadgetInfoPtr,
  568.                       gadgets^[i]^.userData)^.gadActive) THEN
  569.               GadgetStatus(gui, i, FALSE);
  570.             END;
  571.           END;
  572.           EXCL(status, redrawGads);
  573.         END;
  574.       ELSE
  575.         SetGUIError(gui, gadgetError);
  576.       END;
  577.     END;
  578.     IF (gui^.firstError = guiSet) AND (~(menuSet IN gui^.status)) AND
  579.        (gui^.actmenu > 0) THEN
  580.       gui^.menus := G.CreateMenusA(ADDRESS(gui^.newMenus), NIL);
  581.       IF gui^.menus # NIL THEN
  582.         IF G.LayoutMenusA(gui^.menus, gui^.visual, TAG(buffer,
  583.                           gtmnTextAttr, gui^.menuFont, tagEnd)) THEN
  584.  
  585.           IF I.SetMenuStrip(gui^.window, gui^.menus) THEN
  586.             INCL(gui^.status, menuSet);
  587.           ELSE
  588.             SetGUIError(gui, menuSetError);
  589.             G.FreeMenus(gui^.menus);
  590.             gui^.menus := NIL;
  591.           END;
  592.  
  593.         ELSE
  594.           SetGUIError(gui, menuLayoutError);
  595.           G.FreeMenus(gui^.menus);
  596.           gui^.menus := NIL;
  597.         END;
  598.       ELSE
  599.         SetGUIError(gui, menuError);
  600.       END;
  601.     END;
  602.     RETURN gui^.firstError;
  603.   END SetGUI;
  604.  
  605.   (* INTERNE PROCEDURE, um Gadget-spezifische Parameter festzustellen *)
  606.   PROCEDURE ScanGadget(ginfo : GUIGadgetInfoPtr; tags:TagItemPtr;
  607.                        create : BOOLEAN);
  608.   VAR tag   : TagItemPtr;
  609.       list  : ListPtr;
  610.       node  : NodePtr;
  611.       i     : CARDINAL;
  612.  
  613.     PROCEDURE LoadVX(sTag : Tag; adr : CARDPTR; default : CARDINAL);
  614.     BEGIN
  615.       tag := FindTagItem(sTag, tags);
  616.       IF    tag # NIL THEN
  617.         adr^ := CARDINAL(tag^.data);
  618.       ELSIF create THEN
  619.         adr^ := default;
  620.       END;
  621.     END LoadVX;
  622.  
  623.     PROCEDURE LoadLabelsV1(sTag : Tag);
  624.     VAR labPtr : POINTER TO ADDRESS;
  625.     BEGIN
  626.       tag := FindTagItem(sTag, tags);
  627.       IF tag # NIL THEN
  628.         ginfo^.v1 := 0;
  629.         labPtr := ADDRESS(tag^.data);
  630.         WHILE labPtr^ # NIL DO
  631.           INC(ginfo^.v1);
  632.           INC(labPtr, 4);
  633.         END;
  634.       END;
  635.     END LoadLabelsV1;
  636.  
  637.     PROCEDURE LoadV0B(sTag : Tag);
  638.     BEGIN
  639.       tag := FindTagItem(sTag, tags);
  640.       IF    tag # NIL THEN
  641.         ginfo^.v0B := tag^.data # 0;
  642.       ELSIF create THEN
  643.         ginfo^.v0B := FALSE;
  644.       END;
  645.     END LoadV0B;
  646.  
  647.     PROCEDURE LoadVXS(sTag : Tag; adr : INTPTR; default : INTEGER);
  648.     BEGIN
  649.       tag := FindTagItem(sTag, tags);
  650.       IF    tag # NIL THEN
  651.         adr^ := INTEGER(tag^.data);
  652.       ELSIF create THEN
  653.         adr^ := default;
  654.       END;
  655.     END LoadVXS;
  656.  
  657.   BEGIN
  658.     CASE ginfo^.kind OF
  659.       mxKind       : LoadVX(Tag(gtmxActive), ADR(ginfo^.v0), 0);
  660.                      LoadLabelsV1(Tag(gtmxLabels));
  661.     | cycleKind    : LoadVX(Tag(gtcyActive), ADR(ginfo^.v0), 0);
  662.                      LoadLabelsV1(Tag(gtcyLabels));
  663.     | checkboxKind : LoadV0B(Tag(gtcbChecked));
  664.     | sliderKind   : LoadVXS(Tag(gtslMin), ADR(ginfo^.v2S),  0);
  665.                      LoadVXS(Tag(gtslMax), ADR(ginfo^.v1S), 15);
  666.                      LoadVXS(Tag(gtslLevel), ADR(ginfo^.v0S), 0);
  667.     | scrollerKind : LoadVXS(Tag(gtscTop), ADR(ginfo^.v0S), 0);
  668.                      LoadVXS(Tag(gtscVisible), ADR(ginfo^.v1S), 2);
  669.                      LoadVXS(Tag(gtscTotal), ADR(ginfo^.v2S), 0);
  670.     | listviewKind : LoadVX(Tag(gtlvSelected), ADR(ginfo^.v0), lvNotSel);
  671.                      tag := FindTagItem(Tag(gtlvLabels), tags);
  672.                      IF    tag # NIL THEN
  673.                        IF tag^.lidata = -1 THEN
  674.                          ginfo^.v0 := lvNotSel;
  675.                          ginfo^.v1 := lvNotSel;
  676.                        ELSE
  677.                          list := ADDRESS(tag^.data);
  678.                          IF list^.head^.succ = NIL THEN (* Liste leer*)
  679.                            ginfo^.v0 := lvNotSel;
  680.                            ginfo^.v1 := lvNotSel;
  681.                          ELSE
  682.                            ginfo^.v1 := 0;
  683.                            node := list^.head;
  684.                            WHILE node^.succ # NIL DO
  685.                              INC(ginfo^.v1);
  686.                              node := node^.succ;
  687.                            END;
  688.                          END;
  689.                        END;
  690.                      ELSIF create THEN
  691.                        ginfo^.v0 := lvNotSel;
  692.                        ginfo^.v1 := lvNotSel;
  693.                      END;
  694.     | paletteKind  : LoadVX(Tag(gtpaColor), ADR(ginfo^.v0), 1);
  695.                      tag := FindTagItem(Tag(gtpaDepth), tags);
  696.                      IF    tag # NIL THEN
  697.                        ginfo^.v1 := 1;
  698.                        FOR i := 1 TO CARDINAL(tag^.data) DO
  699.                          ginfo^.v1 := ginfo^.v1 * 2;
  700.                        END;
  701.                      ELSIF create THEN
  702.                        ginfo^.v1 := 2;
  703.                      END;
  704.                      LoadVX(Tag(gtpaColorOffset), ADR(ginfo^.v2), 0);
  705.     ELSE
  706.       IF    ginfo^.kind = progressIndicatorKind THEN
  707.         LoadVX(Tag(sgpiMaxValue), ADR(ginfo^.v0), 100);
  708.         LoadVX(Tag(sgpiCurrentValue), ADR(ginfo^.v1), 0);
  709.       ELSIF ginfo^.kind = bevelboxKind THEN
  710.         LoadV0B(Tag(sgbbRecessed));
  711.       END;
  712.     END;
  713.     tag := FindTagItem(Tag(gaDisabled), tags);
  714.     IF tag # NIL THEN
  715.       ginfo^.gadActive := tag^.data = 0;
  716.     ELSIF create THEN
  717.       ginfo^.gadActive := TRUE;
  718.     END;
  719.   END ScanGadget;
  720.  
  721.   PROCEDURE RememberTags(ginfo : GUIGadgetInfoPtr; tags  : TagItemPtr);
  722.   VAR nbr : LONGCARD;
  723.       newchain: TagItemPtr;
  724.       oldTags : TagItemPtr;
  725.       newTags : TagItemPtr;
  726.       next    : TagItemPtr;
  727.       i   : CARDINAL;
  728.   BEGIN
  729.     IF tags # NIL THEN
  730.       newchain := CloneTagItems(tags);
  731.       IF newchain # NIL THEN
  732.         nbr := FilterTagItems(newchain, ADR(NOTREMEMBERTAGS), tagFilterNOT);
  733.         IF nbr > 0 THEN  (* gibt es ⁿberhaupt welche ? *)
  734.           IF ginfo^.nbrTags = 0 THEN  (* ein Platz fⁿr tagMore *)
  735.             INC(nbr);
  736.           ELSE                        (* Doppelte Tags suchen ! *)
  737.             next := ginfo^.tags;
  738.             FOR i := 1 TO ginfo^.nbrTags-1 DO
  739.               newTags := FindTagItem(next^.tag, newchain);
  740.               IF newTags # NIL THEN
  741.                 DEC(nbr);
  742.                 next^.data := newTags^.data;
  743.                 newTags^.tag := tagIgnore;
  744.               END;
  745.             END;
  746.           END;
  747.           IF nbr > 0 THEN
  748.             newTags := AllocMem(SIZE(TagItem) * (nbr + ginfo^.nbrTags),
  749.                                 MemReqSet{memClear});
  750.           ELSE
  751.             newTags := NIL;
  752.           END;
  753.           IF newTags # NIL THEN
  754.             ginfo^.impTags := NIL;
  755.             oldTags := ginfo^.tags;
  756.             next    := oldTags;
  757.             ginfo^.tags := newTags;
  758.             IF ginfo^.nbrTags > 0 THEN
  759.               FOR i := 1 TO ginfo^.nbrTags-1 DO (* alte Tags kopieren *)
  760.                 newTags^ := next^;              (* bis auf tagMore *)
  761.                 INC(newTags, SIZE(TagItem));
  762.                 INC(next,    SIZE(TagItem));
  763.               END;
  764.               FreeMem(oldTags, SIZE(TagItem) * ginfo^.nbrTags);
  765.             END;
  766.             INC(ginfo^.nbrTags, nbr);
  767.             oldTags := newchain;
  768.             next := NextTagItem(oldTags);
  769.             WHILE next # NIL DO
  770.               newTags^ := next^;
  771.               INC(newTags, SIZE(TagItem));
  772.               next := NextTagItem(oldTags);
  773.             END;
  774.             ginfo^.impTags := newTags;
  775.           END;
  776.         END;
  777.       END;
  778.       FreeTagItems(newchain);
  779.     END;
  780.   END RememberTags;
  781.  
  782.   PROCEDURE CreateGadget(gui : GUIInfoPtr;
  783.                          left, top, width, height : INTEGER;
  784.                          kind : LONGCARD;
  785.                          tags : TagItemPtr);
  786.   TYPE CHARARR4 = ARRAY[0..3] OF CHAR;
  787.   VAR pointer : LONGCARD;
  788.       tag     : TagItemPtr;
  789.       newtags : TagItemPtr;
  790.       ginfo   : GUIGadgetInfoPtr;
  791.       buffer  : ARRAY[0..5] OF LONGCARD;
  792.       keyPos  : INTEGER;
  793.       key     : ARRAY[0..1] OF CHAR;
  794.   BEGIN
  795.     WITH gui^ DO
  796.       gadget := NIL;
  797.       IF (kind >= numKinds) AND (G.gadtoolsBase^.version <= 39) THEN
  798.         SetGUIError(gui, noGadToolsGadKind);
  799.         gad := NIL;
  800.         RETURN;
  801.       END;
  802.       IF (actgad < maxgads) AND (~(gadgetsSet IN status)) THEN
  803.  
  804.         IF gad # NIL THEN       (* ggf Standardgr÷▀en eintragen *)
  805.           IF addStdUnderscore IN flags THEN  (* gtUnderscore-Tag *)
  806.             newtags := TAG(buffer, gtUnderscore, '_',
  807.                                    tagMore, tags, NIL);
  808.             IF tags = NIL THEN buffer[2] := tagEnd END;
  809.           ELSE
  810.             newtags := tags;
  811.           END;
  812.           IF    kind = checkboxKind THEN
  813.             IF width  = 0 THEN width  := checkboxWidth  END;
  814.             IF height = 0 THEN height := checkboxHeight END;
  815.           ELSIF kind = mxKind THEN
  816.             IF width  = 0 THEN width  := mxWidth  END;
  817.             IF height = 0 THEN height := mxHeight END;
  818.           ELSIF (kind = stringKind) OR (kind = integerKind) THEN
  819.             IF height = 0 THEN height := newgad.textAttr^.ySize + 4  END;
  820.           END;
  821.           IF addBorderDims IN flags THEN
  822.             INC(left, window^.borderLeft);
  823.             INC(top, window^.borderTop);
  824.           END;
  825.           newgad.leftEdge := left;
  826.           newgad.topEdge  := top;
  827.           newgad.width    := width;
  828.           newgad.height   := height;
  829.  
  830.           tag := NIL;          (* TAG-Liste ggf korrigieren fⁿr Notify *)
  831.           IF    (kind = stringKind)  AND (stringNotify IN flags) THEN
  832.             tag := FindTagItem(Tag(gtstString), newtags);
  833.             IF tag # NIL THEN pointer := tag^.data END;
  834.             (* Bei Strings nur suchen, nicht Σndern *)
  835.           ELSIF (kind = integerKind) AND (integerNotify IN flags) THEN
  836.             tag := FindTagItem(Tag(gtinNumber), newtags);
  837.             IF tag # NIL THEN
  838.               pointer := tag^.data;
  839.               tag^.data := LONGCARD(LINTPTR(tag^.data)^);
  840.             END;
  841.           ELSIF (kind = checkboxKind) AND (checkboxNotify IN flags) THEN
  842.             tag := FindTagItem(Tag(gtcbChecked), newtags);
  843.             IF tag # NIL THEN
  844.               pointer := tag^.data;
  845.               tag^.data := LONGCARD(BOOLPTR(tag^.data)^);
  846.             END;
  847.           ELSIF (kind = mxKind) AND (mxNotify IN flags) THEN
  848.             tag := FindTagItem(Tag(gtmxActive), newtags);
  849.             IF tag # NIL THEN
  850.               pointer := tag^.data;
  851.               tag^.data := LONGCARD(CARDPTR(tag^.data)^);
  852.             END;
  853.           ELSIF (kind = cycleKind) AND (cycleNotify IN flags) THEN
  854.             tag := FindTagItem(Tag(gtcyActive), newtags);
  855.             IF tag # NIL THEN
  856.               pointer := tag^.data;
  857.               tag^.data := LONGCARD(CARDPTR(tag^.data)^);
  858.             END;
  859.           ELSIF (kind = sliderKind) AND (sliderNotify IN flags) THEN
  860.             tag := FindTagItem(Tag(gtslLevel), newtags);
  861.             IF tag # NIL THEN
  862.               pointer := tag^.data;
  863.               tag^.lidata := LONGINT(INTPTR(tag^.data)^);
  864.             END;
  865.           ELSIF (kind = scrollerKind) AND (scrollerNotify IN flags) THEN
  866.             tag := FindTagItem(Tag(gtscTop), newtags);
  867.             IF tag # NIL THEN
  868.               pointer := tag^.data;
  869.               tag^.lidata := LONGINT(INTPTR(tag^.data)^);
  870.             END;
  871.           ELSIF (kind = listviewKind) AND (listviewNotify IN flags) THEN
  872.             tag := FindTagItem(Tag(gtlvSelected), newtags);
  873.             IF tag # NIL THEN
  874.               pointer := tag^.data;
  875.               tag^.data := LONGCARD(CARDPTR(tag^.data)^);
  876.             END;
  877.           ELSIF (kind = paletteKind) AND (paletteNotify IN flags) THEN
  878.             tag := FindTagItem(Tag(gtpaColor), newtags);
  879.             IF tag # NIL THEN
  880.               pointer := tag^.data;
  881.               tag^.data := LONGCARD(CARDPTR(tag^.data)^);
  882.             END;
  883.           END;
  884.           gad := G.CreateGadgetA(kind, gad^, newgad, newtags);
  885.  
  886.           IF gad # NIL THEN   (* GUIGadgetInfo in userData eintragen !*)
  887.  
  888.             ginfo := AllocMem(SIZE(GUIGadgetInfo), MemReqSet{memClear});
  889.             IF ginfo # NIL THEN
  890.  
  891.               (* Zeiger auf erstes Gadget merken *)
  892.               IF firstGad = NIL THEN
  893.                 firstGad := ginfo;
  894.               ELSE (* alle weiteren mitteinander verketten *)
  895.                 CAST(GUIGadgetInfoPtr,
  896.                      gadgets^[actgad-1]^.userData)^.nextGadInfo := ginfo;
  897.               END;
  898.  
  899.               ginfo^.userData := newgad.userData;
  900.               ginfo^.kind := kind;
  901.               ginfo^.v3   := actgad;
  902.               gad^.userData := ginfo;
  903.  
  904.               ScanGadget(ginfo, newtags, TRUE);(* Spezifische Params ermitteln*)
  905.               IF rememberGadTags IN status THEN
  906.                 RememberTags(ginfo, newtags);  (* Tags merken ! *)
  907.               END;
  908.  
  909.               IF tag # NIL THEN  (* Alte TAG-List wieder herstellen *)
  910.                 tag^.data := pointer;
  911.                 ginfo^.buffer := ADDRESS(tag^.data); (* und Notify an*)
  912.                 ginfo^.onlyIntern := internMsgHandling IN flags;
  913.                 (* Intern macht nur Sinn, wenn die entsprechenden Notifys an
  914.                    sind !  Bei buttonKind also nicht) *)
  915.               ELSE
  916.                 ginfo^.onlyIntern := FALSE;
  917.               END;
  918.  
  919.               ginfo^.lvClearTime := lvKeyClearTime IN flags;
  920.  
  921.               (* Gad-Desc merken *)
  922.               ginfo^.gadDesc := newgad;
  923.  
  924.               (* ggf EntryGadgets +verbinden+ *)
  925.               IF ((kind = integerKind) OR (kind = stringKind))
  926.                  AND (linkEntryGads IN flags) THEN
  927.                 IF firstEGad = NIL THEN firstEGad := gad  END;
  928.                 IF lastEGad # NIL THEN
  929.                   CAST(GUIGadgetInfoPtr, lastEGad^.userData)^.nextEGad := gad;
  930.                   CAST(GUIGadgetInfoPtr,
  931.                        lastEGad^.userData)^.nextEGadNbr := actgad;
  932.                 END;
  933.                 lastEGad := gad;
  934.                 IF cycleEntryGads IN flags THEN
  935.                   ginfo^.nextEGad := firstEGad;
  936.                   ginfo^.nextEGadNbr := CAST(GUIGadgetInfoPtr,
  937.                                              firstEGad^.userData)^.v3;
  938.                 END;
  939.               END;
  940.  
  941.               (* ggf Key-Equivalent eintragen *)
  942.               IF vanillaKeysNotify IN flags THEN
  943.                 tag := FindTagItem(Tag(gtUnderscore), newtags);
  944.                 IF tag # NIL THEN
  945.                   key[0] := CAST(CHARARR4, tag^.data)[3];
  946.                   key[1] := 0C;
  947.                   IF newgad.gadgetText # NIL THEN
  948.                     keyPos := Occurs(STRPTR(newgad.gadgetText)^, 0, key, TRUE);
  949.                   ELSE
  950.                     keyPos := noOccur;
  951.                   END;
  952.                   IF keyPos # noOccur THEN
  953.                     INC(keyPos);
  954.                     key[0] := ToUpper(STRPTR(newgad.gadgetText)^[keyPos]);
  955.                     IF (key[0] >= 'A') AND (key[0] <= 'Z') THEN
  956.                       IF keys[ORD(key[0]) - ORD('A')] = noKeyEqu THEN
  957.                         keys[ORD(key[0]) - ORD('A')] := actgad;
  958.                       ELSE
  959.                         SetGUIError(gui, gadKeyDefTwice);
  960.                         gad := NIL;
  961.                       END;
  962.                     ELSIF ~(allowAllVanillaKeys IN flags) THEN
  963.                       SetGUIError(gui, gadKeyNotAllowed);
  964.                       gad := NIL;
  965.                     END;
  966.                   ELSE
  967.                     SetGUIError(gui, gadKeyNotFound);
  968.                     gad := NIL;
  969.                   END;
  970.                 END;
  971.               END;
  972.  
  973.               gadgets^[actgad] := gad; (* nΣchstes Gad vorbereiten *)
  974.               gadget := gad;
  975.               INC(actgad);
  976.               INC(newgad.gadgetID);
  977.               newgad.gadgetText := NIL;
  978.  
  979.             ELSE
  980.               SetGUIError(gui, memError);
  981.               gad := NIL;
  982.             END;  (* IF ginfo # NIL *)
  983.           END;
  984.         END;
  985.       ELSE
  986.         SetGUIError(gui, tooManyGadsError);
  987.         gad := NIL;
  988.       END;
  989.     END;  (* WITH gui^ *)
  990.   END CreateGadget;
  991.  
  992.   PROCEDURE CreateGadgetText(gui : GUIInfoPtr;
  993.                              left, top, width, height : INTEGER;
  994.                              kind : LONGCARD;
  995.                              text : ADDRESS;
  996.                              tags : TagItemPtr);
  997.   BEGIN
  998.     gui^.newgad.gadgetText := text;
  999.     CreateGadget(gui, left, top, width, height, kind, tags);
  1000.   END CreateGadgetText;
  1001.  
  1002.   PROCEDURE CreateGadgetFull(gui : GUIInfoPtr;
  1003.                              left, top, width, height : INTEGER;
  1004.                              kind : LONGCARD;
  1005.                              text : ADDRESS;
  1006.                              place: NewGadgetFlagSet;
  1007.                              tags : TagItemPtr);
  1008.   BEGIN
  1009.     WITH gui^.newgad DO
  1010.       gadgetText := text;
  1011.       flags      := place;
  1012.     END;
  1013.     CreateGadget(gui, left, top, width, height, kind, tags);
  1014.   END CreateGadgetFull;
  1015.  
  1016.   PROCEDURE MakeMenuEntry(gui : GUIInfoPtr; type : SHORTCARD;
  1017.                           text, key : ADDRESS);
  1018.   BEGIN
  1019.     WITH gui^ DO
  1020.       IF (actmenu < (maxmenus-1)) AND (~(menuSet IN status)) THEN
  1021.         newMenus^[actmenu].type    := type;
  1022.         newMenus^[actmenu].label   := text;
  1023.         newMenus^[actmenu].commKey := key;
  1024.         menuAdr := ADR(newMenus^[actmenu]);
  1025.         INC(actmenu);
  1026.         newMenus^[actmenu].type := nmEnd;
  1027.       ELSE
  1028.         menuAdr := NIL;
  1029.         SetGUIError(gui, tooManyMenusError);
  1030.       END;
  1031.     END;
  1032.   END MakeMenuEntry;
  1033.  
  1034.  
  1035.   PROCEDURE GadWithKey(gui : GUIInfoPtr; nbr : INTEGER; shift : BOOLEAN);
  1036.   VAR ginfo  : GUIGadgetInfoPtr;
  1037.       pointer: ADDRESS;
  1038.       buffer : ARRAY[0..2] OF TagItem;
  1039.   BEGIN
  1040.     WITH gui^ DO
  1041.       gadget := gadgets^[nbr];
  1042.       gadID  := gadget^.gadgetID;
  1043.       ginfo  := gadget^.userData;
  1044.       IF gadgDisabled IN gadget^.flags THEN
  1045.         msgClass := IDCMPFlagSet{};
  1046.         cardCode := 0;
  1047.         ginfo    := NIL;  (* Damit nicht in CASE-Zweig gelangt wird *)
  1048.       END;
  1049.       IF ginfo # NIL THEN
  1050.         gadNbr := ginfo^.v3;
  1051.         CASE ginfo^.kind OF
  1052.           buttonKind : msgClass := IDCMPFlagSet{gadgetUp};
  1053.                        cardCode := 0;
  1054.         | stringKind : IF I.ActivateGadget(gadget, window, NIL) THEN END;
  1055.                        cardCode := 0;
  1056.                        msgClass := IDCMPFlagSet{gadgetDown};
  1057.         | integerKind: IF I.ActivateGadget(gadget, window, NIL) THEN END;
  1058.                        cardCode := 0;
  1059.                        msgClass := IDCMPFlagSet{gadgetDown};
  1060.         | checkboxKind:msgClass := IDCMPFlagSet{gadgetUp};
  1061.                        IF ginfo^.buffer # NIL THEN
  1062.                          ginfo^.bool^ := ~(ginfo^.bool^);
  1063.                        END;
  1064.                        ginfo^.v0B := ~ginfo^.v0B;
  1065.                        pointer := TAG(buffer, gtcbChecked, ginfo^.v0B, tagEnd);
  1066.                        G.GTSetGadgetAttrsA(gadget, window, NIL, pointer);
  1067.                        charCode := 0C;
  1068.                        boolCode := ginfo^.v0B;
  1069.         | mxKind     : msgClass := IDCMPFlagSet{gadgetDown};
  1070.                        IF shift THEN
  1071.                          IF ginfo^.v0 = 0 THEN
  1072.                            ginfo^.v0 := ginfo^.v1-1;
  1073.                          ELSE
  1074.                            DEC(ginfo^.v0);
  1075.                          END;
  1076.                        ELSE
  1077.                          IF ginfo^.v0 = ginfo^.v1-1 THEN
  1078.                            ginfo^.v0 := 0;
  1079.                          ELSE
  1080.                            INC(ginfo^.v0);
  1081.                          END;
  1082.                        END;
  1083.                        IF ginfo^.card # NIL THEN
  1084.                          ginfo^.card^ := ginfo^.v0;
  1085.                        END;
  1086.                        cardCode := ginfo^.v0;
  1087.                        pointer := TAG(buffer, gtmxActive, ginfo^.v0, tagEnd);
  1088.                        G.GTSetGadgetAttrsA(gadget, window, NIL, pointer);
  1089.         | cycleKind  : msgClass := IDCMPFlagSet{gadgetUp};
  1090.                        IF shift THEN
  1091.                          IF ginfo^.v0 = 0 THEN
  1092.                            ginfo^.v0 := ginfo^.v1-1;
  1093.                          ELSE
  1094.                            DEC(ginfo^.v0);
  1095.                          END;
  1096.                        ELSE
  1097.                          IF ginfo^.v0 = ginfo^.v1-1 THEN
  1098.                            ginfo^.v0 := 0;
  1099.                          ELSE
  1100.                            INC(ginfo^.v0);
  1101.                          END;
  1102.                        END;
  1103.                        IF ginfo^.card # NIL THEN
  1104.                          ginfo^.card^ := ginfo^.v0;
  1105.                        END;
  1106.                        cardCode := ginfo^.v0;
  1107.                        pointer := TAG(buffer, gtcyActive, ginfo^.v0, tagEnd);
  1108.                        G.GTSetGadgetAttrsA(gadget, window, NIL, pointer);
  1109.         | sliderKind : msgClass := IDCMPFlagSet{gadgetUp};
  1110.                        IF    shift THEN
  1111.                          IF ginfo^.v0S > ginfo^.v2S  THEN
  1112.                            DEC(ginfo^.v0S);
  1113.                          END;
  1114.                        ELSIF ginfo^.v0S < ginfo^.v1S THEN
  1115.                          INC(ginfo^.v0S);
  1116.                        END;
  1117.                        IF ginfo^.int # NIL THEN
  1118.                          ginfo^.int^ := ginfo^.v0S;
  1119.                        END;
  1120.                        intCode := ginfo^.v0S;
  1121.                        pointer := TAG(buffer, gtslLevel, ginfo^.v0S, tagEnd);
  1122.                        G.GTSetGadgetAttrsA(gadget, window, NIL, pointer);
  1123.         | paletteKind :msgClass := IDCMPFlagSet{gadgetUp};
  1124.                        IF    shift THEN
  1125.                          IF ginfo^.v0 > ginfo^.v2 THEN
  1126.                            DEC(ginfo^.v0);
  1127.                          END;
  1128.                        ELSIF ginfo^.v0 < ginfo^.v1-1 THEN
  1129.                          INC(ginfo^.v0);
  1130.                        END;
  1131.                        IF ginfo^.card # NIL THEN
  1132.                          ginfo^.card^ := ginfo^.v0;
  1133.                        END;
  1134.                        cardCode := ginfo^.v0;
  1135.                        pointer := TAG(buffer, gtpaColor, ginfo^.v0, tagEnd);
  1136.                        G.GTSetGadgetAttrsA(gadget, window, NIL, pointer);
  1137.         | scrollerKind:msgClass := IDCMPFlagSet{gadgetUp};
  1138.                        IF    shift THEN
  1139.                          IF ginfo^.v0S > 0 THEN
  1140.                            DEC(ginfo^.v0S);
  1141.                          END;
  1142.                        ELSIF ginfo^.v0S < ginfo^.v2S THEN
  1143.                          INC(ginfo^.v0S);
  1144.                        END;
  1145.                        IF ginfo^.int # NIL THEN
  1146.                          ginfo^.int^ := ginfo^.v0S;
  1147.                        END;
  1148.                        intCode := ginfo^.v0S;
  1149.                        pointer := TAG(buffer, gtscTop, ginfo^.v0S, tagEnd);
  1150.                        G.GTSetGadgetAttrsA(gadget, window, NIL, pointer);
  1151.         | listviewKind:msgClass := IDCMPFlagSet{gadgetUp};
  1152.                        IF ginfo^.v1 # lvNotSel THEN
  1153.                          IF shift THEN
  1154.                            IF    ginfo^.v0 = lvNotSel THEN
  1155.                              ginfo^.v0 := ginfo^.v1-1;
  1156.                            ELSIF ginfo^.v0 > 0 THEN
  1157.                              DEC(ginfo^.v0);
  1158.                            END;
  1159.                          ELSE
  1160.                            IF    ginfo^.v0 = lvNotSel THEN
  1161.                              ginfo^.v0 := 0;
  1162.                            ELSIF ginfo^.v0 < ginfo^.v1-1 THEN
  1163.                              INC(ginfo^.v0);
  1164.                            END;
  1165.                          END;
  1166.                          IF ginfo^.card # NIL THEN
  1167.                            ginfo^.card^ := ginfo^.v0;
  1168.                          END;
  1169.                          cardCode := ginfo^.v0;
  1170.                          pointer := TAG(buffer,
  1171.                                         gtlvSelected, ginfo^.v0,
  1172.                                         gtlvTop, ginfo^.v0, tagEnd);
  1173.                          G.GTSetGadgetAttrsA(gadget, window, NIL, pointer);
  1174.                        ELSE
  1175.                          msgClass := IDCMPFlagSet{};
  1176.                          cardCode := lvNotSel;
  1177.                        END;
  1178.                        IF ginfo^.lvClearTime THEN
  1179.                          im.seconds := 0;
  1180.                          im.micros  := 0;
  1181.                        END;
  1182.         ELSE
  1183.         END;
  1184.         IF ginfo^.onlyIntern THEN msgClass := IDCMPFlagSet{} END;
  1185.         (* CreateGadget sorgt dafⁿr, da▀ nur bei den Gadgets das Flag
  1186.            gesetzt ist, bei denen es auch sinnvoll ist ! *)
  1187.       END;
  1188.     END;
  1189.   END GadWithKey;
  1190.  
  1191.   PROCEDURE ConvKMsgToGMsg(gui : GUIInfoPtr);
  1192.   VAR nbr  : INTEGER;
  1193.       shift: INTEGER;
  1194.       key  : CHAR;
  1195.   BEGIN
  1196.     WITH gui^ DO
  1197.       IF vanillaKey IN msgClass THEN
  1198.         key := CHAR(im.code);
  1199.         nbr := ORD(ToUpper(key)) - ORD('A');
  1200.         IF    (ToUpper(key) >= 'A') AND (ToUpper(key) <= 'Z') AND
  1201.               (keys[nbr] # noKeyEqu) THEN
  1202.           nbr := keys[nbr];
  1203.           GadWithKey(gui, nbr, key = ToUpper(key));
  1204.         ELSIF (callVanillaKeyFct IN flags) AND (vanKeyHook # NIL) AND
  1205.               (vanKeyHook(key, ADR(nbr), ADR(shift))) THEN
  1206.           GadWithKey(gui, nbr, shift # 0);
  1207.         END;
  1208.       END;
  1209.     END;
  1210.   END ConvKMsgToGMsg;
  1211.  
  1212.   PROCEDURE HandleIntMsg(gui : GUIInfoPtr);
  1213.   VAR ginfo : GUIGadgetInfoPtr;
  1214.       fkt   : MenuFct;
  1215.       done  : BOOLEAN;
  1216.   BEGIN
  1217.     done := FALSE;
  1218.     WITH gui^ DO
  1219.       msgClass := im.class;
  1220.       cardCode := im.code;
  1221.  
  1222.       IF (gadgetUp IN msgClass) OR (gadgetDown IN msgClass) OR
  1223.          (mouseMove IN msgClass) THEN
  1224.         gadget := ADDRESS(im.iAddress);
  1225.         gadID  := gadget^.gadgetID;
  1226.         ginfo  := gadget^.userData; (* MU▀ # NIL sein ! *)
  1227.         gadNbr := ginfo^.v3;
  1228.       END;
  1229.  
  1230.       IF    gadgetUp IN msgClass THEN
  1231.         CASE ginfo^.kind OF
  1232.         | integerKind : IF (ginfo^.lint # NIL) AND (autoUpdateEGads IN flags) THEN
  1233.                           ginfo^.lint^ := StringInfoPtr(gadget^.specialInfo)^.longInt;
  1234.                           done := TRUE;
  1235.                         END;
  1236.         | stringKind  : IF (ginfo^.string # NIL) AND (autoUpdateEGads IN flags) THEN
  1237.                           Copy(ginfo^.string^,
  1238.                                STRPTR(StringInfoPtr(gadget^.specialInfo)^.buffer)^);
  1239.                           done := TRUE;
  1240.                         END;
  1241.         | checkboxKind: ginfo^.v0B := ~ginfo^.v0B;
  1242.                         IF ginfo^.bool # NIL THEN
  1243.                           ginfo^.bool^ := ~(ginfo^.bool^);
  1244.                           done := TRUE;
  1245.                         END;
  1246.                         charCode := 0C;
  1247.                         boolCode := ginfo^.v0B;
  1248.         | sliderKind,
  1249.           scrollerKind : ginfo^.v0S := CAST(INTEGER, im.code);
  1250.                          IF ginfo^.int # NIL THEN
  1251.                            ginfo^.int^ := CAST(INTEGER, im.code);
  1252.                            done := TRUE;
  1253.                          END;
  1254.         | cycleKind,
  1255.           listviewKind,
  1256.           paletteKind  : ginfo^.v0  := im.code;
  1257.                          IF ginfo^.card # NIL THEN
  1258.                            ginfo^.card^ := im.code;
  1259.                            done := TRUE;
  1260.                          END;
  1261.         ELSE
  1262.         END;
  1263.  
  1264.         (* NΣchstes EntryGadget aktivieren *)
  1265.         IF ((ginfo^.kind = integerKind) OR (ginfo^.kind = stringKind))
  1266.            AND (ginfo^.nextEGad # NIL) THEN
  1267.           IF im.code = 0 THEN  (* Nicht mit TAB etc verlassen, dann ...*)
  1268.             REPEAT
  1269.               IF ~(gadgDisabled IN ginfo^.nextEGad^.flags) THEN
  1270.                 IF ginfo^.nextEGad # gadget THEN(* Gibt es vielleich nur eins?*)
  1271.                   IF I.ActivateGadget(ginfo^.nextEGad, window, NIL) THEN END;
  1272.                 END;
  1273.                 ginfo := NIL;
  1274.               ELSE
  1275.                 ginfo := ginfo^.nextEGad^.userData;
  1276.               END;
  1277.             UNTIL ginfo = NIL;
  1278.             ginfo := gadget^.userData; (* ginfo wiederherstellen*)
  1279.           END;
  1280.         END;
  1281.  
  1282.       ELSIF gadgetDown IN msgClass THEN
  1283.         CASE ginfo^.kind OF
  1284.         | mxKind       : ginfo^.v0 := im.code;
  1285.                          IF ginfo^.card # NIL THEN
  1286.                            ginfo^.card^ := im.code;
  1287.                            done := TRUE;
  1288.                          END;
  1289.         | sliderKind,
  1290.           scrollerKind : ginfo^.v0S := CAST(INTEGER, im.code);
  1291.                          IF ginfo^.int # NIL THEN
  1292.                            ginfo^.int^ := CAST(INTEGER, im.code);
  1293.                            done := TRUE;
  1294.                          END;
  1295.         ELSE
  1296.         END;
  1297.  
  1298.       ELSIF menuPick IN msgClass THEN
  1299.         IF im.code # menuNull THEN
  1300.           menuNum := MenuNum(im.code);
  1301.           itemNum := ItemNum(im.code);
  1302.           subNum  := SubNum(im.code);
  1303.           itemAdr := I.ItemAddress(menus, im.code);
  1304.           IF callMenuData IN flags THEN
  1305.             IF (itemAdr # NIL) AND (MenuItemUserData(itemAdr) # NIL) THEN
  1306.               fkt := CAST(MenuFct, MenuItemUserData(itemAdr));
  1307.               IF fkt() THEN msgClass := IDCMPFlagSet{}  END;
  1308.             END;
  1309.           END;
  1310.         ELSE
  1311.           msgClass := IDCMPFlagSet{};
  1312.         END;
  1313.  
  1314.       ELSIF menuHelp IN msgClass THEN
  1315.         menuNum := MenuNum(im.code);
  1316.         itemNum := ItemNum(im.code);
  1317.         subNum  := SubNum(im.code);
  1318.         IF itemNum # noItem THEN
  1319.           itemAdr := I.ItemAddress(menus, im.code);
  1320.         ELSE
  1321.           itemAdr := NIL;
  1322.         END;
  1323.  
  1324.       ELSIF mouseMove IN msgClass THEN
  1325.         CASE ginfo^.kind OF
  1326.         | sliderKind,
  1327.           scrollerKind : ginfo^.v0S := CAST(INTEGER, im.code);
  1328.                          IF ginfo^.int # NIL THEN
  1329.                            ginfo^.int^ := CAST(INTEGER, im.code);
  1330.                            done := TRUE;
  1331.                          END;
  1332.         ELSE
  1333.         END;
  1334.  
  1335.       ELSIF (vanillaKey IN msgClass) AND (convertKeys IN flags) THEN
  1336.         ConvKMsgToGMsg(gui);
  1337.  
  1338.       ELSIF (refreshWindow IN msgClass) AND (doRefresh IN flags) THEN
  1339.         BeginRefresh(gui);
  1340.         EndRefresh(gui, TRUE);
  1341.         msgClass := IDCMPFlagSet{};
  1342.       END;
  1343.       IF done AND ginfo^.onlyIntern THEN msgClass := IDCMPFlagSet{} END;
  1344.     END;
  1345.   END HandleIntMsg;
  1346.  
  1347.   PROCEDURE WaitIntMsg(gui : GUIInfoPtr);
  1348.   BEGIN
  1349.     REPEAT
  1350.       IF ~((menuPick IN gui^.im.class) AND (gui^.im.code # menuNull)) THEN
  1351.         WaitPort(gui^.port);
  1352.       END;
  1353.     UNTIL GetIntMsg(gui);
  1354.   END WaitIntMsg;
  1355.  
  1356.   PROCEDURE GetIntMsg(gui : GUIInfoPtr) : BOOLEAN;
  1357.   VAR intmsg : IntuiMessagePtr;
  1358.   BEGIN
  1359.     IF (menuPick IN gui^.im.class) AND (gui^.im.code # menuNull) THEN
  1360.       gui^.im.code := I.ItemAddress(gui^.menus, gui^.im.code)^.nextSelect;
  1361.     ELSE
  1362.       gui^.im.code := menuNull;
  1363.     END;
  1364.     IF gui^.im.code = menuNull THEN
  1365.       intmsg := G.GTGetIMsg(gui^.port);
  1366.       IF intmsg = NIL THEN RETURN FALSE END;
  1367.       gui^.im := intmsg^;
  1368.       G.GTReplyIMsg(intmsg);
  1369.     END;
  1370.     IF ~(noHandleIntMsgCall IN gui^.flags) THEN HandleIntMsg(gui) END;
  1371.     IF gui^.msgClass = IDCMPFlagSet{} THEN RETURN FALSE END;
  1372.     RETURN TRUE;
  1373.   END GetIntMsg;
  1374.  
  1375.   PROCEDURE EmptyIntMsgPort(gui : GUIInfoPtr);
  1376.   VAR intmsg : IntuiMessagePtr;
  1377.   BEGIN
  1378.     Forbid;   (* Keine neuen Nachrichten bitte ! *)
  1379.       REPEAT
  1380.         intmsg := G.GTGetIMsg(gui^.port);
  1381.         IF intmsg # NIL THEN G.GTReplyIMsg(intmsg) END;
  1382.       UNTIL intmsg = NIL;
  1383.     Permit;
  1384.   END EmptyIntMsgPort;
  1385.  
  1386.   PROCEDURE GadgetStatus(gui : GUIInfoPtr; nbr : INTEGER; status : BOOLEAN);
  1387.   VAR Gadget : GadgetPtr;
  1388.       buffer : ARRAY[0..1] OF TagItem;
  1389.   BEGIN
  1390.     Gadget := gui^.gadgets^[nbr];
  1391.     IF CAST(GUIGadgetInfoPtr, Gadget^.userData)^.kind = genericKind THEN
  1392.       IF status THEN
  1393.         I.OnGadget(Gadget, gui^.window, NIL);
  1394.       ELSE
  1395.         I.OffGadget(Gadget,gui^.window, NIL);
  1396.       END;
  1397.     ELSIF CAST(GUIGadgetInfoPtr, Gadget^.userData)^.kind <= guiToolsKinds THEN
  1398.       G.GTSetGadgetAttrsA(Gadget, gui^.window, NIL,
  1399.                           TAG(buffer, gaDisabled, ~status, tagEnd));
  1400.     END;
  1401.     CAST(GUIGadgetInfoPtr, Gadget^.userData)^.gadActive := status;
  1402.   END GadgetStatus;
  1403.  
  1404.   PROCEDURE ModifyGadget(gui : GUIInfoPtr; nbr : INTEGER; tags : TagItemPtr);
  1405.   VAR Gadget : GadgetPtr;
  1406.       ginfo  : GUIGadgetInfoPtr;
  1407.   BEGIN
  1408.     WITH gui^ DO
  1409.       Gadget := gadgets^[nbr];
  1410.       ginfo  := Gadget^.userData;
  1411.       ScanGadget(ginfo, tags, FALSE);      (* Spezifische Werte updaten *)
  1412.       IF rememberGadTags IN status THEN
  1413.         RememberTags(ginfo, tags);         (* Tags merken *)
  1414.       END;
  1415.       IF ginfo^.kind > guiToolsKinds THEN
  1416.         INCL(status, spezialGadsNoText);
  1417.         DrawGadget(gui, Gadget, ginfo);
  1418.         EXCL(status, spezialGadsNoText);
  1419.       ELSE
  1420.         G.GTSetGadgetAttrsA(Gadget, window, NIL, tags);
  1421.       END;
  1422.     END;
  1423.   END ModifyGadget;
  1424.  
  1425.   PROCEDURE UpdateEGad(gui : GUIInfoPtr; nbr : INTEGER);
  1426.   VAR gadg  : GadgetPtr;
  1427.       ginfo : GUIGadgetInfoPtr;
  1428.   BEGIN
  1429.     WITH gui^ DO
  1430.       gadg := gadgets^[nbr];
  1431.       ginfo := gadg^.userData;
  1432.       IF ginfo^.buffer # NIL THEN
  1433.         IF ginfo^.kind = integerKind THEN
  1434.           ginfo^.lint^ := StringInfoPtr(gadg^.specialInfo)^.longInt;
  1435.         ELSIF ginfo^.kind = stringKind THEN
  1436.           Copy(ginfo^.string^,
  1437.                STRPTR(StringInfoPtr(gadg^.specialInfo)^.buffer)^);
  1438.         END;
  1439.       END;
  1440.     END;
  1441.   END UpdateEGad;
  1442.  
  1443.   PROCEDURE UpdateEntryGadgets(gui : GUIInfoPtr);
  1444.   VAR i : INTEGER;
  1445.   BEGIN
  1446.     FOR i := 0 TO gui^.actgad-1 DO
  1447.       UpdateEGad(gui, i);
  1448.     END;
  1449.   END UpdateEntryGadgets;
  1450.  
  1451.   PROCEDURE VarToGad(gui : GUIInfoPtr; nbr : INTEGER);
  1452.   VAR ginfo  : GUIGadgetInfoPtr;
  1453.       tagbuf : ARRAY[0..2] OF TagItem;
  1454.   BEGIN
  1455.     ginfo := gui^.gadgets^[nbr]^.userData;
  1456.     IF ginfo^.buffer # NIL THEN
  1457.       CASE ginfo^.kind OF
  1458.         stringKind   : ModifyGadget(gui, nbr, TAG(tagbuf,
  1459.                                     gtstString, ginfo^.string, tagEnd));
  1460.       | integerKind  : ModifyGadget(gui, nbr, TAG(tagbuf,
  1461.                                     gtinNumber, ginfo^.lint^, tagEnd));
  1462.       | checkboxKind : ModifyGadget(gui, nbr, TAG(tagbuf,
  1463.                                     gtcbChecked, ginfo^.bool^,tagEnd));
  1464.       | cycleKind    : ModifyGadget(gui, nbr, TAG(tagbuf,
  1465.                                     gtcyActive, ginfo^.card^, tagEnd));
  1466.       | mxKind       : ModifyGadget(gui, nbr, TAG(tagbuf,
  1467.                                     gtmxActive, ginfo^.card^, tagEnd));
  1468.       | sliderKind   : ModifyGadget(gui, nbr, TAG(tagbuf,
  1469.                                     gtslLevel, ginfo^.int^, tagEnd));
  1470.       | scrollerKind : ModifyGadget(gui, nbr, TAG(tagbuf,
  1471.                                     gtscTop, ginfo^.int^, tagEnd));
  1472.       | listviewKind : ModifyGadget(gui, nbr, TAG(tagbuf,
  1473.                                     gtlvSelected, ginfo^.card^, tagEnd));
  1474.       | paletteKind  : ModifyGadget(gui, nbr, TAG(tagbuf,
  1475.                                     gtpaColor, ginfo^.card^, tagEnd));
  1476.       ELSE
  1477.       END;
  1478.     END;
  1479.   END VarToGad;
  1480.  
  1481.   PROCEDURE AllVarsToGad(gui : GUIInfoPtr);
  1482.   VAR i : INTEGER;
  1483.   BEGIN
  1484.     FOR i := 0 TO gui^.actgad-1 DO
  1485.       VarToGad(gui, i);
  1486.     END;
  1487.   END AllVarsToGad;
  1488.  
  1489.   PROCEDURE TopazAttr():TextAttrPtr;
  1490.   BEGIN
  1491.     RETURN ADR(TextAttr{name: ADR('topaz.font'), ySize: 8});
  1492.   END TopazAttr;
  1493.  
  1494.   PROCEDURE GetOwnFont(name : ADDRESS; size : CARDINAL;
  1495.                        font : TextAttrPtr) : TextFontPtr;
  1496.   VAR NewFont : TextFontPtr;
  1497.       OwnAttr : TextAttr;
  1498.   BEGIN
  1499.     IF font = NIL THEN font := ADR(OwnAttr) END;
  1500.     font^.name := name;
  1501.     WITH font^ DO
  1502.       ySize := size;
  1503.       style := FontStyleSet{};
  1504.       flags := FontFlagSet{romFont};
  1505.     END;
  1506.     NewFont := OpenFont(font);
  1507.     IF NewFont = NIL THEN
  1508.       font^.flags := FontFlagSet{diskFont};
  1509.       NewFont := OpenDiskFont(font);
  1510.     END;
  1511.     RETURN NewFont;
  1512.   END GetOwnFont;
  1513.  
  1514.   PROCEDURE RemOwnFont(font : TextFontPtr);
  1515.   BEGIN
  1516.     IF font # NIL THEN CloseFont(font) END;
  1517.   END RemOwnFont;
  1518.  
  1519.   PROCEDURE DoubleTags(tag1, tag2 : TagItemPtr);
  1520.   VAR tag : TagItemPtr;
  1521.       next: TagItemPtr;
  1522.   BEGIN
  1523.     next := NextTagItem(tag1);
  1524.     WHILE next # NIL DO
  1525.       tag := FindTagItem(next^.tag, tag2);
  1526.       IF tag # NIL THEN
  1527.         next^.tag := tagIgnore;
  1528.       END;
  1529.       next := NextTagItem(tag1);
  1530.     END;
  1531.   END DoubleTags;
  1532.  
  1533.   PROCEDURE OpenIntWindowTags(left, top, width, height : INTEGER;
  1534.                           name: ADDRESS; idcmpFlags: IDCMPFlagSet;
  1535.                           windowFlags : WindowFlagSet;
  1536.                           screen : ScreenPtr;
  1537.                           tags : TagItemPtr):WindowPtr;
  1538.   VAR buffer : ARRAY[0..11] OF TagItem;
  1539.       pubscr : ScreenPtr;
  1540.       window : WindowPtr;
  1541.   BEGIN
  1542.     window := NIL;
  1543.     IF screen = NIL THEN
  1544.       pubscr := I.LockPubScreen(NIL);
  1545.       screen := pubscr;
  1546.     ELSE
  1547.       pubscr := NIL;
  1548.     END;
  1549.     IF width  = asScreen THEN width  := screen^.width-left  END;
  1550.     IF height = asScreen THEN height := screen^.height-top  END;
  1551.     IF (pubscr # NIL) OR (publicScreen IN screen^.flags) THEN
  1552.       IF TAG(buffer, waTitle, name,
  1553.                      waLeft, left,
  1554.                      waTop, top,
  1555.                      waWidth, width,
  1556.                      waHeight, height,
  1557.                      waIDCMP, idcmpFlags,
  1558.                      waFlags, windowFlags,
  1559.                      waPubScreen, screen,
  1560.                      waPubScreenFallBack, TRUE,
  1561.                      tagMore, tags, tagEnd) # NIL THEN
  1562.         buffer[9].tag := tagEnd;
  1563.         IF tags # NIL THEN
  1564.           DoubleTags(ADR(buffer), tags);
  1565.           buffer[9].tag := tagMore;
  1566.         END;
  1567.       END;
  1568.     ELSE
  1569.       IF TAG(buffer, waTitle, name,
  1570.                      waLeft, left,
  1571.                      waTop, top,
  1572.                      waWidth, width,
  1573.                      waHeight, height,
  1574.                      waIDCMP, idcmpFlags,
  1575.                      waFlags, windowFlags,
  1576.                      waCustomScreen, screen,
  1577.                      tagMore, tags, tagEnd) # NIL THEN
  1578.         buffer[8].tag := tagEnd;
  1579.         IF tags # NIL THEN
  1580.           DoubleTags(ADR(buffer), tags);
  1581.           buffer[8].tag := tagMore;
  1582.         END;
  1583.       END;
  1584.     END;
  1585.     window := I.OpenWindowTagList(NIL, ADR(buffer));
  1586.     IF pubscr # NIL THEN I.UnlockPubScreen(NIL, pubscr) END;
  1587.     RETURN window;
  1588.   END OpenIntWindowTags;
  1589.  
  1590.   PROCEDURE OpenIntWindow(left, top, width, height : INTEGER;
  1591.                           name: ADDRESS;
  1592.                           idcmpFlags: IDCMPFlagSet;
  1593.                           windowFlags : WindowFlagSet;
  1594.                           screen : ScreenPtr):WindowPtr;
  1595.   VAR tags : ARRAY[0..1] OF TagItem;
  1596.   BEGIN
  1597.     RETURN OpenIntWindowTags(left, top, width, height, name,
  1598.                              idcmpFlags, windowFlags, screen,
  1599.                              TAG(tags, waScreenTitle, name, tagEnd));
  1600.   END OpenIntWindow;
  1601.  
  1602.   PROCEDURE CloseIntWindow(window : WindowPtr);
  1603.   VAR intmsg : IntuiMessagePtr;
  1604.       list   : GUIWindowInfoPtr;
  1605.       next   : GUIWindowInfoPtr;
  1606.   BEGIN
  1607.     IF window # NIL THEN
  1608.       IF window^.userPort # NIL THEN
  1609.         Forbid;   (* Keine neuen Nachrichten bitte ! *)
  1610.           REPEAT
  1611.             intmsg := G.GTGetIMsg(window^.userPort);
  1612.             IF intmsg # NIL THEN G.GTReplyIMsg(intmsg) END;
  1613.           UNTIL intmsg = NIL;
  1614.           I.ModifyIDCMP(window, IDCMPFlagSet{});
  1615.         Permit;
  1616.       END;
  1617.       (* GUI noch vorhanden ? , sollte auch mehrere GUIs pro Window handeln*)
  1618.       Forbid;
  1619.         list := allWindowsWithGUI;
  1620.         WHILE list # NIL DO
  1621.           IF list^.window = window THEN
  1622.             next := list^.next;
  1623.             FreeGUIInfo(list^.gui); (* list ist jetzt ungⁿltig ! *)
  1624.             list := next;
  1625.           ELSE
  1626.             list := list^.next;
  1627.           END;
  1628.         END;
  1629.       Permit;
  1630.       I.CloseWindow(window);
  1631.     END;
  1632.   END CloseIntWindow;
  1633.  
  1634.   PROCEDURE OpenIntScreenTags(id:LONGCARD; depth:INTEGER;
  1635.                           name : ADDRESS;
  1636.                           font : TextAttrPtr;
  1637.                           tags : TagItemPtr) : ScreenPtr;
  1638.   VAR tagBuffer : ARRAY[0..7] OF TagItem;
  1639.   BEGIN
  1640.     IF TAG(tagBuffer, saPens, ADR(CARDINAL{0FFFFH}),
  1641.                       saDepth, depth,
  1642.                       saDisplayID, id,
  1643.                       saTitle, name,
  1644.                       saFont, font,
  1645.                       tagMore, tags, tagEnd) # NIL THEN
  1646.       tagBuffer[5]. tag := tagEnd;
  1647.       IF tags # NIL THEN
  1648.         DoubleTags(ADR(tagBuffer), tags);
  1649.         tagBuffer[5].tag := tagMore;
  1650.       END;
  1651.       RETURN I.OpenScreenTagList(NIL, ADR(tagBuffer));
  1652.     ELSE
  1653.       RETURN NIL;
  1654.     END;
  1655.   END OpenIntScreenTags;
  1656.  
  1657.   PROCEDURE OpenIntScreen(id:LONGCARD; depth:INTEGER;
  1658.                            name : ADDRESS; font : TextAttrPtr) : ScreenPtr;
  1659.   BEGIN
  1660.     RETURN OpenIntScreenTags(id, depth, name, font, NIL);
  1661.   END OpenIntScreen;
  1662.  
  1663.   PROCEDURE CloseIntScreen(screen : ScreenPtr);
  1664.   BEGIN
  1665.     IF screen # NIL THEN
  1666.       Forbid;
  1667.         WHILE screen^.firstWindow # NIL DO
  1668.           CloseIntWindow(screen^.firstWindow);
  1669.         END;
  1670.         I.CloseScreen(screen);
  1671.       Permit;
  1672.     END;
  1673.   END CloseIntScreen;
  1674.  
  1675.   PROCEDURE DrawBox(gui : GUIInfoPtr; left, top, width, height : INTEGER;
  1676.                     recessed : BOOLEAN);
  1677.   VAR tagbuf : ARRAY[0..2] OF TagItem;
  1678.   BEGIN
  1679.     IF ~recessed THEN
  1680.       G.DrawBevelBoxA(gui^.window^.rPort, left, top, width, height,
  1681.                       TAG(tagbuf, gtVisualInfo, gui^.visual, tagEnd));
  1682.     ELSE
  1683.       G.DrawBevelBoxA(gui^.window^.rPort, left, top, width, height,
  1684.                       TAG(tagbuf, gtVisualInfo, gui^.visual,
  1685.                                   gtbbRecessed, TRUE, tagEnd));
  1686.     END;
  1687.   END DrawBox;
  1688.  
  1689.   PROCEDURE RedrawGadgets(gui : GUIInfoPtr; setGads:BOOLEAN) : INTEGER;
  1690.   VAR ginfo : GUIGadgetInfoPtr;
  1691.       firstEGadNbr, i : INTEGER;
  1692.       tagbuf : ARRAY[0..3] OF TagItem;
  1693.       myTag  : TagItem;
  1694.   BEGIN
  1695.     IF (rememberGadTags IN gui^.status) AND
  1696.        (gui^.gadlist # NIL) THEN  (* gibt es ⁿberhaupt Gadgets *)
  1697.  
  1698.       IF gui^.firstEGad # NIL THEN
  1699.         firstEGadNbr := CAST(GUIGadgetInfoPtr, gui^.firstEGad^.userData)^.v3;
  1700.       END;
  1701.  
  1702.       (* Alte Gadgets entfernen *)
  1703.       IF I.RemoveGList(gui^.window, gui^.gadlist, -1) = 0 THEN END;
  1704.       G.FreeGadgets(gui^.gadlist);
  1705.  
  1706.       (* Window-Inhalt l÷schen *)
  1707.       ClearWindow(gui);
  1708.  
  1709.       (* neue Gadget-Liste erstellen ! *)
  1710.       gui^.gadlist := NIL;
  1711.       gui^.gad := G.CreateContext(gui^.gadlist);
  1712.       EXCL(gui^.status, gadgetsSet);
  1713.       IF gui^.gadlist # NIL THEN
  1714.  
  1715.         gui^.actgad := 0;
  1716.         ginfo := gui^.firstGad;
  1717.         WHILE ginfo # NIL DO
  1718.  
  1719.           IF ginfo^.nbrTags = 0 THEN
  1720.             ginfo^.tags := ADR(myTag);
  1721.             ginfo^.impTags := ADR(myTag);
  1722.           END;
  1723.           ginfo^.impTags^.tag := tagMore;
  1724.           CASE ginfo^.kind OF
  1725.             mxKind : ginfo^.impTags^.data := TAG(tagbuf,
  1726.                                                  gtmxActive, ginfo^.v0, tagEnd);
  1727.           | checkboxKind : ginfo^.impTags^.data := TAG(tagbuf,
  1728.                                            gtcbChecked, ginfo^.v0B, tagEnd);
  1729.           | cycleKind : ginfo^.impTags^.data := TAG(tagbuf,
  1730.                                           gtcyActive, ginfo^.v0, tagEnd);
  1731.           | sliderKind: ginfo^.impTags^.data := TAG(tagbuf,
  1732.                                               gtslMin, ginfo^.v2S,
  1733.                                               gtslMax, ginfo^.v1S,
  1734.                                               gtslLevel, ginfo^.v0S, tagEnd);
  1735.           | scrollerKind:ginfo^.impTags^.data := TAG(tagbuf,
  1736.                                               gtscTop, ginfo^.v0S,
  1737.                                               gtscVisible, ginfo^.v1S,
  1738.                                               gtscTotal, ginfo^.v2S, tagEnd);
  1739.           | listviewKind:ginfo^.impTags^.data := TAG(tagbuf,
  1740.                                               gtlvSelected, ginfo^.v1,tagEnd);
  1741.           | paletteKind :ginfo^.impTags^.data := TAG(tagbuf,
  1742.                                               gtpaColorOffset, ginfo^.v2,
  1743.                                               gtpaColor, ginfo^.v0, tagEnd);
  1744.           ELSE
  1745.             ginfo^.impTags^.tag := tagEnd;
  1746.           END;
  1747.  
  1748.           IF ginfo^.kind > guiToolsKinds THEN
  1749.             WITH gui^.gadgets^[gui^.actgad]^ DO
  1750.               leftEdge := ginfo^.gadDesc.leftEdge;
  1751.               topEdge  := ginfo^.gadDesc.topEdge;
  1752.               width    := ginfo^.gadDesc.width;
  1753.               height   := ginfo^.gadDesc.height;
  1754.               gadgetText^.iText := ginfo^.gadDesc.gadgetText;
  1755.               gadgetText^.iTextFont := ginfo^.gadDesc.textAttr;
  1756.             END;
  1757.             CalcText(gui, gui^.gadgets^[gui^.actgad]);
  1758.             IF setGads THEN
  1759.               DrawGadget(gui, gui^.gadgets^[gui^.actgad], ginfo);
  1760.             END;
  1761.           ELSE
  1762.             gui^.gad := G.CreateGadgetA(ginfo^.kind, gui^.gad^,
  1763.                                         ginfo^.gadDesc, ginfo^.tags);
  1764.             IF gui^.gad # NIL THEN   (* GUIGadgetInfo in userData eintragen !*)
  1765.               gui^.gadgets^[gui^.actgad] := gui^.gad;
  1766.             ELSE
  1767.               ginfo := NIL;
  1768.             END;
  1769.           END;
  1770.           IF ginfo # NIL THEN
  1771.             gui^.gadgets^[gui^.actgad]^.userData := ginfo;
  1772.             INC(gui^.actgad);
  1773.             IF ginfo^.nbrTags = 0 THEN
  1774.               ginfo^.tags    := NIL;
  1775.               ginfo^.impTags := NIL;
  1776.             END;
  1777.             ginfo := ginfo^.nextGadInfo;
  1778.           END;
  1779.  
  1780.         END;
  1781.  
  1782.         IF gui^.gad # NIL THEN
  1783.  
  1784.           IF gui^.firstEGad # NIL THEN
  1785.             (* Verkettung der E-Gads wieder aufbauen *)
  1786.             gui^.firstEGad := gui^.gadgets^[firstEGadNbr];
  1787.  
  1788.             ginfo := gui^.firstEGad^.userData;
  1789.             WHILE ginfo # NIL DO
  1790.               IF ginfo^.nextEGad # NIL THEN
  1791.                 IF ginfo^.nextEGadNbr = CAST(GUIGadgetInfoPtr,
  1792.                                              gui^.firstEGad^.userData)^.v3S THEN
  1793.                   ginfo^.nextEGad := gui^.firstEGad;
  1794.                   ginfo := NIL;
  1795.                 ELSE
  1796.                   ginfo^.nextEGad := gui^.gadgets^[ginfo^.nextEGadNbr];
  1797.                   ginfo := ginfo^.nextEGad^.userData;
  1798.                 END;
  1799.               ELSE
  1800.                 ginfo := NIL;
  1801.               END;
  1802.             END;
  1803.           END;
  1804.           IF setGads THEN
  1805.             IF I.AddGList(gui^.window, gui^.gadlist, -1, -1, NIL) = 0 THEN END;
  1806.             I.RefreshGList(gui^.gadlist, gui^.window, NIL, -1);
  1807.             G.GTRefreshWindow(gui^.window, NIL);
  1808.             FOR i := 0 TO gui^.actgad-1 DO
  1809.               IF ~(CAST(GUIGadgetInfoPtr,
  1810.                         gui^.gadgets^[i]^.userData)^.gadActive) THEN
  1811.                 GadgetStatus(gui, i, FALSE);
  1812.               END;
  1813.             END;
  1814.             IF activateFirstEGad IN gui^.flags THEN
  1815.               IF I.ActivateGadget(gui^.firstEGad, gui^.window, NIL) THEN END;
  1816.             END;
  1817.             INCL(gui^.status, gadgetsSet);
  1818.           ELSE
  1819.             INCL(gui^.status, redrawGads);
  1820.           END;
  1821.  
  1822.         ELSE
  1823.           SetGUIError(gui, gadgetError);
  1824.         END;
  1825.  
  1826.       ELSE
  1827.         SetGUIError(gui, rdGUIContextError);
  1828.       END;
  1829.  
  1830.     END;
  1831.     RETURN gui^.firstError;
  1832.   END RedrawGadgets;
  1833.  
  1834.   PROCEDURE RedrawMenu(gui : GUIInfoPtr) : INTEGER;
  1835.   VAR buffer : ARRAY[0..1] OF TagItem;
  1836.   BEGIN
  1837.     IF (menuSet IN gui^.status) THEN
  1838.       I.ClearMenuStrip(gui^.window);
  1839.       G.FreeMenus(gui^.menus);
  1840.       EXCL(gui^.status, menuSet);
  1841.       gui^.menus := G.CreateMenusA(ADDRESS(gui^.newMenus), NIL);
  1842.       IF gui^.menus # NIL THEN
  1843.         IF G.LayoutMenusA(gui^.menus, gui^.visual, TAG(buffer,
  1844.                             gtmnTextAttr, ADR(gui^.font), tagEnd)) THEN
  1845.  
  1846.           IF I.SetMenuStrip(gui^.window, gui^.menus) THEN
  1847.             INCL(gui^.status, menuSet);
  1848.           ELSE
  1849.             SetGUIError(gui, menuSetError);
  1850.             G.FreeMenus(gui^.menus);
  1851.             gui^.menus := NIL;
  1852.           END;
  1853.         ELSE
  1854.           SetGUIError(gui, menuLayoutError);
  1855.           G.FreeMenus(gui^.menus);
  1856.           gui^.menus := NIL;
  1857.         END;
  1858.       ELSE
  1859.         SetGUIError(gui, menuError);
  1860.       END;
  1861.     END;
  1862.     RETURN gui^.firstError;
  1863.   END RedrawMenu;
  1864.  
  1865.   PROCEDURE ResizeGadget(gui : GUIInfoPtr;
  1866.                          nbr : INTEGER;
  1867.                          left, top, width, height : INTEGER);
  1868.   BEGIN
  1869.     WITH CAST(GUIGadgetInfoPtr, gui^.gadgets^[nbr]^.userData)^ DO
  1870.       IF addBorderDims IN gui^.flags THEN
  1871.         IF left # preserve THEN INC(left, gui^.window^.borderLeft)  END;
  1872.         IF top  # preserve THEN INC(top, gui^.window^.borderTop)    END;
  1873.       END;
  1874.       IF left   # preserve THEN gadDesc.leftEdge := left   END;
  1875.       IF top    # preserve THEN gadDesc.topEdge  := top    END;
  1876.       IF width  # preserve THEN gadDesc.width    := width  END;
  1877.       IF height # preserve THEN gadDesc.height   := height END;
  1878.     END;
  1879.   END ResizeGadget;
  1880.  
  1881.   PROCEDURE NewGadgetFont(gui  : GUIInfoPtr;
  1882.                           nbr  : INTEGER;
  1883.                           font : TextAttrPtr);
  1884.   BEGIN
  1885.     WITH CAST(GUIGadgetInfoPtr, gui^.gadgets^[nbr]^.userData)^ DO
  1886.       gadDesc.textAttr := font;
  1887.     END;
  1888.   END NewGadgetFont;
  1889.  
  1890.   PROCEDURE NewGadgetText(gui  : GUIInfoPtr;
  1891.                           nbr  : INTEGER;
  1892.                           text : ADDRESS);
  1893.   BEGIN
  1894.     WITH CAST(GUIGadgetInfoPtr, gui^.gadgets^[nbr]^.userData)^ DO
  1895.       gadDesc.gadgetText := text;
  1896.     END;
  1897.   END NewGadgetText;
  1898.  
  1899.   PROCEDURE RemoveGadgets(gui : GUIInfoPtr; erase : BOOLEAN);
  1900.   VAR ginfo : GUIGadgetInfoPtr;
  1901.       ggad  : GadgetPtr;
  1902.       i     : INTEGER;
  1903.   BEGIN
  1904.     WITH gui^ DO
  1905.  
  1906.       IF (gadlist # NIL) AND (gadgetsSet IN status) THEN
  1907.         IF I.RemoveGList(window, gadlist, -1) = 0 THEN END;
  1908.       END;
  1909.  
  1910.       IF erase THEN
  1911.         WHILE firstGad # NIL DO    (* Infostrukturen freigeben *)
  1912.           ginfo := firstGad;
  1913.           firstGad := firstGad^.nextGadInfo;
  1914.           IF (ginfo^.tags # NIL) AND (ginfo^.nbrTags > 0) THEN
  1915.             FreeMem(ginfo^.tags, SIZE(TagItem) * ginfo^.nbrTags);
  1916.           END;
  1917.           FreeMem(ginfo, SIZE(GUIGadgetInfo));
  1918.         END;
  1919.         WHILE spezialGad # NIL DO  (* Special-Gadgets freigeben *)
  1920.           ggad := spezialGad;
  1921.           spezialGad := spezialGad^.nextGadget;
  1922.           FreeMem(ggad, SPEZIALGADSIZE);
  1923.         END;
  1924.         IF gadlist # NIL THEN G.FreeGadgets(gadlist) END;
  1925.         gui^.gad := G.CreateContext(gui^.gadlist);
  1926.         IF gadlist = NIL THEN SetGUIError(gui, gadgetError) END;
  1927.         newgad.gadgetText := NIL;
  1928.         newgad.gadgetID   := 0;
  1929.         newgad.flags      := NewGadgetFlagSet{};
  1930.         actgad  := 0;
  1931.         firstEGad := NIL;
  1932.         lastEGad  := NIL;
  1933.         FOR i := 0 TO 25 DO
  1934.           keys[i] := noKeyEqu;
  1935.         END;
  1936.       END;
  1937.       EXCL(status, gadgetsSet);
  1938.     END;
  1939.   END RemoveGadgets;
  1940.  
  1941.   PROCEDURE RemoveMenu(gui : GUIInfoPtr; erase : BOOLEAN);
  1942.   BEGIN
  1943.     WITH gui^ DO
  1944.       IF (menuSet IN status) AND (menus # NIL) THEN
  1945.         I.ClearMenuStrip(window);
  1946.       END;
  1947.       IF menus # NIL THEN
  1948.         G.FreeMenus(menus);
  1949.         menus := NIL;
  1950.       END;
  1951.       IF erase THEN
  1952.         actmenu := 0;
  1953.         newMenus^[0].type := nmEnd;
  1954.       END;
  1955.       EXCL(status, menuSet);
  1956.     END;
  1957.   END RemoveMenu;
  1958.  
  1959.   PROCEDURE NewFontAllGadgets(gui : GUIInfoPtr;
  1960.                               font: TextAttrPtr);
  1961.   VAR i : INTEGER;
  1962.   BEGIN
  1963.     FOR i := 0 TO gui^.actgad-1 DO
  1964.       CAST(GUIGadgetInfoPtr,
  1965.            gui^.gadgets^[i]^.userData)^.gadDesc.textAttr := font;
  1966.     END;
  1967.   END NewFontAllGadgets;
  1968.  
  1969.   PROCEDURE ClearWindow(gui : GUIInfoPtr);
  1970.   VAR oldPen : INTEGER;
  1971.   BEGIN
  1972.     WITH gui^.window^ DO
  1973.       oldPen := rPort^.fgPen;
  1974.       SetAPen(rPort, rPort^.bgPen);
  1975.       RectFill(rPort, borderLeft, borderTop+2, width-borderRight-1,
  1976.                height-borderBottom-1);
  1977.       SetAPen(rPort, oldPen);
  1978.     END;
  1979.   END ClearWindow;
  1980.  
  1981.   PROCEDURE CreateSpecialGadget(gui : GUIInfoPtr;
  1982.                                 left   : INTEGER;
  1983.                                 top    : INTEGER;
  1984.                                 width  : INTEGER;
  1985.                                 height : INTEGER;
  1986.                                 kind   : LONGCARD;
  1987.                                 tags   : TagItemPtr);
  1988.   VAR next     : TagItemPtr;
  1989.       spGadget : GadgetPtr;
  1990.       ginfo    : GUIGadgetInfoPtr;
  1991.       text     : IntuiTextPtr;
  1992.       oldtags  : TagItemPtr;
  1993.   BEGIN
  1994.     oldtags := tags;
  1995.     IF   ((kind = progressIndicatorKind) OR (kind = bevelboxKind)) AND
  1996.          (gui^.gad # NIL) AND (~(gadgetsSet IN gui^.status)) THEN
  1997.       IF gui^.actgad < gui^.maxgads THEN
  1998.         WITH gui^ DO
  1999.           newgad.leftEdge := left;
  2000.           newgad.topEdge  := top;
  2001.           newgad.width    := width;
  2002.           newgad.height   := height;
  2003.           IF addBorderDims IN flags THEN
  2004.             INC(newgad.leftEdge, window^.borderLeft);
  2005.             INC(newgad.topEdge, window^.borderTop);
  2006.           END;
  2007.         END;
  2008.         IF tags # NIL THEN
  2009.           next := NextTagItem(oldtags);
  2010.           WHILE next # NIL DO
  2011.             IF    next^.tag = Tag(sgGadgetText) THEN
  2012.  
  2013.               gui^.newgad.gadgetText := ADDRESS(next^.data);
  2014.  
  2015.             ELSIF next^.tag = Tag(sgGadgetFlags) THEN
  2016.  
  2017.               gui^.newgad.flags := CAST(NewGadgetFlagSet, next^.data);
  2018.             END;
  2019.             next := NextTagItem(oldtags);
  2020.           END;
  2021.         END;
  2022.         spGadget := AllocMem(SPEZIALGADSIZE, MemReqSet{memClear});
  2023.         IF spGadget # NIL THEN
  2024.           ginfo := AllocMem(SIZE(GUIGadgetInfo), MemReqSet{memClear});
  2025.           IF ginfo # NIL THEN
  2026.             text := ADDRESS(spGadget);
  2027.             INC(text, SIZE(Gadget));
  2028.  
  2029.             spGadget^.userData := ginfo;
  2030.             ginfo^.kind := kind;
  2031.             ScanGadget(ginfo, tags, TRUE);
  2032.  
  2033.             WITH gui^ DO
  2034.               (* Zeiger auf GUIGadgetInfo-Struktur merken *)
  2035.               IF firstGad = NIL THEN
  2036.                 firstGad := ginfo;
  2037.               ELSE (* alle weiteren mitteinander verketten *)
  2038.                 CAST(GUIGadgetInfoPtr,
  2039.                      gadgets^[actgad-1]^.userData)^.nextGadInfo := ginfo;
  2040.               END;
  2041.               (* Zeiger auf Special-Gadgets merken *)
  2042.               spGadget^.nextGadget := spezialGad;
  2043.               spezialGad := spGadget;
  2044.  
  2045.               gadgets^[actgad] := spGadget;
  2046.               spGadget^.gadgetText := text;
  2047.               text^.iText := newgad.gadgetText;
  2048.               text^.iTextFont := newgad.textAttr;
  2049.               spGadget^.specialInfo  := CAST(ADDRESS, newgad.flags);
  2050.               spGadget^.leftEdge := newgad.leftEdge;
  2051.               spGadget^.topEdge  := newgad.topEdge;
  2052.               spGadget^.width    := newgad.width;
  2053.               spGadget^.height   := newgad.height;
  2054.               spGadget^.gadgetID := newgad.gadgetID;
  2055.               (* Gad-Desc merken *)
  2056.               ginfo^.gadDesc := newgad;
  2057.               newgad.gadgetText := NIL;
  2058.               INC(actgad);
  2059.               INC(newgad.gadgetID);
  2060.             END;
  2061.             CalcText(gui, spGadget);
  2062.           ELSE
  2063.             SetGUIError(gui, memError);
  2064.             FreeMem(spGadget, SIZE(Gadget)+SIZE(IntuiText));
  2065.           END;
  2066.         ELSE
  2067.           SetGUIError(gui, memError);
  2068.           gui^.gad := NIL;
  2069.         END;
  2070.       ELSE
  2071.         SetGUIError(gui, tooManyGadsError);
  2072.         gui^.gad := NIL;
  2073.       END;
  2074.     ELSE
  2075.       SetGUIError(gui, noGUIToolsGadKind);
  2076.       gui^.gad := NIL;
  2077.     END;
  2078.   END CreateSpecialGadget;
  2079.  
  2080.   PROCEDURE BeginRefresh(gui : GUIInfoPtr);
  2081.   VAR spGadget : GadgetPtr;
  2082.   BEGIN
  2083.     G.GTBeginRefresh(gui^.window);
  2084.     spGadget := gui^.spezialGad;
  2085.     WHILE spGadget # NIL DO
  2086.       DrawGadget(gui, spGadget, spGadget^.userData);
  2087.       spGadget := spGadget^.nextGadget;
  2088.     END;
  2089.   END BeginRefresh;
  2090.  
  2091.   PROCEDURE EndRefresh(gui : GUIInfoPtr; complete : BOOLEAN);
  2092.   BEGIN
  2093.     G.GTEndRefresh(gui^.window, complete);
  2094.     IF refreshWF IN gui^.status THEN I.RefreshWindowFrame(gui^.window) END;
  2095.   END EndRefresh;
  2096.  
  2097.   PROCEDURE ShowRequester(gui  : GUIInfoPtr; text : ADDRESS;
  2098.                           kind : LONGCARD; tags : TagItemPtr) : LONGINT;
  2099.   VAR window : WindowPtr;
  2100.       easyReq: EasyStructPtr;
  2101.       next   : TagItemPtr;
  2102.       idcmpP : POINTER TO IDCMPFlagSet;
  2103.       args   : ADDRESS;
  2104.       return : LONGINT;
  2105.       idcmp  : IDCMPFlagSet;
  2106.   BEGIN
  2107.     return := reqCancel;
  2108.     idcmp  := IDCMPFlagSet{};
  2109.     args   := NIL;
  2110.     idcmpP := ADR(idcmp);
  2111.     IF gui # NIL THEN
  2112.       window := gui^.window;
  2113.     ELSE
  2114.       window := CAST(ProcessPtr, FindTask(NIL))^.windowPtr;
  2115.     END;
  2116.     easyReq := AllocMem(SIZE(EasyStruct), MemReqSet{memClear});
  2117.     IF easyReq # NIL THEN
  2118.       WITH easyReq^ DO
  2119.         structSize := SIZE(EasyStruct);
  2120.         textFormat := text;
  2121.         IF    kind = okReqKind   THEN gadgetFormat := ADR('OK');
  2122.         ELSIF kind = doitReqKind THEN gadgetFormat := ADR('YES|NO');
  2123.         ELSIF kind = yncReqKind  THEN gadgetFormat := ADR('YES|NO|CANCEL');
  2124.         END;
  2125.       END;
  2126.       IF tags # NIL THEN
  2127.         next := NextTagItem(tags);
  2128.         WHILE next # NIL DO
  2129.           IF    next^.tag = Tag(srGadgets) THEN
  2130.             easyReq^.gadgetFormat := ADDRESS(next^.data);
  2131.           ELSIF next^.tag = Tag(srArgs)  THEN
  2132.             args := ADDRESS(next^.data);
  2133.           ELSIF next^.tag = Tag(srFlags) THEN
  2134.             easyReq^.flags := CAST(LONGSET, next^.data);
  2135.           ELSIF next^.tag = Tag(srTitle) THEN
  2136.             easyReq^.title := ADDRESS(next^.data);
  2137.           ELSIF next^.tag = Tag(srIDCMP) THEN
  2138.             idcmpP := ADDRESS(next^.data);
  2139.           ELSIF next^.tag = Tag(srReqWindow) THEN
  2140.             window := ADDRESS(next^.data);
  2141.           END;
  2142.           next := NextTagItem(tags);
  2143.         END;
  2144.       END;
  2145.       IF CAST(LONGINT, window) # -1 THEN
  2146.         return := I.EasyRequestArgs(window, easyReq^, idcmpP^, args);
  2147.       END;
  2148.       FreeMem(easyReq, SIZE(EasyStruct));
  2149.     END;
  2150.     RETURN return;
  2151.   END ShowRequester;
  2152.  
  2153.   PROCEDURE ShowRequesterP(gui  : GUIInfoPtr; text : ADDRESS;
  2154.                            kind : LONGCARD; tags : TagItemPtr);
  2155.   BEGIN
  2156.     IF ShowRequester(gui, text, kind, tags) = 0 THEN END;
  2157.   END ShowRequesterP;
  2158.  
  2159.   PROCEDURE SetProcessWindow(window : WindowPtr):WindowPtr;
  2160.   VAR oldwin : WindowPtr;
  2161.   BEGIN
  2162.     oldwin := CAST(ProcessPtr, FindTask(NIL))^.windowPtr;
  2163.     CAST(ProcessPtr, FindTask(NIL))^.windowPtr := window;
  2164.     RETURN oldwin;
  2165.   END SetProcessWindow;
  2166.  
  2167.   PROCEDURE SimpleReq(text : ADDRESS; kind : LONGCARD):LONGINT;
  2168.   BEGIN
  2169.     RETURN ShowRequester(NIL, text, kind, NIL);
  2170.   END SimpleReq;
  2171.  
  2172.   PROCEDURE SimpleReqP(text : ADDRESS; kind : LONGCARD);
  2173.   BEGIN
  2174.     IF ShowRequester(NIL, text, kind, NIL) = 0 THEN END;
  2175.   END SimpleReqP;
  2176.  
  2177. BEGIN
  2178. END GUITools.
  2179.