home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD1.bin / useful / dev / obero / oberon-a / examples / guienvironment / notifyexample.mod < prev    next >
Encoding:
Text File  |  1994-09-05  |  14.9 KB  |  383 lines
  1. (****************************************************************************
  2.  
  3. $RCSfile: NotifyExample.mod $
  4.  
  5. $Revision: 1.1 $
  6.     $Date: 1994/07/19 20:21:55 $
  7.  
  8.     GUIEnvironment V37.0 example: Notify functions
  9.  
  10.     Oberon-A Oberon-2 Compiler V4.5ß (Release 1.3)
  11.  
  12.   Copyright © 1994, Carsten Ziegeler
  13.                     Augustin-Wibbelt-Str.7, 33106 Paderborn, Germany
  14.  
  15.   This example differs just a little but from the modula-2 example,
  16.   because Oberon-A does not know register parameters by now. So the
  17.   vanilla key hook function had to be implemented by hand !
  18.  
  19. ****************************************************************************)
  20. MODULE NotifyExample;
  21.  
  22. (* $P- Allow non-portable code *)
  23.  
  24. (* Let's open an own hires-pal-screen with a full-sized window. All gadget-
  25.    kinds from GADTools are displayed. The results will be printed using
  26.    StdIO (It's the easiest way !) !*)
  27.  
  28. (* NotifyExample uses the following catalog strings 1.. : gadgets
  29.                                                     30..: menus
  30.                                                     50..: misc
  31.                                                     100 : END       *)
  32.  
  33. IMPORT SYS := SYSTEM, E := Exec, GUI := GUIEnv, I := Intuition, ExecUtil,
  34.        GT := GadTools, IO := StdIO, Str := Strings, GS := GUIEnvSupport;
  35.  
  36. TYPE CycleArr    = ARRAY 5 OF E.STRPTR;
  37.      MxArr       = ARRAY 4 OF E.STRPTR;
  38.      ListViewArr = ARRAY 11 OF E.STRPTR;
  39.  
  40.      INTPTR   = CPOINTER TO INTEGER;
  41.  
  42.      ListViewNode = E.Node;
  43.      ListViewNodePtr = CPOINTER TO ListViewNode;
  44.  
  45.  
  46. CONST version = "$VER: NotifyExample 1.1 (21.06.94)\n";
  47.  
  48. VAR S : I.ScreenPtr;
  49.     W : I.WindowPtr;
  50.     G : GUI.GUIInfoPtr;  (* The most important one *)
  51.  
  52.     list   : E.MinList;        (* List for ListviewKind-Gadget *)
  53.     entry  : ListViewNodePtr;
  54.     i : INTEGER;
  55.  
  56. (* Variables for the entry-fields *)
  57.     string : ARRAY 80 OF CHAR;
  58.     longI  : LONGINT;
  59.     cycle  : INTEGER;
  60.     mx     : INTEGER;
  61.     check  : BOOLEAN;
  62.     listview : INTEGER;
  63.     scroller : INTEGER;
  64.     slider   : INTEGER;
  65.     color    : INTEGER;
  66.  
  67.     cycleLabs: CycleArr;
  68.     mxLabs   : MxArr;
  69.     listviewLabs : ListViewArr;
  70.  
  71.     strPTR : E.STRPTR;
  72.  
  73.   (* Hook-Function, so we can use also chars which are not letters as
  74.      key-equivalents !
  75.      SORRY, but the current version of Oberon-A does not support
  76.      register parameters, so we can't define this hook function by now.
  77.      Perhaps it would be possible to implement one using the register
  78.      functions provided by SYSTEM but that's not a good idea ! So this
  79.      example will not handle any custom key equivalents !
  80.      This hook functions is emulated in the IDCMP message loop !
  81.   PROCEDURE VanKeyHookFct(char{D0} : CHAR) : LONGINT;
  82.   VAR return : LONGINT;
  83.   BEGIN
  84.     (* MXKind gadgets do not support gadget-text, so we have to immitate
  85.        the key-equivalent.
  86.        We also use for the sliderKind gadget a key-equivalent with the
  87.        + and - keys *)
  88.     return := GUI.gehKeyUnknown;
  89.     IF    char = 'm' THEN
  90.       return := 9;
  91.     ELSIF char = 'M' THEN
  92.       return := 9 + GUI.gehKeyShifted;
  93.     ELSIF char = '+' THEN
  94.       return := 8;
  95.     ELSIF char = '-' THEN
  96.       return := 8 + GUI.gehKeyShifted;
  97.     END;
  98.     RETURN return;
  99.   END VanKeyHookFct;
  100.  
  101.   But despite that we define a hook function which always returns
  102.   gehKeyUnknown, so the key is passed to this application ! *)
  103.   PROCEDURE VanKeyHookFct() : LONGINT;
  104.   BEGIN
  105.     RETURN GUI.gehKeyUnknown;
  106.   END VanKeyHookFct;
  107.  
  108. (* Menu-Functions :
  109.    Usually you have to set the A4 register to have access to all functions
  110.    and variables. GUIEnv does this for us !
  111.    If the result is TRUE, GUIEnv will stay in the waiting-loop, otherwise
  112.    it will return ! *)
  113.  
  114.   PROCEDURE MenuAbout():BOOLEAN;
  115.   BEGIN
  116.     IF GUI.base.GUIRequest(G, GUI.base.GetCatStr(G, 51,
  117.                            SYS.ADR('GUIEnvironment example for version 37.0\n© 1994 C. Ziegeler')),
  118.                            GUI.gerOKKind, NIL) = GUI.gerCancel THEN END;
  119.     (* the return value of a okReqKind is always 0 *)
  120.     RETURN TRUE;
  121.   END MenuAbout;
  122.  
  123.   PROCEDURE MenuQuit():BOOLEAN;
  124.   BEGIN
  125.     RETURN GUI.base.GUIRequest(G, GUI.base.GetCatStr(G, 52, SYS.ADR('Really quit example ?')),
  126.                          GUI.gerDoItKind,
  127.                          GUI.gerGadgets, GUI.base.GetCatStr(G, 53, SYS.ADR('YES|NO')), NIL) # GUI.gerYes;
  128.   END MenuQuit;
  129.  
  130.  
  131. BEGIN
  132.  
  133.   ExecUtil.NewList(list);
  134.  
  135.   cycleLabs[0] := SYS.ADR("Zero");
  136.   cycleLabs[1] := SYS.ADR("One");
  137.   cycleLabs[2] := SYS.ADR("Two");
  138.   cycleLabs[3] := SYS.ADR("Three");
  139.   cycleLabs[4] := NIL;
  140.   mxLabs[0] := SYS.ADR("Man");
  141.   mxLabs[1] := SYS.ADR("Woman");
  142.   mxLabs[2] := SYS.ADR("Child");
  143.   mxLabs[3] := NIL;
  144.   listviewLabs[0] := SYS.ADR("Amiga 500");
  145.   listviewLabs[1] := SYS.ADR("Amiga 500+");
  146.   listviewLabs[2] := SYS.ADR("Amiga 600");
  147.   listviewLabs[3] := SYS.ADR("Amiga 1000");
  148.   listviewLabs[4] := SYS.ADR("Amiga 1200");
  149.   listviewLabs[5] := SYS.ADR("Amiga 2000");
  150.   listviewLabs[6] := SYS.ADR("Amiga 3000");
  151.   listviewLabs[7] := SYS.ADR("Amiga 4000/030");
  152.   listviewLabs[8] := SYS.ADR("Amiga 4000/040");
  153.   listviewLabs[9] := SYS.ADR("Amiga XXXX/yyy");
  154.   listviewLabs[10] := NIL;
  155.  
  156.   FOR i := 0 TO 9 DO     (* make the list-entries *)
  157.     entry := E.base.AllocMem(SIZE(ListViewNode), {E.memClear});
  158.     IF entry # NIL THEN
  159.       entry^.name := listviewLabs[i];
  160.       E.base.Insert(list, entry, NIL);
  161.     END;
  162.   END;
  163.  
  164.   (* set the values *)
  165.   (* the string variable is set later because of localization ! *)
  166.   longI  := 33106;
  167.   cycle  := 2;
  168.   mx     := 1;
  169.   check  := TRUE;
  170.   listview := -1;
  171.   scroller := 1;
  172.   slider   := 5;
  173.   color    := 0;
  174.  
  175.   (* open screen with Topaz/8-Font! *)
  176.   S := GUI.base.OpenGUIScreen(GS.gesHiresPalID, 2,
  177.                               SYS.ADR("GUIEnvExample_Screen"),
  178.                               I.saFont, GS.TopazAttr(), NIL);
  179.   IF S # NIL THEN
  180.     (* And now a full-sized window *)
  181.     W := GUI.base.OpenGUIWindow(0, 0, 640, 256,
  182.                                 SYS.ADR("GUIEnvironment - NotifyExample"),
  183.                                 {I.idcmpCloseWindow, I.idcmpGadgetUp,
  184.                                  I.idcmpGadgetDown, I.idcmpMenuPick,
  185.                                  I.idcmpRefreshWindow, I.idcmpVanillaKey},
  186.                                 {I.wflgCloseGadget, I.wflgActivate}, S,
  187.                                 GUI.gewOuterSize, 1, NIL);
  188.     IF W # NIL THEN
  189.       (* create GUIInfo *)
  190.       G := GUI.base.CreateGUIInfo(W,
  191.                             GUI.guiVanKeyHook, SYS.ADR(VanKeyHookFct),
  192.                             GUI.guiCatalogFile, SYS.ADR('GUIEnvExamples.catalog'),
  193.                             GUI.guiGadgetCatalogOffset, 1,
  194.                             GUI.guiMenuCatalogOffset, 30, NIL);
  195.  
  196.       IF G # NIL THEN
  197.  
  198.         (* Is the locale.library installed and the catalog available,
  199.            so change the texts for the cycle and mx gadget *)
  200.         FOR i := 0 TO 3 DO
  201.           cycleLabs[i] := GUI.base.GetCatStr(G, 54+i, cycleLabs[i]);
  202.         END;
  203.         FOR i := 0 TO 2 DO
  204.           mxLabs[i] := GUI.base.GetCatStr(G, 58+i, mxLabs[i]);
  205.         END;
  206.  
  207.         (* Copy text to string ! I tried to use Strings.Insert directly
  208.            but it failt ! *)
  209.         strPTR := GUI.base.GetCatStr(G, 68, SYS.ADR("This is a text-line !"));
  210.         Str.Insert(string, strPTR^, 0);
  211.  
  212.         (* If this gadget receives a gadgetUp message, GUIEnv will
  213.            call the given function. Only if this returns FALSE
  214.            GUIEnv will send this message to our message port !! *)
  215.         GUI.base.CreateGUIGadget(G, 500, 190, 80, 20, GT.buttonKind,
  216.                                  GUI.gegFlags, {GT.placeTextIn},
  217.                                  GUI.gegText, SYS.ADR('_QUIT'),
  218.                                  GUI.gegFunctionUp, SYS.ADR(MenuQuit),
  219.                                  GUI.gegFunctionDown, SYS.ADR(MenuQuit), NIL);
  220.         GUI.base.CreateGUIGadget(G, 100, 10, 200, 13, GT.stringKind,
  221.                                  GUI.gegText, SYS.ADR('S_tring:'),
  222.                                  GUI.gegFlags, {GT.placeTextLeft},
  223.                                  GUI.gegVarAddress, SYS.ADR(string),
  224.                                  GUI.gegStartChain, 0,
  225.                                  GT.stMaxChars, 80, NIL);
  226.         GUI.base.CreateGUIGadget(G, 100, 30,  80, 13, GT.integerKind,
  227.                                  GUI.gegVarAddress, SYS.ADR(longI),
  228.                                  GUI.gegText, SYS.ADR('_Longint:'),
  229.                                  GUI.gegEndChain, 1,
  230.                                  GT.inMaxChars, 7, NIL);
  231.         GUI.base.CreateGUIGadget(G, 100, 50,  80,15, GT.cycleKind,
  232.                                  GUI.gegVarAddress, SYS.ADR(cycle),
  233.                                  GUI.gegText, SYS.ADR('C_ycle It:'),
  234.                                  GT.cyLabels, SYS.ADR(cycleLabs), NIL);
  235.         GUI.base.CreateGUIGadget(G, 270, 90,  0, 0, GT.checkBoxKind,
  236.                                  GUI.gegVarAddress, SYS.ADR(check),
  237.                                  GUI.gegText, SYS.ADR('_Check it:'), NIL);
  238.         GUI.base.CreateGUIGadget(G, 320, 30, 200, 80, GT.listViewKind,
  239.                                  GUI.gegVarAddress, SYS.ADR(listview),
  240.                                  GUI.gegText, SYS.ADR('Choose List_view-Entry'),
  241.                                  GUI.gegFlags, {GT.placeTextAbove},
  242.                                  GT.lvLabels, SYS.ADR(list),
  243.                                  GT.lvShowSelected, NIL, NIL);
  244.         GUI.base.CreateGUIGadget(G, 20, 130, 600, 14, GT.scrollerKind,
  245.                                  GUI.gegText, SYS.ADR('_Scroll Me'),
  246.                                  GUI.gegVarAddress, SYS.ADR(scroller),
  247.                                  GT.scTotal, 100,
  248.                                  I.gaImmediate, 1,
  249.                                  I.gaRelVerify, 1,
  250.                                  I.pgaFreedom, I.lOrientHoriz, NIL);
  251.         GUI.base.CreateGUIGadget(G, 120, 200, 250, 35, GT.paletteKind,
  252.                                  GUI.gegText, SYS.ADR('This is a _palette !'),
  253.                                  GT.paDepth, 2,
  254.                                  GUI.gegVarAddress, SYS.ADR(color),
  255.                                  GT.paIndicatorWidth, 50, NIL);
  256.         GUI.base.CreateGUIGadget(G, 20, 170, 600, 14, GT.sliderKind,
  257.                                  GUI.gegText, SYS.ADR('Slider me with + and -'),
  258.                                  GT.slMin, 0,
  259.                                  GT.slMax, 200,
  260.                                  GUI.gegVarAddress, SYS.ADR(slider),
  261.                                  I.gaImmediate, 1,
  262.                                  I.gaRelVerify, 1,
  263.                                  I.pgaFreedom, I.lOrientHoriz, NIL);
  264.         GUI.base.CreateGUIGadget(G, 100, 80,  80,17, GT.mxKind,
  265.                                  GUI.gegFlags, {GT.placeTextLeft},
  266.                                  GUI.gegVarAddress, SYS.ADR(mx),
  267.                                  GT.mxLabels, SYS.ADR(mxLabs), NIL);
  268.         GUI.base.CreateGUIGadget(G, 120, 68,  10,12, GT.textKind,
  269.                                  GUI.gegText, SYS.ADR('MX:'),
  270.                                  GT.txText, GUI.base.GetCatStr(G, 50, SYS.ADR('Try pressing m')), NIL);
  271.  
  272.         GUI.base.CreateGUIMenuEntry(G, GT.nmTitle, SYS.ADR('Project'), NIL);
  273.         GUI.base.CreateGUIMenuEntry(G, GT.nmItem, SYS.ADR('About'),
  274.                                     GUI.gemFunction, SYS.ADR(MenuAbout),
  275.                                     GUI.gemShortCut, SYS.ADR('A\o'), NIL);
  276.         GUI.base.CreateGUIMenuEntry(G, GT.nmItem, SYS.ADR('Quit'),
  277.                                     GUI.gemFunction, SYS.ADR(MenuQuit),
  278.                                     GUI.gemShortCut, SYS.ADR('Q\o'), NIL);
  279.  
  280.         IF GUI.base.DrawGUI(G, NIL) = GUI.geDone THEN (* Draw all *)
  281.  
  282.           LOOP (* Input-Loop *)
  283.             GUI.base.WaitGUIMsg(G);
  284.             IF    I.idcmpCloseWindow IN G^.msgClass THEN
  285.               IF MenuQuit() = FALSE THEN EXIT END;
  286.             ELSIF (I.idcmpGadgetUp IN G^.msgClass) OR (I.idcmpGadgetDown IN G^.msgClass) THEN
  287.               (* We are only interessed in the buttonGadget !*)
  288.               IF G^.msgGadNbr = 0 THEN  (* ButtonGadget Quit *)
  289.                 EXIT;
  290.               END;
  291.             ELSIF I.idcmpMenuPick IN G^.msgClass THEN
  292.               EXIT;
  293.             (* Emulate the vankeyhook function ! Usually this part is
  294.                not required ! The hook function does then this for us ! *)
  295.             ELSIF I.idcmpVanillaKey IN G^.msgClass THEN
  296.               CASE G^.msgCharCode OF
  297.                 'm' : GUI.base.GUIGadgetAction(G, GUI.gegActivateUp, 9, NIL);
  298.               | 'M' : GUI.base.GUIGadgetAction(G, GUI.gegActivateDown, 9, NIL);
  299.               | '+' : GUI.base.GUIGadgetAction(G, GUI.gegActivateUp, 8, NIL);
  300.               | '-' : GUI.base.GUIGadgetAction(G, GUI.gegActivateDown, 8, NIL);
  301.               END;
  302.             END;
  303.           END;
  304.  
  305.           (* update entry-gadgets *)
  306.           GUI.base.GUIGadgetAction(G, GUI.gegGetVar, GUI.gegALLGADGETS, NIL);
  307.  
  308.           (* And now print all values *)
  309.           (* For each string, it is necessary first to call
  310.              strPTR := GUI.base.GetCatStr(..) and then
  311.              IO.WriteStr(strPTR^)
  312.              because IO.WriteStr(GUI.base.GetCatStr(..)^) causes an error *)
  313.  
  314.           IO.WriteLn;
  315.           strPTR := GUI.base.GetCatStr(G, 61, SYS.ADR("Your input:"));
  316.           IO.WriteStr(strPTR^);
  317.           IO.WriteLn;
  318.           strPTR := GUI.base.GetCatStr(G, 62, SYS.ADR("String  :"));
  319.           IO.WriteStr(strPTR^);
  320.           IO.WriteStr(string);
  321.           IO.WriteLn;
  322.  
  323.           strPTR := GUI.base.GetCatStr(G, 63, SYS.ADR("Longint :"));
  324.           IO.WriteStr(strPTR^);
  325.           IO.WriteInt(longI);
  326.           IO.WriteLn;
  327.  
  328.           IO.WriteStr("Cycle   :");
  329.           IO.WriteStr(cycleLabs[cycle]^);
  330.           IO.WriteLn;
  331.  
  332.           IO.WriteStr("MX      :");
  333.           IO.WriteStr(mxLabs[mx]^);
  334.           IO.WriteLn;
  335.  
  336.           IF check THEN
  337.             strPTR := GUI.base.GetCatStr(G, 64, SYS.ADR("Checkbox:YES"));
  338.             IO.WriteStr(strPTR^);
  339.           ELSE
  340.             strPTR := GUI.base.GetCatStr(G, 65, SYS.ADR("Checkbox:NO"));
  341.             IO.WriteStr(strPTR^);
  342.           END;
  343.           IO.WriteLn;
  344.  
  345.           IO.WriteStr("Listview:");
  346.           IF listview = -1 THEN
  347.             strPTR := GUI.base.GetCatStr(G, 66, SYS.ADR("Nothing"));
  348.             IO.WriteStr(strPTR^);
  349.           ELSE
  350.             IO.WriteStr(listviewLabs[9-listview]^);
  351.             (* The list was created in reverse order ! *)
  352.           END;
  353.           IO.WriteLn;
  354.  
  355.           IO.WriteStr("Slider  :");
  356.           IO.WriteInt(slider);
  357.           IO.WriteLn;
  358.  
  359.           IO.WriteStr("Scroller:");
  360.           IO.WriteInt(scroller);
  361.           IO.WriteLn;
  362.  
  363.           strPTR := GUI.base.GetCatStr(G, 67, SYS.ADR("Color   :"));
  364.           IO.WriteStr(strPTR^);
  365.           IO.WriteInt(color);
  366.           IO.WriteLn;
  367.  
  368.           IO.WriteLn;
  369.         END;
  370.       END;
  371.     END;
  372.   END;
  373.  
  374.  
  375.   IF S # NIL THEN
  376.     GUI.base.CloseGUIScreen(S);
  377.     (* The closing of the window etc is done by GUIEnv !*)
  378.   END;
  379.   WHILE list.tailPred # SYS.ADR(list) DO    (* free list *)
  380.     E.base.FreeMem(E.base.RemTail(list), SIZE(ListViewNode));
  381.   END;
  382. END NotifyExample.
  383.