home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 10 / Fresh_Fish_10_2352.bin / new / dev / obero / oberon-a / examples / libraries / gadtools / simplegadget.mod < prev    next >
Text File  |  1995-07-02  |  4KB  |  160 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: SimpleGadget.mod $
  4.   Description: Port of simplegtgadget.c from RKM:Libraries
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 1.6 $
  8.       $Author: fjc $
  9.         $Date: 1995/07/02 16:59:15 $
  10.  
  11.   Copyright © 1994-1995, Frank Copeland.
  12.   This example program is part of Oberon-A.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.  
  15. *************************************************************************)
  16.  
  17. <* STANDARD- *>
  18.  
  19. MODULE SimpleGadget;
  20.  
  21. IMPORT
  22.   SYS := SYSTEM,
  23.   e   := Exec,
  24.   u   := Utility,
  25.   g   := Graphics,
  26.   i   := Intuition,
  27.   gt  := GadTools,
  28.   IO  := StdIO;
  29.  
  30. CONST
  31.   VersionTag = "$VER: SimpleGadget 1.2 (23.1.95)\r\n";
  32.  
  33.   (* Gadget defines of out choosing, to be used as GadgetID's. *)
  34.   mygadButton = 4;
  35.  
  36. VAR
  37.   Topaz80 : g.TextAttr;
  38.  
  39. (*------------------------------------*)
  40. PROCEDURE Init ();
  41.  
  42. BEGIN (* Init *)
  43.   Topaz80.name := SYS.ADR ("topaz.font");
  44.   Topaz80.ySize := 8;
  45.   Topaz80.style := {};
  46.   Topaz80.flags := {}
  47. END Init;
  48.  
  49. (*
  50. ** Standard message handling loop with GadTools message handling functions
  51. ** used (GetIMsg() and ReplyIMsg()).
  52. *)
  53. PROCEDURE ProcessWindowEvents (win : i.WindowPtr);
  54.  
  55.   VAR
  56.     imsg : i.IntuiMessagePtr;
  57.     gad : i.GadgetPtr;
  58.     terminated : BOOLEAN;
  59.     signals : SET;
  60.  
  61. BEGIN (* ProcessWindowEvents *)
  62.   terminated := FALSE;
  63.   WHILE ~terminated DO
  64.     signals := e.Wait ({win.userPort.sigBit});
  65.  
  66.     (* Use GetIMsg() and ReplyIMsg() for handling *)
  67.     (* IntuiMessages with GadTools gadgets. *)
  68.     LOOP
  69.       IF terminated THEN EXIT END;
  70.       imsg := gt.GetIMsg (win.userPort);
  71.       IF imsg = NIL THEN EXIT END;
  72.       IF imsg.class = {i.gadgetUp} THEN
  73.         gad := imsg.iAddress;
  74.         IF gad.gadgetID = mygadButton THEN
  75.           IO.WriteStr ("Button was pressed\n")
  76.         END
  77.       ELSIF imsg.class = {i.closeWindow} THEN
  78.         terminated := TRUE
  79.       ELSIF imsg.class = {i.refreshWindow} THEN
  80.         (* This handling is REQUIRED with GadTools *)
  81.         gt.BeginRefresh (win);
  82.         gt.EndRefresh (win, e.LTRUE)
  83.       END;
  84.       (* Use the toolkit message-replying function here... *)
  85.       gt.ReplyIMsg (imsg)
  86.     END;
  87.  
  88.   END;
  89. END ProcessWindowEvents;
  90.  
  91. (*
  92. ** Prepare for using GadTools, set up gadgets and open window.
  93. ** Clean up and when done or on error.
  94. *)
  95. PROCEDURE GadtoolsWindow ();
  96.  
  97.   VAR
  98.     mysc : i.ScreenPtr;
  99.     mywin : i.WindowPtr;
  100.     glist, gad : i.GadgetPtr;
  101.     ng : gt.NewGadget;
  102.     vi : gt.VisualInfo;
  103.  
  104. BEGIN (* GadtoolsWindow *)
  105.   glist := NIL;
  106.   mysc := i.LockPubScreen (e.NILSTR);
  107.   IF mysc # NIL THEN
  108.     vi := gt.GetVisualInfo (mysc, u.end);
  109.     IF vi # NIL THEN
  110.       (* GadTools gadgets require this step to be taken *)
  111.       gad := gt.CreateContext (glist);
  112.  
  113.       (* create a button gadget centered below the window title *)
  114.       ng.textAttr := SYS.ADR (Topaz80);
  115.       ng.visualInfo := vi;
  116.       ng.leftEdge := 150;
  117.       ng.topEdge := 20 + mysc.wBorTop + (mysc.font.ySize + 1);
  118.       ng.width := 100;
  119.       ng.height := 12;
  120.       ng.gadgetText := SYS.ADR ("Click Here");
  121.       ng.gadgetID := mygadButton;
  122.       ng.flags := {};
  123.       gad := gt.CreateGadget (gt.buttonKind, gad, ng, u.end);
  124.  
  125.       IF gad # NIL THEN
  126.         mywin := i.OpenWindowTagsA
  127.           ( NIL,
  128.             i.waTitle,     SYS.ADR ("GadTools Gadget Demo"),
  129.             i.waGadgets,   glist,   i.waAutoAdjust,  e.LTRUE,
  130.             i.waWidth,     400,     i.waInnerHeight, 100,
  131.             i.waDragBar,   e.LTRUE, i.waDepthGadget, e.LTRUE,
  132.             i.waActivate,  e.LTRUE, i.waCloseGadget, e.LTRUE,
  133.             i.waIDCMP,     gt.buttonIDCMP +
  134.                            {i.closeWindow, i.refreshWindow},
  135.             i.waPubScreen, mysc,
  136.             u.end );
  137.         IF mywin # NIL THEN
  138.           gt.RefreshWindow (mywin, NIL);
  139.           ProcessWindowEvents (mywin);
  140.           i.CloseWindow (mywin)
  141.         END;
  142.       END;
  143.       (* FreeGadgets() must be called after the context has been
  144.       ** created.  It does nothing if glist is NIL.
  145.       *)
  146.       gt.FreeGadgets (glist);
  147.       gt.FreeVisualInfo (vi)
  148.     END;
  149.     i.UnlockPubScreen ("", mysc)
  150.   END;
  151. END GadtoolsWindow;
  152.  
  153. BEGIN (* SimpleGadget *)
  154.   IF i.base.libNode.version >= 37 THEN
  155.     ASSERT (gt.base # NIL, 100);
  156.     Init;
  157.     GadtoolsWindow ()
  158.   END;
  159. END SimpleGadget.
  160.