home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 288.lha / Tiles_v2.1 / TilesInfo.mod < prev    next >
Encoding:
Modula Implementation  |  1989-09-12  |  6.0 KB  |  197 lines
  1.  
  2. IMPLEMENTATION MODULE TilesInfo;
  3.  
  4. (*
  5. This module displays a requester with some info
  6. about Tiles.
  7.  
  8. Created: 6/11/86 by Richie Bielak
  9.  
  10. Modified:
  11.  
  12. CopyRight (c) 1986, by Richie Bielak
  13.  
  14. This program may be freely distributed. But please leave
  15. my name in. Thanks... Richie.
  16.  
  17. Turned into TilesInfo by Todd Lewis in 1988.  Thanks alot, Richie!
  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. PROCEDURE ShowTilesInfo (wp : WindowPtr);
  33.   VAR succ : BOOLEAN;
  34.   BEGIN
  35.     succ := Request (InfoRequest, wp)
  36.   END ShowTilesInfo;
  37.  
  38. (* ++++ GADGET related variables ++++++ *)
  39. CONST
  40.   InfoGadWidth = 70;
  41.   InfoGadHeight = 10;
  42.   BOOLGADGET = 1H;
  43.   REQGADGET = 1000H;
  44. VAR
  45.   InfoGadText    : IntuitionText;
  46.   InfoGad        : Gadget;
  47.   InfoGadTextStr : ARRAY [0..20] OF CHAR;
  48.   InfoGadBorder  : Border;
  49.   InfoGadPairs   : ARRAY [1..10] OF INTEGER;
  50.  
  51. (* ++++++++++++++++++++++++++++++++++++ *)
  52. PROCEDURE SetUpGadget ();
  53.   BEGIN
  54.     InfoGadTextStr := "Continue";
  55.  
  56.     (* Coordinates for border of the gadget box *)
  57.     InfoGadPairs [1] := 0;    InfoGadPairs [2] := 0;
  58.     InfoGadPairs [3] := InfoGadWidth+1;    InfoGadPairs [4] := 0;
  59.     InfoGadPairs [5] := InfoGadWidth+1;
  60.     InfoGadPairs [6] := InfoGadHeight+1;
  61.     InfoGadPairs [7] := 0;    InfoGadPairs [8] := InfoGadHeight+1;
  62.     InfoGadPairs [9] := 0;    InfoGadPairs [10] := 0;
  63.  
  64.     WITH InfoGadBorder DO
  65.       LeftEdge := -1; TopEdge := -1;
  66.       FrontPen := BYTE (3); BackPen := BYTE (0);
  67.       DrawMode := BYTE (Jam1); Count := BYTE (5);
  68.       XY := ADR (InfoGadPairs); NextBorder := NULL;
  69.     END;
  70.  
  71.     WITH InfoGadText DO
  72.       FrontPen := BYTE (2); BackPen := BYTE (1);
  73.       DrawMode := BYTE (DrawingModeSet {Jam2});
  74.       LeftEdge := 1; TopEdge := 1;
  75.       ITextFont := NULL; NextText := NULL;
  76.       IText := ADR (InfoGadTextStr);
  77.     END;
  78.  
  79.     WITH InfoGad DO
  80.       NextGadget := NULL;
  81.       LeftEdge := (InfoReqWidth DIV 2) - (InfoGadWidth DIV 2);
  82.       TopEdge := InfoReqHeight - (InfoGadHeight + 5);
  83.       Width := InfoGadWidth; Height := InfoGadHeight;
  84.       Flags := GadgetFlagSet {};
  85.       Activation := ActivationFlagSet {EndGadget, RelVerify};
  86.       GadgetType := BOOLGADGET + REQGADGET;
  87.       GadgetRender := ADR (InfoGadBorder);
  88.       SelectRender := NULL;
  89.       GadgetText := ADR (InfoGadText);
  90.       MutualExclude := 0;
  91.       SpecialInfoProp := PropInfoPtr (0);
  92.       GadgetID := 0; UserData := NULL
  93.     END;
  94.   END SetUpGadget;
  95.  
  96. (* +++++++ These variables are needed for the requester's stuff +++ *)
  97. CONST
  98.   InfoReqWidth = 330;
  99.   InfoReqHeight = 140;
  100.  
  101. VAR
  102.   InfoReqBorder : Border;
  103.   InfoReqPairs  : ARRAY [1..10] OF INTEGER;
  104.   InfoReqText   : ARRAY [0..9] OF IntuitionText;
  105.  
  106.  
  107. (* ++++++++++++++++++++++++++++++++++++ *)
  108. PROCEDURE SetUpRequester ();
  109.   BEGIN
  110.     (* Set up the border stuff *)
  111.     (* Coordinates for border of the gadget box *)
  112.     InfoReqPairs [1] := 0;    InfoReqPairs [2] := 0;
  113.     InfoReqPairs [3] := InfoReqWidth-3;    InfoReqPairs [4] := 0;
  114.     InfoReqPairs [5] := InfoReqWidth-3;
  115.     InfoReqPairs [6] := InfoReqHeight-3;
  116.     InfoReqPairs [7] := 0;    InfoReqPairs [8] := InfoReqHeight-3;
  117.     InfoReqPairs [9] := 0;    InfoReqPairs [10] := 0;
  118.  
  119.     WITH InfoReqBorder DO
  120.       LeftEdge := 1; TopEdge := 1;
  121.       FrontPen := BYTE (3); BackPen := BYTE (0);
  122.       DrawMode := BYTE (Jam1); Count := BYTE (5);
  123.       XY := ADR (InfoReqPairs); NextBorder := NULL;
  124.     END;
  125.  
  126.     (* Set up the requester *)
  127.     InitRequester (InfoRequest);
  128.  
  129.     WITH InfoRequest DO
  130.       LeftEdge := 20; TopEdge := 30;
  131.       Width := InfoReqWidth; Height := InfoReqHeight;
  132.       ReqGadget := ADR (InfoGad);
  133.       ReqText := ADR (InfoReqText);
  134.       ReqBorder := ADR (InfoReqBorder);
  135.       BackFill := BYTE (1);
  136.     END;
  137.  
  138.   END SetUpRequester;
  139.  
  140. (* ++++++++++++++++++++++++++++++++++++ *)
  141. PROCEDURE SetUpRequesterText ();
  142.  
  143.   (* ++++++++++++++++++++++++++++ *)
  144.   PROCEDURE InitIText (VAR itext : IntuitionText;
  145.                        L, T : CARDINAL;
  146.        Next : ADDRESS;
  147.        VAR text : ARRAY OF CHAR);
  148.     BEGIN
  149.       WITH itext DO
  150.         FrontPen := BYTE (2); BackPen := BYTE (1);
  151.         DrawMode := BYTE (DrawingModeSet {Jam2});
  152.         LeftEdge := L; TopEdge := T;
  153.         ITextFont := NULL; NextText := Next;
  154.         IText := ADR (text);
  155.       END;
  156.     END InitIText;
  157.  
  158.   BEGIN
  159.     InitIText (InfoReqText[0], 7,  6, ADR (InfoReqText[1]),
  160.                "            Tiles!  Ver2.1            ");
  161.     InitIText (InfoReqText[1], 7, 16, ADR (InfoReqText[2]),
  162.                "  Copyright (c) 1988 - Todd M. Lewis. ");
  163.     InitIText (InfoReqText[2], 7, 24, ADR (InfoReqText[3]),
  164.                "  Parts Copyright 1986 - Richie Bielak.");
  165.     InitIText (InfoReqText[3], 7, 34, ADR (InfoReqText[4]),
  166.                "  email: utoddl@unc.bitnet            ");
  167.     InitIText (InfoReqText[4], 7, 43, ADR (InfoReqText[5]),
  168.                "         utoddl@ecsvax.uncecs.edu     ");
  169.     InitIText (InfoReqText[5], 7, 55, ADR (InfoReqText[6]),
  170.                "     (Your comments are welcome.)     ");
  171.     InitIText (InfoReqText[6], 7, 64, ADR (InfoReqText[7]),
  172.                "    TDI/Modula-2, Ver. 3.02a/4.00a    ");
  173.     InitIText (InfoReqText[7], 7, 86, ADR (InfoReqText[8]),
  174.                "  Thanks to Doug McIntyre for ideas.  ");
  175.     InitIText (InfoReqText[8], 7, 99, ADR (InfoReqText[9]),
  176.                "  Special thanks to Tamara, my wife, ");
  177.     InitIText (InfoReqText[9], 7, 108, NULL,
  178.                "  for her understanding and patience. ");
  179.   END SetUpRequesterText;
  180.  
  181. (* +++++++++++++++++++++++++++++ *)
  182. PROCEDURE InitTilesInfo ();
  183.   BEGIN
  184.     (* Initialize the Gadget that goes with the requester *)
  185.     SetUpGadget ();
  186.     (* Initialize text for the requester *)
  187.     SetUpRequesterText ();
  188.     (* Initialize the requester *)
  189.     SetUpRequester ();
  190.   END InitTilesInfo;
  191.  
  192. BEGIN
  193.   NULL := ADDRESS (0);
  194. END TilesInfo.
  195.  
  196.  
  197.