home *** CD-ROM | disk | FTP | other *** search
/ Gold Fish 1 / GoldFishApril1994_CD1.img / d1xx / d174 / tunnel / tuninfo.mod < prev    next >
Encoding:
Modula Implementation  |  1989-02-04  |  5.7 KB  |  190 lines
  1. IMPLEMENTATION MODULE TunInfo;
  2.  
  3. (*
  4. This module displays a requester with some info
  5. about Tunnel.
  6.  
  7. Created: 6/11/86 by Richie Bielak
  8.  
  9. Modified: 17/2/88 by Garth Thornton
  10.           All I've done is change the message; I'd never get around to
  11.           putting this into a quick'n'easy program otherwise.
  12.  
  13. CopyRight (c) 1986, by Richie Bielak
  14.  
  15. This program may be freely distributed. But please leave
  16. my name in. Thanks... Richie.  and... Garth.
  17.  
  18. *)
  19.  
  20. FROM Intuition    IMPORT WindowPtr, IDCMPFlagSet, IntuitionText, Requester,
  21.                          RequesterFlagSet, Gadget, PropInfoPtr, GadgetFlagSet,
  22.                          ActivationFlagSet, ActivationFlags, Border;
  23. FROM Requesters   IMPORT InitRequester, Request;
  24. FROM SYSTEM       IMPORT ADR, BYTE, ADDRESS;
  25. FROM GraphicsLibrary IMPORT Jam2, Jam1, DrawingModeSet;
  26.  
  27.  
  28. VAR
  29.   NULL : ADDRESS;
  30.   InfoRequest : Requester;
  31.  
  32. (* ++++++++++++++++++++++++++++++++++++ *)
  33. PROCEDURE ShowTunInfo (wp : WindowPtr);
  34.   VAR succ : BOOLEAN;
  35.   BEGIN
  36.     succ := Request (InfoRequest, wp)
  37.   END ShowTunInfo;
  38.  
  39. (* ++++ GADGET related variables ++++++ *)
  40. CONST
  41.   InfoGadWidth = 70;
  42.   InfoGadHeight = 10;
  43.   BOOLGADGET = 1H;
  44.   REQGADGET = 1000H;
  45. VAR
  46.   InfoGadText    : IntuitionText;
  47.   InfoGad        : Gadget;
  48.   InfoGadTextStr : ARRAY [0..20] OF CHAR;
  49.   InfoGadBorder  : Border;
  50.   InfoGadPairs   : ARRAY [1..10] OF INTEGER;
  51.  
  52. (* ++++++++++++++++++++++++++++++++++++ *)
  53. PROCEDURE SetUpGadget ();
  54.   BEGIN
  55.     InfoGadTextStr := "Continue";
  56.  
  57.     (* Coordinates for border of the gadget box *)
  58.     InfoGadPairs [1] := 0;    InfoGadPairs [2] := 0;    
  59.     InfoGadPairs [3] := InfoGadWidth+1;    InfoGadPairs [4] := 0;
  60.     InfoGadPairs [5] := InfoGadWidth+1;
  61.     InfoGadPairs [6] := InfoGadHeight+1;
  62.     InfoGadPairs [7] := 0;    InfoGadPairs [8] := InfoGadHeight+1;
  63.     InfoGadPairs [9] := 0;    InfoGadPairs [10] := 0;    
  64.  
  65.     WITH InfoGadBorder DO
  66.       LeftEdge := -1; TopEdge := -1;
  67.       FrontPen := BYTE (3); BackPen := BYTE (0);
  68.       DrawMode := BYTE (Jam1); Count := BYTE (5);
  69.       XY := ADR (InfoGadPairs); NextBorder := NULL;
  70.     END;
  71.  
  72.     WITH InfoGadText DO
  73.       FrontPen := BYTE (2); BackPen := BYTE (1);
  74.       DrawMode := BYTE (DrawingModeSet {Jam2});
  75.       LeftEdge := 1; TopEdge := 1;
  76.       ITextFont := NULL; NextText := NULL;
  77.       IText := ADR (InfoGadTextStr);
  78.     END;
  79.  
  80.     WITH InfoGad DO
  81.       NextGadget := NULL;
  82.       LeftEdge := (InfoReqWidth DIV 2) - (InfoGadWidth DIV 2);
  83.       TopEdge := InfoReqHeight - (InfoGadHeight + 5);
  84.       Width := InfoGadWidth; Height := InfoGadHeight;
  85.       Flags := GadgetFlagSet {};
  86.       Activation := ActivationFlagSet {EndGadget, RelVerify};
  87.       GadgetType := BOOLGADGET + REQGADGET;
  88.       GadgetRender := ADR (InfoGadBorder);
  89.       SelectRender := NULL;
  90.       GadgetText := ADR (InfoGadText);
  91.       MutualExclude := 0;
  92.       SpecialInfoProp := PropInfoPtr (0);
  93.       GadgetID := 0; UserData := NULL
  94.     END;
  95.   END SetUpGadget;
  96.  
  97. (* +++++++ These variables are needed for the requester's stuff +++ *)
  98. CONST
  99.   InfoReqWidth = 300;
  100.   InfoReqHeight = 100;
  101.  
  102. VAR
  103.   InfoReqBorder : Border;
  104.   InfoReqPairs  : ARRAY [1..10] OF INTEGER;
  105.   InfoReqText   : ARRAY [0..5] OF IntuitionText;
  106.  
  107.   
  108. (* ++++++++++++++++++++++++++++++++++++ *)
  109. PROCEDURE SetUpRequester ();
  110.   BEGIN
  111.     (* Set up the border stuff *)
  112.     (* Coordinates for border of the gadget box *)
  113.     InfoReqPairs [1] := 0;    InfoReqPairs [2] := 0;    
  114.     InfoReqPairs [3] := InfoReqWidth-3;    InfoReqPairs [4] := 0;
  115.     InfoReqPairs [5] := InfoReqWidth-3;
  116.     InfoReqPairs [6] := InfoReqHeight-3;
  117.     InfoReqPairs [7] := 0;    InfoReqPairs [8] := InfoReqHeight-3;
  118.     InfoReqPairs [9] := 0;    InfoReqPairs [10] := 0;    
  119.  
  120.     WITH InfoReqBorder DO
  121.       LeftEdge := 1; TopEdge := 1;
  122.       FrontPen := BYTE (3); BackPen := BYTE (0);
  123.       DrawMode := BYTE (Jam1); Count := BYTE (5);
  124.       XY := ADR (InfoReqPairs); NextBorder := NULL;
  125.     END;
  126.  
  127.     (* Set up the requester *)
  128.     InitRequester (InfoRequest);
  129.  
  130.     WITH InfoRequest DO
  131.       LeftEdge := 20; TopEdge := 30;
  132.       Width := InfoReqWidth; Height := InfoReqHeight;
  133.       ReqGadget := ADR (InfoGad);
  134.       ReqText := ADR (InfoReqText);
  135.       ReqBorder := ADR (InfoReqBorder);
  136.       BackFill := BYTE (1);
  137.     END;
  138.  
  139.   END SetUpRequester;
  140.  
  141. (* ++++++++++++++++++++++++++++++++++++ *)
  142. PROCEDURE SetUpRequesterText ();
  143.  
  144.   (* ++++++++++++++++++++++++++++ *)
  145.   PROCEDURE InitIText (VAR itext : IntuitionText;
  146.                        L, T : CARDINAL;
  147.        Next : ADDRESS;
  148.        VAR text : ARRAY OF CHAR);
  149.     BEGIN
  150.       WITH itext DO
  151.         FrontPen := BYTE (2); BackPen := BYTE (1);
  152.         DrawMode := BYTE (DrawingModeSet {Jam2});
  153.         LeftEdge := L; TopEdge := T;
  154.         ITextFont := NULL; NextText := Next;
  155.         IText := ADR (text);
  156.       END;
  157.     END InitIText;
  158.  
  159.   BEGIN
  160.     InitIText (InfoReqText[0], 5, 10, ADR (InfoReqText[1]),
  161.                " This program was written using ");
  162.     InitIText (InfoReqText[1], 5, 20, ADR (InfoReqText[2]),
  163.                "        TDI/Modula-2.");
  164.     InitIText (InfoReqText[2], 5, 30, ADR (InfoReqText[3]),
  165.                "-----------------------------------");
  166.     InitIText (InfoReqText[3], 5, 40, ADR (InfoReqText[4]),
  167.                "Copyright (c) 1988 - Garth Thornton");
  168.     InitIText (InfoReqText[4], 5, 60, ADR (InfoReqText[5]),
  169.                " Wellington,  New Zealand. ");
  170.     InitIText (InfoReqText[5], 5, 70, NULL,
  171.                "It's Public Domain - UYRAF!");
  172.   END SetUpRequesterText;
  173.  
  174. (* +++++++++++++++++++++++++++++ *)
  175. PROCEDURE InitTunInfo ();
  176.   BEGIN
  177.     (* Initialize the Gadget that goes with the requester *)
  178.     SetUpGadget ();
  179.     (* Initialize text for the requester *)
  180.     SetUpRequesterText ();
  181.     (* Initialize the requester *)
  182.     SetUpRequester ();
  183.   END InitTunInfo;
  184.  
  185. BEGIN
  186.   NULL := ADDRESS (0);
  187. END TunInfo.
  188.  
  189.  
  190.