home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / Dev / Oberon / examples.lha / Examples / Libraries / Intuition / Talk2boopsi.mod < prev    next >
Encoding:
Text File  |  1995-07-02  |  4.4 KB  |  158 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: Talk2boopsi.mod $
  4.   Description: A port of Talk2boopsi.c
  5.  
  6.                "This example creates a Boopsi prop gadget and integer
  7.                string gadget, connecting them so they update each other
  8.                when the user changes their value.  The example program
  9.                only initializes the gadgets and puts them on the window;
  10.                it doesn't have to interact with them to make them talk
  11.                to each other."
  12.  
  13.    Created by: fjc (Frank Copeland)
  14.     $Revision: 1.5 $
  15.       $Author: fjc $
  16.         $Date: 1995/01/25 23:52:19 $
  17.  
  18.   Copyright © 1994-1995, Frank Copeland.
  19.   This example program is part of Oberon-A.
  20.   See Oberon-A.doc for conditions of use and distribution.
  21.  
  22. *************************************************************************)
  23.  
  24. <* STANDARD- *>
  25.  
  26. MODULE Talk2boopsi;
  27.  
  28. IMPORT SYS := SYSTEM, Kernel, E := Exec, U := Utility, I := Intuition;
  29.  
  30. CONST
  31.   VersionTag = "$VER: Talk2boopsi 1.3 (23.1.95)";
  32.  
  33. VAR
  34.   w : I.WindowPtr;
  35.   msg : I.IntuiMessagePtr;
  36.   prop, integer : I.GadgetPtr;
  37.   prop2intmap, int2propmap : ARRAY 2 OF U.TagItem;
  38.  
  39. CONST
  40.   propGadgetID = 1;
  41.   intGadgetID = 2;
  42.   propGadgetWidth = 10;
  43.   propGadgetHeight = 80;
  44.   intGadgetHeight = 18;
  45.   visible = 10;
  46.   total = 100;
  47.   initialVal = 25;
  48.   minWindowWidth = 80;
  49.   minWindowHeight = propGadgetHeight + 70;
  50.   maxChars = 3;
  51.  
  52. (*------------------------------------*)
  53. PROCEDURE* Cleanup (VAR rc : LONGINT);
  54.  
  55. BEGIN (* Cleanup *)
  56.   IF integer # NIL THEN
  57.     SYS.PUTREG (0, I.RemoveGList (w, prop, -1));
  58.     I.DisposeObject (integer);
  59.   END;
  60.   IF prop # NIL THEN
  61.     I.DisposeObject (prop);
  62.   END;
  63.   IF w # NIL THEN
  64.     I.CloseWindow (w);
  65.   END;
  66. END Cleanup;
  67.  
  68. (*------------------------------------*)
  69. PROCEDURE Init ();
  70.  
  71. BEGIN (* Init *)
  72.   prop2intmap [0].tag := I.pgaTop;
  73.   prop2intmap [0].data := I.stringaLongVal;
  74.   prop2intmap [1].tag := U.end;
  75.   int2propmap [0].tag := I.stringaLongVal;
  76.   int2propmap [0].data := I.pgaTop;
  77.   int2propmap [1].tag := U.end;
  78.   w := NIL; prop := NIL; integer := NIL;
  79.  
  80.   Kernel.SetCleanup (Cleanup);
  81. END Init;
  82.  
  83. (*------------------------------------*)
  84. PROCEDURE Main ();
  85.  
  86.   VAR done : BOOLEAN;
  87.  
  88. BEGIN (* Main *)
  89.   done := FALSE;
  90.   (*
  91.     Open the window -- notice that the window's IDCMP port does not
  92.     listen for GADGETUP messages.
  93.   *)
  94.   w := I.OpenWindowTagsA (
  95.       NIL,
  96.       I.waFlags,     { I.windowDepth, I.windowDrag,
  97.                        I.windowClose, I.windowSizing },
  98.       I.waIDCMP,     { I.closeWindow },
  99.       I.waMinWidth,  minWindowWidth,
  100.       I.waMinHeight, minWindowHeight,
  101.       U.end );
  102.   IF w # NIL THEN
  103.     (* Create a new propgclass object *)
  104.     prop := I.NewObject ( NIL, "propgclass",
  105.         I.gaID,       propGadgetID,
  106.         I.gaTop,      w.borderTop + 5,
  107.         I.gaLeft,     w.borderLeft + 5,
  108.         I.gaWidth,    propGadgetWidth,
  109.         I.gaHeight,   propGadgetHeight,
  110.         I.icaMap,     SYS.ADR (prop2intmap),
  111.         I.pgaTotal,   total,
  112.         I.pgaTop,     initialVal,
  113.         I.pgaVisible, visible,
  114.         I.pgaNewLook, TRUE,
  115.         U.end );
  116.     IF prop # NIL THEN
  117.       (* Create the integer string gadget *)
  118.       integer := I.NewObject ( NIL, "strgclass",
  119.           I.gaID,            intGadgetID,
  120.           I.gaTop,           w.borderTop + 5,
  121.           I.gaLeft,          w.borderLeft + propGadgetWidth + 5,
  122.           I.gaWidth,         minWindowWidth -
  123.                              ( w.borderLeft + w.borderRight +
  124.                                propGadgetWidth + 15 ),
  125.           I.gaHeight,        intGadgetHeight,
  126.           I.icaMap,          SYS.ADR (int2propmap),
  127.           I.icaTarget,       prop,
  128.           I.gaPrevious,      prop,
  129.           I.stringaLongVal,  initialVal,
  130.           I.stringaMaxChars, maxChars,
  131.           U.end );
  132.       IF integer # NIL THEN
  133.         SYS.PUTREG (0, I.SetGadgetAttrs (
  134.             prop^, w, NIL,
  135.             I.icaTarget, integer,
  136.             U.end ));
  137.         SYS.PUTREG (0, I.AddGList (w, prop, -1, -1, NIL));
  138.         I.RefreshGList (prop, w, NIL, -1);
  139.         WHILE ~done DO
  140.           E.WaitPort (w.userPort);
  141.           LOOP
  142.             msg :=
  143.               SYS.VAL (I.IntuiMessagePtr, E.GetMsg (w.userPort));
  144.             IF msg = NIL THEN EXIT END;
  145.             IF msg.class = {I.closeWindow} THEN done := TRUE END;
  146.             E.ReplyMsg (msg);
  147.           END
  148.         END
  149.       END
  150.     END
  151.   END
  152. END Main;
  153.  
  154. BEGIN (* Talk2boopsi *)
  155.   Init ();
  156.   Main ();
  157. END Talk2boopsi.
  158.