home *** CD-ROM | disk | FTP | other *** search
/ Gold Fish 3 / goldfish_volume_3.bin / files / dev / obero / oberon-a / source / eagui / oaexample.mod < prev    next >
Encoding:
Text File  |  1995-06-29  |  12.3 KB  |  420 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: OAExample.mod $
  4.   Description: Oberon-2 port of the EAGUI example.c
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 1.1 $
  8.       $Author: fjc $
  9.         $Date: 1995/06/29 18:48:07 $
  10.  
  11.   Copyright © 1995, Frank Copeland.
  12.   This file is part of Oberon-A.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.  
  15. *************************************************************************)
  16.  
  17. (*
  18.  * RCSfile: Example.c,v
  19.  * Author: marcel
  20.  * Revision: 3.2
  21.  * Date: 1994/12/01 07:04:30
  22.  * Locker: marcel
  23.  * State: Exp
  24.  *
  25.  * Description: This is an example of how to use EAGUI. In fact it is the
  26.  *     complete version of the example used in the tutorial[2]. It can be
  27.  *     compiled under SAS/C 6.51. It should be fairly trivial to modify
  28.  *     this example to create any window you want[1]. Please note that the
  29.  *     contents of the gadgets aren't saved, so after a resize, everything
  30.  *     is lost. Under V39 it is very easy to get and set these attributes
  31.  *     (with GT_GetGadgetAttrs() and GT_SetGadgetAttrs()), and although
  32.  *     it's a bit more difficult under V37, it can be done there too (it's
  33.  *     something you'll have to do anyway).
  34.  *
  35.  * [1] If you want to create a new window, it is enough to specify a new
  36.  *     tree of objects. The only other thing you might want to change is
  37.  *     the fact that the window in this example can only be resized in
  38.  *     horizontal direction. If you change the last argument of the
  39.  *     WindowLimits() call to "~0" that's fixed too.
  40.  *
  41.  * [2] In fact, it is a slightly enhanced example, which shows a little bit
  42.  *     more.
  43.  *)
  44.  
  45. <* STANDARD- *>
  46.  
  47. MODULE OAExample;
  48.  
  49. IMPORT
  50.   SYS := SYSTEM, Errors, Kernel, s := Sets, e := Exec, u := Utility,
  51.   gfx := Graphics, i := Intuition, gt := GadTools, df := DiskFont,
  52.   ea := EAGUI, eam := EAGUI_Macros, lbl := EALabels;
  53.  
  54. (*------------------------------------*)
  55. CONST
  56.   VersionTag = "$VER: OAExample 1.1 (18.4.95)";
  57.   VersionStr = "OAExample 1.1 (18.4.95)\n";
  58.   CopyrightStr = "Copyright © 1995 Frank Copeland";
  59.  
  60. (*------------------------------------*)
  61. VAR
  62.  
  63.   winobj_ptr * : ea.OPTR;
  64.   okobj_ptr * : ea.OPTR;
  65.   cancelobj_ptr * : ea.OPTR;
  66.   hgroupobj_ptr * : ea.OPTR;
  67.   win_ptr * : i.WindowPtr;
  68.   scr_ptr * : i.ScreenPtr;
  69.   gadlist_ptr * : i.GadgetPtr;
  70.   stringgadget_ptr * : i.GadgetPtr;
  71.   visualinfo_ptr * : gt.VisualInfo;
  72.   drawinfo_ptr * : i.DrawInfoPtr;
  73.   tf_ptr * : gfx.TextFontPtr;
  74.   textattr * : gfx.TextAttr;
  75.   relhook * : u.Hook;
  76.   imsg * : i.IntuiMessage;
  77.   label * : lbl.Label;
  78.  
  79.  
  80. (*------------------------------------*)
  81. (* same size relation *)
  82.  
  83. PROCEDURE* rel_samesize
  84.   ( hook_ptr : u.HookPtr;
  85.     list_ptr : e.ListPtr;
  86.     msg_ptr  : e.APTR )
  87.   : e.ULONG;
  88.  
  89.   VAR
  90.     ro_ptr : ea.RelationObjectPtr;
  91.     minx, miny, x, y, ignore : e.ULONG;
  92.  
  93.   BEGIN (* rel_samesize *)
  94.     minx := 0;
  95.     miny := 0;
  96.  
  97.     (* examine the list of objects that are affected by the relation *)
  98.     ro_ptr := SYS.VAL (ea.RelationObjectPtr, list_ptr.head);
  99.     WHILE ro_ptr.node.succ # NIL DO
  100.       ignore := ea.GetAttrs ( ro_ptr.object_ptr,
  101.                               ea.MinWidth,  SYS.ADR (x),
  102.                               ea.MinHeight, SYS.ADR (y),
  103.                               u.done );
  104.  
  105.       (* find the maximum values of the minimum sizes *)
  106.       IF x > minx THEN minx := x END;
  107.       IF y > miny THEN miny := y END;
  108.  
  109.       ro_ptr := SYS.VAL (ea.RelationObjectPtr, ro_ptr.node.succ)
  110.     END;
  111.  
  112.     (* set all objects to the newly found minimum sizes *)
  113.     ro_ptr := SYS.VAL (ea.RelationObjectPtr, list_ptr.head);
  114.     WHILE ro_ptr.node.succ # NIL DO
  115.       ignore := ea.SetAttrs ( ro_ptr.object_ptr,
  116.                               ea.MinWidth,  minx,
  117.                               ea.MinHeight, miny,
  118.                               u.done );
  119.  
  120.       ro_ptr := SYS.VAL (ea.RelationObjectPtr, ro_ptr.node.succ)
  121.     END;
  122.     RETURN 0
  123.   END rel_samesize;
  124.  
  125. (*------------------------------------*)
  126. PROCEDURE resizewindow;
  127.  
  128.   VAR
  129.     bl, br, bt, bb, ignore : LONGINT;
  130.  
  131.   BEGIN (* resizewindow *)
  132.     (* if necessary, remove the gadget list from the window, and clean it
  133.      * up
  134.      *)
  135.  
  136.     IF gadlist_ptr # NIL THEN
  137.       ignore := i.RemoveGList ( win_ptr, gadlist_ptr, -1 );
  138.       ea.FreeGadgetList (winobj_ptr, gadlist_ptr);
  139.       gadlist_ptr := NIL;
  140.     END;
  141.  
  142.     ignore := ea.GetAttrs (winobj_ptr,
  143.         ea.BorderLeft,   SYS.ADR (bl),
  144.         ea.BorderRight,  SYS.ADR (br),
  145.         ea.BorderTop,    SYS.ADR (bt),
  146.         ea.BorderBottom, SYS.ADR (bb),
  147.         u.done );
  148.  
  149.     ignore := ea.SetAttrs (winobj_ptr,
  150.         ea.Width,  win_ptr.width -
  151.                    win_ptr.borderLeft -
  152.                    win_ptr.borderRight -
  153.                    bl -
  154.                    br,
  155.         ea.Height, win_ptr.height -
  156.                    win_ptr.borderTop -
  157.                    win_ptr.borderBottom -
  158.                    bt -
  159.                    bb,
  160.         ea.Left,   win_ptr.borderLeft,
  161.         ea.Top,    win_ptr.borderTop,
  162.         u.done );
  163.  
  164.     ea.LayoutObjects (winobj_ptr);
  165.  
  166.     IF ea.CreateGadgetList ( winobj_ptr, gadlist_ptr, visualinfo_ptr,
  167.                              drawinfo_ptr )
  168.      # ea.ERROR_OK
  169.     THEN
  170.       HALT (36)
  171.     END;
  172.  
  173.     gfx.EraseRect (win_ptr.rPort,
  174.         win_ptr.borderLeft,
  175.         win_ptr.borderTop,
  176.         win_ptr.width - win_ptr.borderRight - 1,
  177.         win_ptr.height - win_ptr.borderBottom - 1);
  178.  
  179.     i.RefreshWindowFrame (win_ptr);
  180.  
  181.     ignore := i.AddGList (win_ptr, gadlist_ptr, -1, -1, NIL);
  182.     i.RefreshGList (gadlist_ptr, win_ptr, NIL, -1);
  183.     gt.RefreshWindow (win_ptr, NIL);
  184.  
  185.     (* finally, we render the imagery, if there is any *)
  186.     ea.RenderObjects (winobj_ptr, win_ptr.rPort);
  187.   END resizewindow;
  188.  
  189. (*------------------------------------*)
  190. PROCEDURE* Cleanup (VAR rc : LONGINT);
  191.  
  192.   VAR ignore : LONGINT;
  193.  
  194.   BEGIN (* Cleanup *)
  195.     IF gadlist_ptr # NIL THEN
  196.       ignore := i.RemoveGList (win_ptr, gadlist_ptr, -1);
  197.       ea.FreeGadgetList (winobj_ptr, gadlist_ptr);
  198.       gadlist_ptr := NIL
  199.     END;
  200.  
  201.     IF win_ptr # NIL THEN
  202.       i.CloseWindow (win_ptr);
  203.       win_ptr := NIL;
  204.     END;
  205.  
  206.     IF drawinfo_ptr # NIL THEN
  207.       i.FreeScreenDrawInfo (scr_ptr, drawinfo_ptr);
  208.       drawinfo_ptr := NIL;
  209.     END;
  210.  
  211.     IF visualinfo_ptr # NIL THEN
  212.       gt.FreeVisualInfo (visualinfo_ptr);
  213.       visualinfo_ptr := NIL;
  214.     END;
  215.  
  216.     IF scr_ptr # NIL THEN
  217.       i.UnlockPubScreen (e.NILSTR, scr_ptr);
  218.       scr_ptr := NIL;
  219.     END;
  220.  
  221.     IF winobj_ptr # NIL THEN
  222.       ea.DisposeObject (winobj_ptr);
  223.       winobj_ptr := NIL;
  224.     END;
  225.  
  226.     IF tf_ptr # NIL THEN
  227.       gfx.CloseFont (tf_ptr);
  228.       tf_ptr := NIL;
  229.     END;
  230.   END Cleanup;
  231.  
  232. (*------------------------------------*)
  233. PROCEDURE Init ();
  234.  
  235.   VAR
  236.     w, h, bl, br, bt, bb, ignore : LONGINT;
  237.     w_ptr, h_ptr, bl_ptr, br_ptr, bt_ptr, bb_ptr : SYS.ADDRESS;
  238.  
  239.   BEGIN (* Init *)
  240.     Kernel.SetCleanup (Cleanup);
  241.  
  242.     textattr.name := SYS.ADR ("helvetica.font");
  243.     textattr.ySize := 15;
  244.     textattr.style := gfx.normal;
  245.     textattr.flags := {gfx.diskFont};
  246.  
  247.     (* open the font *)
  248.     tf_ptr := df.OpenDiskFont (textattr);
  249.     IF tf_ptr = NIL THEN HALT (30) END;
  250.  
  251.     (* initialize the relation *)
  252.     u.InitHook (SYS.ADR (relhook), SYS.VAL (u.HookFunc, rel_samesize));
  253.  
  254.     (*
  255.     (* initialize textfield hooks *)
  256.     u.InitHook (SYS.ADR (tfminsizehook), SYS.VAL (u.HookFunc, lbl.MinSize));
  257.     u.InitHook (SYS.ADR (tfrenderhook), SYS.VAL (u.HookFunc, lbl.Render));
  258.     *)
  259.  
  260.     (* set up some defaults for all objects *)
  261.     ignore := ea.SetAttr (NIL, ea.DefGTTextAttr, SYS.ADR (textattr));
  262.  
  263.     (* now we can build the object tree *)
  264.     okobj_ptr := eam.GTButton (SYS.ADR ("Ok"), u.done);
  265.     cancelobj_ptr := eam.GTButton(SYS.ADR ("Cancel"), u.done);
  266.     hgroupobj_ptr := eam.HGroup (
  267.         ea.BorderTop,    4,
  268.         ea.Child,        okobj_ptr,
  269.         ea.Child,        eam.EmptyBox (1, u.done),
  270.         ea.Child,        cancelobj_ptr,
  271.         u.done );
  272.     winobj_ptr := eam.VGroup (
  273.         ea.BorderLeft,   4,
  274.         ea.BorderRight,  4,
  275.         ea.BorderTop,    4,
  276.         ea.BorderBottom, 4,
  277.         ea.Child,        lbl.NewLabel ( label,
  278.             ea.BorderBottom,  4,
  279.             u.done ),
  280.         ea.Child,        eam.GTString ( NIL,
  281.             ea.InstanceAddress, SYS.ADR (stringgadget_ptr),
  282.             ea.MinWidth,        20, (* Fixes a bug in the GadTools library, which
  283.                                      * renders the full contents of the gadget, if
  284.                                      * it is very small, and you're using a fixed-
  285.                                      * width font. Originally reported by Roy van
  286.                                      * der Woning.
  287.                                      *)
  288.             u.done ),
  289.         ea.Child,        hgroupobj_ptr,
  290.         u.done );
  291.     IF winobj_ptr = NIL THEN HALT (31) END;
  292.  
  293.     ignore := ea.NewRelation ( hgroupobj_ptr, SYS.ADR (relhook),
  294.         ea.Object, okobj_ptr,
  295.         ea.Object, cancelobj_ptr,
  296.         u.done );
  297.  
  298.     (* lock the screen *)
  299.     scr_ptr := i.LockPubScreen (e.NILSTR);
  300.     IF scr_ptr = NIL THEN HALT (32) END;
  301.  
  302.     (* get VisualInfo and DrawInfo *)
  303.     visualinfo_ptr := gt.GetVisualInfo (scr_ptr, u.done);
  304.     IF visualinfo_ptr = NIL THEN HALT (33) END;
  305.     drawinfo_ptr := i.GetScreenDrawInfo (scr_ptr);
  306.     IF drawinfo_ptr = NIL THEN HALT (34) END;
  307.  
  308.     (* fill in the label structure *)
  309.     lbl.InitLabel ( label,
  310.         SYS.ADR ("Enter a string here:"),
  311.         SYS.ADR (textattr),
  312.         gfx.jam1,
  313.         {lbl.AlignTop, lbl.ShadowText},
  314.         drawinfo_ptr );
  315.  
  316.     (* obtain the minimum dimensions of every object in the tree *)
  317.     ea.GetMinSizes (winobj_ptr);
  318.  
  319.     (* get some attributes *)
  320.     w_ptr := SYS.ADR (w); h_ptr := SYS.ADR (h);
  321.     bl_ptr := SYS.ADR (bl); br_ptr := SYS.ADR (br);
  322.     bt_ptr := SYS.ADR (bt); bb_ptr := SYS.ADR (bb);
  323.  
  324.     ignore := ea.GetAttrs ( winobj_ptr,
  325.         ea.MinWidth,     w_ptr,
  326.         ea.MinHeight,    h_ptr,
  327.         ea.BorderLeft,   bl_ptr,
  328.         ea.BorderRight,  br_ptr,
  329.         ea.BorderTop,    bt_ptr,
  330.         ea.BorderBottom, bb_ptr,
  331.         u.done );
  332.  
  333.      (* open the window *)
  334.      win_ptr := i.OpenWindowTagsA ( NIL,
  335.          i.waTitle,       SYS.ADR ("EAGUI Example"),
  336.          i.waFlags,       { i.windowDrag, i.windowDepth, i.windowClose,
  337.                             i.windowSizing, i.sizeBBottom, i.activate },
  338.          i.waIDCMP,       { i.closeWindow, i.refreshWindow, i.newSize }
  339.                           + gt.buttonIDCMP + gt.stringIDCMP,
  340.          i.waInnerHeight, h + bt + bb,
  341.          i.waInnerWidth,  (w + bl + br) * 2,
  342.          u.done );
  343.      IF win_ptr = NIL THEN HALT (35) END;
  344.  
  345.      (* set the window limits *)
  346.      IF i.WindowLimits ( win_ptr,
  347.          w + win_ptr.borderLeft + win_ptr.borderRight + bl + br,
  348.          h + win_ptr.borderTop + win_ptr.borderBottom + bt + bb,
  349.          -1,
  350.          h + win_ptr.borderTop + win_ptr.borderBottom + bt + bb )
  351.      THEN END;
  352.  
  353.     (* create the gadgets and add them to the window *)
  354.     resizewindow();
  355.   END Init;
  356.  
  357. (*------------------------------------*)
  358. PROCEDURE handlemsgs () : LONGINT;
  359.  
  360.   VAR
  361.     imsg_ptr : i.IntuiMessagePtr;
  362.     rc : e.ULONG;
  363.  
  364.   BEGIN (* handlemsgs *)
  365.     LOOP
  366.       imsg_ptr := gt.GetIMsg (win_ptr.userPort);
  367.       IF imsg_ptr = NIL THEN EXIT END;
  368.         imsg := imsg_ptr^;
  369.  
  370.         gt.ReplyIMsg (imsg_ptr);
  371.  
  372.         IF imsg.class = {i.refreshWindow} THEN
  373.           gt.BeginRefresh (win_ptr);
  374.           gt.EndRefresh (win_ptr, i.LTRUE)
  375.         ELSIF imsg.class = {i.closeWindow} THEN
  376.           rc := 10
  377.         ELSIF imsg.class = {i.newSize} THEN
  378.           resizewindow();
  379.           (* Just for fun, we put a string in the string gadget after each
  380.            * resize. This demonstrates how to use the EA_InstanceAddress
  381.            * tag to obtain pointers to gadgets, which you can use to modify
  382.            * the gadgets directly.
  383.            *)
  384.           gt.SetGadgetAttrs (
  385.               stringgadget_ptr^, win_ptr, NIL,
  386.               gt.stString, SYS.ADR ("Ah, a size change! How nice."),
  387.               u.done )
  388.         END
  389.     END; (* LOOP *)
  390.     RETURN rc
  391.   END handlemsgs;
  392.  
  393.  
  394. (*------------------------------------*)
  395. PROCEDURE Main ();
  396.  
  397.   VAR
  398.     idcmpmask, signals : s.SET32;
  399.     done : BOOLEAN;
  400.  
  401.   BEGIN (* Main *)
  402.     done := FALSE;
  403.  
  404.     (* event handling loop *)
  405.     idcmpmask := {win_ptr.userPort.sigBit};
  406.     WHILE ~done DO
  407.       signals := e.Wait (idcmpmask);
  408.       IF (signals * idcmpmask) # {} THEN
  409.         IF handlemsgs() # 0 THEN done := TRUE END
  410.       END
  411.     END
  412.   END Main;
  413.  
  414. (*------------------------------------*)
  415. BEGIN (* OAExample *)
  416.   Errors.Init;
  417.   Init;
  418.   Main
  419. END OAExample.
  420.