home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PROG_GEN / GUITLS38.ZIP / WBDEMO.MOD < prev   
Text File  |  1994-02-09  |  9KB  |  213 lines
  1. (**********************************************************************
  2. :Program.    WBDemo.mod
  3. :Contents.   guitools.library demonstration
  4. :Author.     Carsten Ziegeler
  5. :Address.    Augustin-Wibbelt-Str.7, 33106 Paderborn
  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.     requires guitools.library V38.0
  12. :History.    v1.1  Carsten Ziegeler  09-Feb-94
  13. ***********************************************************************)
  14. MODULE WBDemo;
  15.  
  16.   FROM SYSTEM     IMPORT ADR, ADDRESS, ASSEMBLE, TAG;
  17.   FROM ExecD      IMPORT MemReqs, MemReqSet, Node, NodePtr, MinList;
  18.   FROM ExecL      IMPORT AllocMem, FreeMem, RemTail, Insert;
  19.   FROM GadToolsD  IMPORT buttonKind, listviewKind, GtTags, NewGadgetFlagSet,
  20.                          NewGadgetFlags;
  21.   FROM IntuitionD IMPORT WindowPtr, WindowFlagSet, WindowFlags, IDCMPFlagSet,
  22.                          IDCMPFlags, WaTags;
  23.  
  24.   FROM GUIToolsD  IMPORT GUIInfoPtr, GUIInfoFlagSet, GUIInfoFlags, guiSet,
  25.                          GuiTags, preserve, bevelboxKind, SgTags, okReqKind,
  26.                          progressIndicatorKind;
  27.   FROM GUIToolsL  IMPORT OpenIntWindowTags, CloseIntWindow, CreateGUIInfoTags,
  28.                          CreateGadget, CreateGadgetFull, SetProcessWindow,
  29.                          CreateGadgetText, SetGUI, WaitIntMsg, TopazAttr,
  30.                          ResizeGadget, RedrawGadgets, CreateSpecialGadget,
  31.                          SimpleReqP, ModifyGadget, RemoveGadgets, ClearWindow;
  32.  
  33. CONST version = ADR('WBDemo 1.1 (09.02.94)\n');
  34.  
  35. TYPE ListViewArr = ARRAY[0..9] OF ADDRESS;
  36.  
  37. CONST listviewALabs = ListViewArr{ADR('Amiga 500'), ADR('Amiga 500+'),
  38.                        ADR('Amiga 600'), ADR('Amiga 1000'),
  39.                        ADR('Amiga 1200'), ADR('Amiga 2000'),
  40.                        ADR('Amiga 3000'), ADR('Amiga 4000/030'),
  41.                        ADR('Amiga 4000/040'), ADR('Amiga XXXX/yyy')};
  42.       listviewCLabs = ListViewArr{ADR('2086'), ADR('80286'),
  43.                        ADR('80386'), ADR('80486'),
  44.                        ADR('Pentium'), ADR('MC 68000'),
  45.                        ADR('MC 68020'), ADR('MC 68030'),
  46.                        ADR('MC 68040'), ADR('MC 68060')};
  47.  
  48. VAR win : WindowPtr;
  49.     oldWin : WindowPtr;
  50.     gui : GUIInfoPtr;
  51.     tagbuf : ARRAY[0..19] OF LONGCARD;
  52.  
  53.     innerWidth, innerHeight : INTEGER;
  54.     prg : INTEGER;
  55.  
  56.     alist,
  57.     clist  : MinList;        (* Lists for ListviewKind-Gadget *)
  58.  
  59.   (* Creates two exec.lists. One contains some amiga-models and the other
  60.      some cpu-kinds ! *)
  61.   PROCEDURE CreateLists;
  62.   VAR entry  : NodePtr;
  63.       i      : CARDINAL;
  64.   BEGIN
  65.     (* Init amiga-list & cpu-list/ same as NewList(ADR(...)) *)
  66.     ASSEMBLE(LEA     alist(A4), A0
  67.              MOVE.L  A0,(A0)
  68.              ADDQ.L  #4,(A0)
  69.              CLR.L   4(A0)
  70.              MOVE.L  A0,8(A0)
  71.              LEA     clist(A4), A0
  72.              MOVE.L  A0,(A0)
  73.              ADDQ.L  #4,(A0)
  74.              CLR.L   4(A0)
  75.              MOVE.L  A0,8(A0)
  76.     END);
  77.     FOR i := 0 TO 9 DO     (* make the list-entries *)
  78.       entry := AllocMem(SIZE(Node), MemReqSet{memClear});
  79.       IF entry # NIL THEN
  80.         entry^.name := listviewALabs[i];
  81.         Insert(ADR(alist), entry, NIL);
  82.       END;
  83.       entry := AllocMem(SIZE(Node), MemReqSet{memClear});
  84.       IF entry # NIL THEN
  85.         entry^.name := listviewCLabs[i];
  86.         Insert(ADR(clist), entry, NIL);
  87.       END;
  88.     END;
  89.   END CreateLists;
  90.  
  91.  
  92. BEGIN
  93.   CreateLists;
  94.   win := OpenIntWindowTags( 50, 50, 300, 150, ADR('WB-Demo'),
  95.                             IDCMPFlagSet{gadgetUp, closeWindow, newSize,
  96.                                          refreshWindow, vanillaKey,
  97.                                          gadgetDown},
  98.                             WindowFlagSet{activate, windowSizing,
  99.                                           windowDepth, windowClose,
  100.                                           windowDrag}, NIL,
  101.                             TAG(tagbuf, waMinWidth, 250,
  102.                                         waMinHeight,120,
  103.                                         waMaxWidth, 500,
  104.                                         waMaxHeight,200, NIL));
  105.   IF win # NIL THEN
  106.     oldWin := SetProcessWindow(win);
  107.     gui := CreateGUIInfoTags(win, 5, 0, TAG(tagbuf, guiResizableGads, TRUE,
  108.                    guiFlags, GUIInfoFlagSet{addBorderDims, doRefresh,
  109.                                             vanillaKeysNotify, convertKeys},
  110.                    guiGadFont, TopazAttr(), NIL));
  111.     IF gui # NIL THEN
  112.       innerWidth := win^.width - win^.borderRight - win^.borderLeft;
  113.       innerHeight:= win^.height- win^.borderTop - win^.borderBottom;
  114.       CreateSpecialGadget(gui, 20, 20, innerWidth-30, innerHeight-55,
  115.                           progressIndicatorKind,
  116.                           TAG(tagbuf, sgGadgetText, ADR('Progress'),
  117.                         sgGadgetFlags, NewGadgetFlagSet{placetextAbove}, NIL));
  118.       INCL(gui^.flags, addStdUnderscore);
  119.       CreateGadgetFull(gui, 20, innerHeight-30, 70, 18, buttonKind,
  120.                        ADR('_Plus'), NewGadgetFlagSet{placetextIn}, NIL);
  121.       CreateGadgetText(gui, innerWidth-90, innerHeight-30, 70, 18, buttonKind,
  122.                        ADR('_Minus'), NIL);
  123.       EXCL(gui^.flags, addStdUnderscore);
  124.       IF SetGUI(gui) = guiSet THEN
  125.         prg := 0;
  126.         LOOP
  127.           WaitIntMsg(gui);
  128.  
  129.           IF    closeWindow IN gui^.msgClass THEN
  130.             EXIT;
  131.           ELSIF gadgetUp    IN gui^.msgClass THEN
  132.             IF    gui^.gadID = 1 THEN
  133.               IF prg < 10 THEN INC(prg) END;
  134.               ModifyGadget(gui, 0,TAG(tagbuf, sgpiCurrentValue, prg * 10, NIL));
  135.             ELSIF gui^.gadID = 2 THEN
  136.               IF prg >  0 THEN DEC(prg) END;
  137.               ModifyGadget(gui, 0,TAG(tagbuf, sgpiCurrentValue, prg * 10, NIL));
  138.             END;
  139.           ELSIF newSize     IN gui^.msgClass THEN
  140.             innerWidth := win^.width - win^.borderRight - win^.borderLeft;
  141.             innerHeight:= win^.height- win^.borderTop - win^.borderBottom;
  142.             ResizeGadget(gui, 0, preserve, preserve,
  143.                                  innerWidth-30, innerHeight-55);
  144.             ResizeGadget(gui, 1, preserve, innerHeight-25,
  145.                                  preserve, preserve);
  146.             ResizeGadget(gui, 2, innerWidth-90, innerHeight-25,
  147.                                  preserve, preserve);
  148.             IF RedrawGadgets(gui, TRUE) # guiSet THEN EXIT END;
  149.           END;
  150.         END;
  151.       END;
  152.       RemoveGadgets(gui, TRUE);
  153.       ClearWindow(gui);
  154.  
  155.       innerWidth := win^.width - win^.borderRight - win^.borderLeft;
  156.       innerHeight:= win^.height- win^.borderTop - win^.borderBottom;
  157.       CreateGadget(gui, 20, 10, innerWidth-35, innerHeight-45,
  158.                    listviewKind, TAG(tagbuf, gtlvLabels, ADR(alist), NIL));
  159.       INCL(gui^.flags, addStdUnderscore);
  160.       CreateGadgetFull(gui, 20, innerHeight-30, 70, 18, buttonKind,
  161.                        ADR('_Amigas'), NewGadgetFlagSet{placetextIn}, NIL);
  162.       CreateGadgetText(gui, innerWidth-90, innerHeight-30, 70, 18, buttonKind,
  163.                        ADR('_CPUs'), NIL);
  164.       CreateSpecialGadget(gui, 10, 5, innerWidth-15, innerHeight-10,
  165.                           bevelboxKind, TAG(tagbuf, sgbbRecessed, TRUE, NIL));
  166.       IF SetGUI(gui) = guiSet THEN
  167.         LOOP
  168.           WaitIntMsg(gui);
  169.  
  170.           IF    closeWindow IN gui^.msgClass THEN
  171.             EXIT;
  172.           ELSIF gadgetUp    IN gui^.msgClass THEN
  173.             IF    gui^.gadID = 1 THEN  (* Amiga-list *)
  174.               ModifyGadget(gui, 0, TAG(tagbuf, gtlvLabels, ADR(alist), NIL));
  175.             ELSIF gui^.gadID = 2 THEN  (* CPU-list *)
  176.               ModifyGadget(gui, 0, TAG(tagbuf, gtlvLabels, ADR(clist), NIL));
  177.             END;
  178.           ELSIF newSize     IN gui^.msgClass THEN
  179.             innerWidth := win^.width - win^.borderRight - win^.borderLeft;
  180.             innerHeight:= win^.height- win^.borderTop - win^.borderBottom;
  181.             ResizeGadget(gui, 0, preserve, preserve,
  182.                                  innerWidth-35, innerHeight-45);
  183.             ResizeGadget(gui, 1, preserve, innerHeight-30,
  184.                                  preserve, preserve);
  185.             ResizeGadget(gui, 2, innerWidth-90, innerHeight-30,
  186.                                  preserve, preserve);
  187.             ResizeGadget(gui, 3, preserve, preserve,
  188.                                  innerWidth-15, innerHeight-10);
  189.             IF RedrawGadgets(gui, TRUE) # guiSet THEN EXIT END;
  190.           END;
  191.         END;
  192.       END;
  193.     ELSE
  194.       SimpleReqP(ADR('Unable to create gui-info-structure !'), okReqKind);
  195.     END;
  196.   ELSE
  197.     SimpleReqP(ADR('Unable to open window !'), okReqKind);
  198.   END;
  199.  
  200. CLOSE
  201.   IF win # NIL THEN
  202.     IF SetProcessWindow(oldWin) = NIL THEN END;
  203.     CloseIntWindow(win);
  204.     win := NIL;
  205.   END;
  206.   WHILE alist.tailPred # ADR(alist) DO    (* free lists *)
  207.     FreeMem(RemTail(ADR(alist)), SIZE(Node));
  208.   END;
  209.   WHILE clist.tailPred # ADR(clist) DO    (* free lists *)
  210.     FreeMem(RemTail(ADR(clist)), SIZE(Node));
  211.   END;
  212. END WBDemo.
  213.