Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP
Path: utzoo!mnetor!seismo!husc6!mit-eddie!genrad!decvax!ucbvax!s.cc.purdue.edu!doc
From: doc@s.cc.purdue.edu (Craig Norborg)
Newsgroups: comp.sources.amiga
Subject: Gravity Wars Source (part 1 of 2)
Message-ID: <291@s.cc.purdue.edu>
Date: Mon, 15-Jun-87 16:01:56 EDT
Article-I.D.: s.291
Posted: Mon Jun 15 16:01:56 1987
Date-Received: Sat, 27-Jun-87 06:59:44 EDT
Sender: doc@s.cc.purdue.edu
Reply-To: doc@s.cc.purdue.edu (Craig Norborg)
Distribution: world
Organization: Purdue University Computing Center
Lines: 1075
Approved: doc@j.cc.purdue.edu


    Here is part 1 of 2 to Gravity Wars.  A game written in Modula 2 by
Ed Bartz.  Note that the sources arrangement is somewhat different than
mentioned in his ReadMe file, since I found it much better to pack it
this way.  So, definition modules are mixed in with implementation
modules...  Binaries will be coming in comp.binaries.amiga
    Enjoy!
	Craig Norborg
	comp.sources.amiga moderator

#	This is a shell archive.
#	Remove everything above and including the cut line.
#	Then run the rest of the file through sh.
#----cut here-----cut here-----cut here-----cut here----#
#!/bin/sh
# Xshar: Extended Shell Archiver.
# This is part  1 out of  2.
#	Run the following text with /bin/sh to create:
#	ReadMe
#	console.def
#	gw.def
#	gw.mod
#	mywindow.def
#	mywindow.mod
#	options.def
# This archive created: Fri Jun 12 13:56:35 1987
# By: Craig Norborg (Purdue University Computing Center)
cat << \SHAR_EOF > ReadMe

	This posting contains the sources for GravityWars version 1.04.
Since I recieved many requests for them ( 4 or 5) I finally got around to
posting them. The program is written in Tdi Modula 2. File one contains the
Definition modules and file two (which is itself in two parts for mailing
purposes) contains the implementation modules.
	These sources are kind of messy I know, I don't have the time 
now to give them the reWrite and comments they require but I hope
they are of some use to you. 
        Also the title screen stuff has been removed. That stuff is a
modified version of the showILBM program that came as an example from TDI.
Although in a phone call to TDI I was told it was Ok to use the program
under certain conditions I was still uncomfortable about it. So to avoid
any problems I removed it from the sources. 
	Also these sources are NOT public domain. They are to serve only
as an example for programers (probably a bad one). They may be distributed
provided that no charge other than a small copying fee is imposed, and that
all copyright notices remain intact including this message. While 
modifications are permitted, any changes must be noted as such in the sources,
and the sources must accompany any excutable made from them if redistributed.
(In otherwords don't mess with the code and give it to some poor fool who'll
yell at me if it don't work.)
SHAR_EOF
cat << \SHAR_EOF > console.def
DEFINITION MODULE Console;

(**********************************************************************
***************           Written by Ed Bartz           ***************
***************           Copyright  5/21/87            ***************
***************    This program may be redistributed    ***************
***************    or modified as long as these         ***************
***************    notices and all other references     ***************
***************    to the author remain intack.         ***************
***************    Also this may not be used for        ***************
***************    profit by anyone without the         ***************
***************    express permission of the author.    ***************
**********************************************************************)

  FROM Ports IMPORT MsgPortPtr;
  FROM Intuition IMPORT WindowPtr;
  FROM IO IMPORT IOStdReqPtr;

TYPE
  Conport = RECORD
     IO : IOStdReqPtr;
     msg : MsgPortPtr;
     buf : ARRAY [0..80] OF CHAR;
  END;

 PROCEDURE QueueRead(VAR Rport: Conport);
        (* queue up a read request to a console, show where to
         * put the character when ready to be returned.  Most
         * efficient if this is called right after console is
         * opened *)

 PROCEDURE OpenWRConsole(VAR Wport, Rport: Conport; w : WindowPtr):BOOLEAN;
(* Open a console device *)

 PROCEDURE OpenWConsole(VAR Wport: Conport; w : WindowPtr):BOOLEAN;
(* Open a console device *)

 PROCEDURE OpenRConsole(VAR Rport: Conport; w : WindowPtr):BOOLEAN;
(* Open a console device *)

 PROCEDURE CloseWRConsole(Wport, Rport: Conport);
(* Close a console device *)

 PROCEDURE CloseWConsole(Wport : Conport);
(* Close a console device *)

 PROCEDURE CloseRConsole(Rport: Conport);
(* Close a console device *)

 PROCEDURE PutChar(Wport: Conport; c: CHAR);
(* Output a single character to a specified console *)
 
 PROCEDURE Writestr(Wport: Conport; VAR s: ARRAY OF CHAR; len: LONGINT);
(* Output a stream of known length to a console *)

 PROCEDURE PutStr(Wport: Conport; VAR s: ARRAY OF CHAR);
(* Output a NULL-terminated string of characters to a console *)

 PROCEDURE MayGetChar(VAR Rport: Conport; VAR c: CHAR): BOOLEAN;
        (* see if there is a character to read.  If none, don't wait, 
         * come back with a value of FALSE *)
 
 PROCEDURE GetChar(VAR Rport: Conport; VAR c: CHAR);
        (* go and get a character; put the task to sleep if
         * there isn't one present *)

 PROCEDURE GetStr(VAR Rport, Wport: Conport; VAR s: ARRAY OF CHAR): BOOLEAN;
        (* get string from console device *)

END Console.
SHAR_EOF
cat << \SHAR_EOF > gw.def
DEFINITION MODULE GW;


(**********************************************************************
***************           Written by Ed Bartz           ***************
***************           Copyright  5/14/87            ***************
***************    This program may be redistributed    ***************
***************    or modified as long as these         ***************
***************    notices and all other references     ***************
***************    to the author remain intack.         ***************
***************    Also this may not be used for        ***************
***************    profit by anyone without the         ***************
***************    express permission of the author.    ***************
**********************************************************************)

FROM Intuition  IMPORT WindowPtr;

    TYPE
      Pl = RECORD
       x,y,r   :INTEGER;
       color   :CARDINAL;
       m       :REAL;
      END;

      Mdata = RECORD
       P1ang,P1vel,P2ang,P2vel  :REAL;
      END;

      Shell = RECORD
        vx,vy: REAL;
        x,y : INTEGER;
      END;

      String = ARRAY [0..80] OF CHAR;

   PROCEDURE DrawPlanet(x,y,r:INTEGER;color,ptype:CARDINAL;wp:WindowPtr);

    PROCEDURE Distance(A,B :Pl): INTEGER;

PROCEDURE Pposition (VAR PlanetPos: ARRAY OF Pl;Pnum,ptype: CARDINAL; w: WindowPtr);

PROCEDURE Sposition(w: WindowPtr;VAR Ship,PPos: ARRAY OF Pl;Pnum: CARDINAL);

    PROCEDURE Stars(wp: WindowPtr);

    PROCEDURE Sexplosion(mis:Shell;wp: WindowPtr);

    PROCEDURE Pexplosion(mis:Shell;wp: WindowPtr);

    PROCEDURE DrawLine (x1,y1,x2,y2,c : CARDINAL; wp : WindowPtr);

    PROCEDURE DrawShip(x1,y1,x2,y2 : CARDINAL; wp : WindowPtr);

END GW.

SHAR_EOF
cat << \SHAR_EOF > gw.mod
IMPLEMENTATION MODULE GW;

(*+,+*)

(**********************************************************************
***************           Written by Ed Bartz           ***************
***************           Copyright  5/21/87            ***************
***************    This program may be redistributed    ***************
***************    or modified as long as these         ***************
***************    notices and all other references     ***************
***************    to the author remain intack.         ***************
***************    Also this may not be used for        ***************
***************    profit by anyone without the         ***************
***************    express permission of the author.    ***************
**********************************************************************)

FROM SYSTEM     IMPORT ADR, BYTE, ADDRESS, NULL, WORD;
FROM Areas  IMPORT AreaInfo, AreaInfoPtr, AreaEllipse, AreaEnd, InitArea;
FROM Intuition  IMPORT
     IntuitionName, IntuitionBase, Window, WindowFlags, NewWindow,
     MenuPick, IDCMPFlagSet, WindowFlagSet, WindowPtr, ScreenPtr, Screen,
     MenuEnabled, MenuFlagSet, Menu, MenuItem, IntuitionText, ActiveWindow,
     ItemFlagSet, ItemText, ItemEnabled, IntuiMessagePtr, CustomScreen ;
FROM GraphicsLibrary IMPORT GraphicsName, GraphicsBase, Jam2, Jam1,
     DrawingModeSet, BitMapPtr, BitMap, PlanePtr;
FROM Windows IMPORT OpenWindow, CloseWindow;
FROM Screens IMPORT NewScreen, OpenScreen, CloseScreen, ShowTitle;
FROM RandomNumbers IMPORT Random;
FROM MathLib0 IMPORT arctan,pi,real,entier,sin,cos,DegToRad,sqrt,power;
FROM Rasters IMPORT SetRast, RastPort, RastPortPtr, TmpRas, InitTmpRas,
     AllocRaster, FreeRaster;
FROM Views IMPORT ModeSet;
FROM Console   IMPORT
     OpenWConsole,CloseWConsole,PutChar,PutStr,GetChar,GetStr,Conport;
FROM M2Conversions IMPORT ConvertReal, ConvertToReal;
FROM Pens IMPORT Draw, Move,SetAPen,SetDrMd,ReadPixel,WritePixel;
FROM InOut IMPORT WriteLn,WriteString;
FROM MyWindow IMPORT ReadMenu;

  PROCEDURE Min (x,y :INTEGER) :INTEGER;
    BEGIN
     IF x < y THEN RETURN x;
     ELSE RETURN y;
     END;
  END Min;
(***********************************************************************)
  PROCEDURE Max (x,y :INTEGER) :INTEGER;
    BEGIN
     IF x > y THEN RETURN x;
     ELSE RETURN y;
     END;
  END Max;
(***********************************************************************)
  PROCEDURE Sdrwline(x1,x2,y1,y2: INTEGER;color: CARDINAL;wp: WindowPtr);

    VAR
      i,j,k,l,m : INTEGER;
      c1,c2 : CARDINAL;

    BEGIN
      i:= ABS(y2-y1) DIV 3;
      IF i>0 THEN
        l:=Min(y1,y2);
        j:= i + l;
        FOR m:= 0 TO 2 DO
          c2:=CARDINAL(j-l);
          FOR k:= l TO j DO
            c1:= Random(c2);
            IF c1<(CARDINAL(k-l)) THEN c1:=1;ELSE c1:=0;END;
            SetAPen (wp^.RPort,color+c1);
            WritePixel(wp^.RPort,k,x2);
            WritePixel(wp^.RPort,k,x1);
          END;
          l:=j;
          j:=j+i;
          color:= color+1;
        END;
        DrawLine(l,x2,Max(y1,y2),x2,color,wp);
        DrawLine(l,x1,Max(y1,y2),x1,color,wp);
      ELSE
        DrawLine(y1,x1,y2,x1,color,wp);
        DrawLine(y1,x2,y2,x2,color,wp);
      END;
    END Sdrwline;
  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++*)
    PROCEDURE DrawPlanet(x,y,r:INTEGER;color,ptype: CARDINAL;wp: WindowPtr);

      CONST
        round = 0.83;
        
      VAR
        r1,itr,nx,ny,x1,x2,y1,y2 :INTEGER;

      BEGIN
      IF color>3 THEN
       IF ptype = 1 THEN
         r1:=entier(real(r)*round);
         itr := r1*r1;
         FOR ny := 0 TO r1 DO
           nx:=entier(sqrt(real(itr-ny*ny))/round);
           x1:= x-nx;
           x2:= x+nx;
           y1:= y-ny;
           y2:= y+ny;
           IF x1<0 THEN x1:=0; END;
           IF y1<0 THEN y1:=0; END;
           IF x2>639 THEN x2:=639; END;
           IF y2>399 THEN y2:=399; END;
           Sdrwline(y1,y2,x1,x2,color,wp);
         END;
       ELSE
         itr := r*r;
         FOR nx := 0 TO r DO
           ny:=entier(sqrt(real(itr-nx*nx))*round);
           x1:= x-nx;
           x2:= x+nx;
           y1:= y-ny;
           y2:= y+ny;
           IF x1<0 THEN x1:=0; END;
           IF y1<0 THEN y1:=0; END;
           IF x2>639 THEN x2:=639; END;
           IF y2>399 THEN y2:=399; END;
           DrawLine(x1,y1,x1,y2,color+2,wp);
           DrawLine(x2,y1,x2,y2,color+2,wp);
         END;
       END;
     END;
       IF color<2 THEN
         itr := r*r;
         FOR nx := 0 TO r DO
           ny:=entier(sqrt(real(itr-nx*nx))*round);
           x1:= x-nx;
           x2:= x+nx;
           y1:= y-ny;
           y2:= y+ny;
           IF x1<0 THEN x1:=0; END;
           IF y1<0 THEN y1:=0; END;
           IF x2>639 THEN x2:=639; END;
           IF y2>399 THEN y2:=399; END;
           DrawLine(x1,y1,x1,y2,0,wp);
           DrawLine(x2,y1,x2,y2,0,wp);
         END;
       END;
    END DrawPlanet;
  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++*)
    PROCEDURE Distance(A,B :Pl):INTEGER;

      VAR
        i : INTEGER;
        m,l,k,n : REAL;

      BEGIN
        m:=real(ABS(A.x-B.x));
        k:=real(ABS(A.y-B.y))/0.83;
        IF m <= 0.0 THEN m:=0.01;END;
        IF k <= 0.0 THEN k:=0.01;END;
        l:=sqrt(m*m+k*k);
        i:=ABS(entier(l));

      RETURN i;
    END Distance;
  (*++++++++++++++++++++++++++++++++++++++++++++++++++++*)
 PROCEDURE Pposition (VAR PlanetPos: ARRAY OF Pl;Pnum,ptype: CARDINAL; w: WindowPtr);

    VAR
      i,j,k,Stop1,Stop2 :INTEGER;
      Ok:BOOLEAN;
      r3 : REAL;
      density : CARDINAL;
      mass : ARRAY [0..2] OF REAL;

    BEGIN
      mass[0] := 0.020;
      mass[1] := 0.025;
      mass[2] := 0.030;
      Stop1:=0;
      Stop2:=0;
      i:=0;
      WHILE i<INTEGER(Pnum) DO
        WITH PlanetPos[i] DO
          x := Random(519)+60;
          y := Random(299)+50;
          r := Random(40)+10;
        END;
        Ok:= TRUE;
        j:=i-1;
        WHILE ((j>=0)AND Ok) DO
          k:=Distance(PlanetPos[i],PlanetPos[j]);
          k:=k-PlanetPos[i].r-PlanetPos[j].r;
          IF k<20 THEN
            Ok := FALSE;
          END;
          j:=j-1;
        END;
        Stop1:= ReadMenu(w);
        IF Stop1 = 1 THEN  Stop2:= 1; END;
        IF Ok THEN
          WITH PlanetPos[i] DO
            r3:=real(r);
            r3:=r3*r3*r3;
            density:= Random(3);
            color := (density*4)+4;
            m := r3* mass[density];
            IF Random(50)>47 THEN 
              color := 0;
              m := r3* mass[2];
            END;
            IF Stop2 = 0 THEN DrawPlanet(x,y,r,color,ptype,w); END;
          END;
          i:=i+1;
        END;
      END;
    END Pposition;
  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
PROCEDURE Sposition(w: WindowPtr;VAR Ship,PPos: ARRAY OF Pl;Pnum: CARDINAL);

      VAR
        k,m     : CARDINAL;
        i,j,l   : INTEGER;
        Ok      : BOOLEAN;

      BEGIN
        FOR  k:= 0 TO 1 DO;
        Ship[k].r := 18;
          REPEAT 
            m:=k*460+40;
            Ship[k].y :=Random(300)+50;
            Ship[k].x :=Random(100)+m;
            Ok:=TRUE;
            i:=0;
            WHILE ((i<INTEGER(Pnum))AND Ok) DO
              j:=Distance(Ship[k],PPos[i]);
              IF j<PPos[i].r+40 THEN
                Ok:=FALSE;
              END;
              i:=i+1;
            END;
          UNTIL Ok;
        END;
        DrawShip(Ship[0].x,Ship[0].y,Ship[1].x,Ship[1].y,w);
    END Sposition;
  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
    PROCEDURE Stars(wp: WindowPtr);

      VAR
        i,x,y,c  : CARDINAL;

      BEGIN
       FOR i:= 0 TO 500 DO
         x :=Random(639);
         y :=Random(399);
         SetAPen(wp^.RPort,1);
         WritePixel(wp^.RPort,x,y);
       END;
    END Stars;
  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
    PROCEDURE Sexplosion(mis:Shell;wp: WindowPtr);
      VAR
        i,j,k,x,y,x1,y1 : CARDINAL;

      BEGIN
        FOR i:=0 TO 50 DO
          j:= (i DIV 5)+5;
          k:= j * 2;
          x:= (CARDINAL(mis.x) - j)+Random(k) ;
          y:= (CARDINAL(mis.y) - j)+Random(k) ;
          SetAPen(wp^.RPort,2);
          WritePixel(wp^.RPort,x,y);
        END;
        FOR i:=0 TO 500 DO
          j:= (i DIV 25)+5;
          k:= j * 2;
          x:= (CARDINAL(mis.x) - j)+Random(k) ;
          y:= (CARDINAL(mis.y) - j)+Random(k) ;
          x1:= (CARDINAL(mis.x) - 5)+Random(10) ;
          y1:= (CARDINAL(mis.y) - 5)+Random(10) ;
          k:= Random(3);
          SetAPen(wp^.RPort,0);
          WritePixel(wp^.RPort,x1,y1);
          SetAPen(wp^.RPort,k);
          WritePixel(wp^.RPort,x,y);
        END;
    END Sexplosion;
  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
    PROCEDURE Pexplosion(mis:Shell;wp: WindowPtr);
      VAR
        debry : ARRAY [0..2],[0..20] OF CARDINAL;
        i,j,k,l : CARDINAL;

      BEGIN
        l:=0;
        i:=0;
        WHILE ((l<20)AND(i<100)) DO
          j:= 10*(1+(i DIV 50)) + (l DIV 4);
          k:= j * 2;
          debry[0,l]:= (CARDINAL(mis.x) - j)+Random(k) ;
          debry[1,l]:= (CARDINAL(mis.y) - j)+Random(k) ;
          debry[2,l]:= ReadPixel(wp^.RPort,debry[0,l],debry[1,l]);
          IF debry[2,l]=0 THEN
            SetAPen(wp^.RPort,2);
            WritePixel(wp^.RPort,debry[0,l],debry[1,l]);
            l:=l+1;
          END;
          i:=i+1;
        END;
        FOR i:=0 TO l DO
          SetAPen(wp^.RPort,debry[2,i]);
          WritePixel(wp^.RPort,debry[0,i],debry[1,i]);
        END;
    END Pexplosion;
  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
    PROCEDURE DrawLine (x1,y1,x2,y2,c : CARDINAL; wp : WindowPtr);
      BEGIN
        WITH wp^ DO
          SetAPen (RPort,c); SetDrMd (RPort, Jam1);
          Move (RPort ,x1, y1);  Draw (RPort , x2, y2);
        END
    END DrawLine;

  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
    PROCEDURE DrawShip(x1,y1,x2,y2 : CARDINAL; wp : WindowPtr);

      VAR 
        n,X1,X2,Y1,Y2 : INTEGER;
        pts : ARRAY [0..42] OF INTEGER;
        xa,xb,ya,yb : CARDINAL;

      BEGIN
      X1:=CARDINAL(x1);
      X2:=CARDINAL(x2);
      Y1:=CARDINAL(y1);
      Y2:=CARDINAL(y2);
     pts[0]:=17; pts[1]:=7; pts[2]:=15; pts[3]:=17; pts[4]:=6;  pts[5]:=15;
     pts[6]:=8;  pts[7]:=5; pts[8]:=3;  pts[9]:=7; pts[10]:=4; pts[11]:=3;
     pts[12]:=6; pts[13]:=3;pts[14]:=3; pts[15]:=5;pts[16]:=2; pts[17]:=3;
     pts[18]:=8; pts[19]:=1;pts[20]:=26;pts[21]:=9;pts[22]:=0; pts[23]:=27;
     pts[24]:=0; pts[25]:=2;pts[26]:=18;pts[27]:=(-4);pts[28]:=3; pts[29]:=13;
     pts[30]:=(-4);pts[31]:=4;pts[32]:=13;pts[33]:=(-5);pts[34]:=5; pts[35]:=11;
     pts[36]:=(-6);pts[37]:=6;pts[38]:=9; pts[39]:=(-8);pts[40]:=7; pts[41]:=5;

        FOR n:= 0 TO 41 BY 3 DO
         xa:=CARDINAL(X1-pts[n]);
         ya:=CARDINAL(Y1-pts[n+1]);
         xb:=CARDINAL(X1-pts[n]+pts[n+2]);
         yb:=CARDINAL(Y1-pts[n+1]);
         DrawLine(xa,ya,xb,yb,3,wp);
         xa:=CARDINAL(X1-pts[n]);
         ya:=CARDINAL(Y1+pts[n+1]);
         xb:=CARDINAL(X1-pts[n]+pts[n+2]);
         yb:=CARDINAL(Y1+pts[n+1]);
         DrawLine(xa,ya,xb,yb,3,wp);
        END;

    pts[0]:=2; pts[1]:=7; pts[2]:=1;      pts[3]:=2; pts[4]:=6;  pts[5]:=1;
    pts[6]:=(-10); pts[7]:=1; pts[8]:=1;  pts[9]:=(-9); pts[10]:=0; pts[11]:=3;

        FOR n:= 0 TO 11 BY 3 DO
         xa:=CARDINAL(X1-pts[n]);
         ya:=CARDINAL(Y1-pts[n+1]);
         xb:=CARDINAL(X1-pts[n]+pts[n+2]);
         yb:=CARDINAL(Y1-pts[n+1]);
         DrawLine(xa,ya,xb,yb,2,wp);
         xa:=CARDINAL(X1-pts[n]);
         ya:=CARDINAL(Y1+pts[n+1]);
         xb:=CARDINAL(X1-pts[n]+pts[n+2]);
         yb:=CARDINAL(Y1+pts[n+1]);
         DrawLine(xa,ya,xb,yb,2,wp);
        END;

     pts[0]:=17; pts[1]:=7; pts[2]:=12; pts[3]:=17; pts[4]:=6;  pts[5]:=13;
     pts[6]:=14; pts[7]:=5; pts[8]:=11; pts[9]:=13; pts[10]:=4; pts[11]:=11;
     pts[12]:=12;pts[13]:=3;pts[14]:=11; pts[15]:=11;pts[16]:=2; pts[17]:=11;
     pts[18]:=12;pts[19]:=1;pts[20]:=30;pts[21]:=12;pts[22]:=0; pts[23]:=30;
     pts[24]:=(-12);pts[25]:=2;pts[26]:=5;pts[27]:=(-13);pts[28]:=3; pts[29]:=3;
     pts[30]:=(-14);pts[31]:=4;pts[32]:=1;

        FOR n:= 0 TO 32 BY 3 DO
         xa:=CARDINAL(X2+pts[n]);
         ya:=CARDINAL(Y2-pts[n+1]);
         xb:=CARDINAL(X2+pts[n]-pts[n+2]);
         yb:=CARDINAL(Y2-pts[n+1]);
         DrawLine(xa,ya,xb,yb,3,wp);
         xa:=CARDINAL(X2+pts[n]);
         ya:=CARDINAL(Y2+pts[n+1]);
         xb:=CARDINAL(X2+pts[n]-pts[n+2]);
         yb:=CARDINAL(Y2+pts[n+1]);
         DrawLine(xa,ya,xb,yb,3,wp);
        END;

        pts[0]:=18; pts[1]:=7; pts[2]:=1; pts[3]:=18; pts[4]:=6;  pts[5]:=1;
        pts[6]:=3; pts[7]:=1; pts[8]:=1;  pts[9]:=3; pts[10]:=0; pts[11]:=1;

        FOR n:= 0 TO 11 BY 3 DO
         xa:=CARDINAL(X2+pts[n]);
         ya:=CARDINAL(Y2-pts[n+1]);
         xb:=CARDINAL(X2+pts[n]-pts[n+2]);
         yb:=CARDINAL(Y2-pts[n+1]);
         DrawLine(xa,ya,xb,yb,2,wp);
         xa:=CARDINAL(X2+pts[n]);
         ya:=CARDINAL(Y2+pts[n+1]);
         xb:=CARDINAL(X2+pts[n]-pts[n+2]);
         yb:=CARDINAL(Y2+pts[n+1]);
         DrawLine(xa,ya,xb,yb,2,wp);
        END;
    END DrawShip;

END GW.

SHAR_EOF
cat << \SHAR_EOF > mywindow.def
DEFINITION MODULE MyWindow;

(**********************************************************************
***************           Written by Ed Bartz           ***************
***************           Copyright  5/21/87            ***************
***************    This program may be redistributed    ***************
***************    or modified as long as these         ***************
***************    notices and all other references     ***************
***************    to the author remain intack.         ***************
***************    Also this may not be used for        ***************
***************    profit by anyone without the         ***************
***************    express permission of the author.    ***************
**********************************************************************)

FROM Intuition  IMPORT WindowPtr, ScreenPtr, Menu, MenuItem, IntuitionText;
FROM Console   IMPORT Conport;

TYPE 
  MenuData = RECORD
     menu: ARRAY [0..5] OF Menu;
     Items: ARRAY [0..40] OF MenuItem;
     Itemtext : ARRAY [0..40] OF IntuitionText;
     Text : ARRAY [0..40],[0..80] OF CHAR;
     menuname : ARRAY [0..5],[0..80] OF CHAR;
  END;

PROCEDURE OpenLibraries () : BOOLEAN;

PROCEDURE InitScreen () : ScreenPtr;

PROCEDURE InitWindow (screen : ScreenPtr) : WindowPtr;

PROCEDURE OpenIOWin(VAR W : Conport; VAR w :WindowPtr;scn: ScreenPtr): BOOLEAN;

PROCEDURE CloseIOWin (VAR W : Conport;w :WindowPtr );

PROCEDURE InitMenu (VAR GravityWarsmenu: MenuData);

PROCEDURE SetColors (sp : ScreenPtr);

PROCEDURE ReadMenu(wp : WindowPtr): INTEGER;

PROCEDURE QueueMenu(wp : WindowPtr): BOOLEAN;

PROCEDURE ReadMouse(wp: WindowPtr;VAR x,y: CARDINAL);

END MyWindow.
SHAR_EOF
cat << \SHAR_EOF > mywindow.mod
IMPLEMENTATION MODULE MyWindow;
(*+,+*)

(**********************************************************************
***************           Written by Ed Bartz           ***************
***************           Copyright  5/21/87            ***************
***************    This program may be redistributed    ***************
***************    or modified as long as these         ***************
***************    notices and all other references     ***************
***************    to the author remain intack.         ***************
***************    Also this may not be used for        ***************
***************    profit by anyone without the         ***************
***************    express permission of the author.    ***************
**********************************************************************)

FROM Ports IMPORT ReplyMsg, WaitPort, GetMsg, MessagePtr;
FROM Colors IMPORT SetRGB4;
FROM Libraries IMPORT OpenLibrary, CloseLibrary;
FROM SYSTEM     IMPORT ADR, BYTE, ADDRESS, NULL;
FROM Intuition  IMPORT
     IntuitionName, IntuitionBase, Window, WindowFlags, NewWindow,
     MenuPick, IDCMPFlagSet, WindowFlagSet, WindowPtr, ScreenPtr,
     MenuEnabled, MenuFlagSet, Menu, MenuItem, IntuitionText, ActiveWindow,
     ItemFlagSet, ItemText, ItemEnabled, IntuiMessagePtr, CustomScreen,
     MouseButtons, SelectDown, CheckIt, MenuToggle, InactiveWindow;
FROM GraphicsLibrary IMPORT GraphicsName, GraphicsBase, Jam2, Jam1,
     DrawingModeSet;
FROM Windows IMPORT OpenWindow, CloseWindow, ModifyIDCMP;
FROM Screens IMPORT 
     NewScreenPtr, NewScreen, OpenScreen, CloseScreen, ShowTitle;
FROM Views IMPORT Lace, Hires, ModeSet;
FROM Menus IMPORT HighComp, SetMenuStrip;
FROM Text IMPORT TextAttr,Text,NormalStyle,FontFlags,FontFlagSet;
FROM Console   IMPORT OpenWConsole,CloseWConsole,Conport;


   PROCEDURE OpenLibraries () : BOOLEAN;
     BEGIN
     (* First open intuition library *)
     IntuitionBase := OpenLibrary (IntuitionName, 0);
     IF IntuitionBase = 0 THEN RETURN FALSE END;
     (* Now open the graphics library *)
     GraphicsBase := OpenLibrary (GraphicsName, 0);
     IF GraphicsBase = 0 THEN RETURN FALSE END;
     RETURN TRUE
   END OpenLibraries;
(*++++++++++++++++++++++++++++++++++++++ *)
   PROCEDURE InitScreen () : ScreenPtr;

     VAR
       s : NewScreenPtr;
       GravityWarsName : ARRAY [0..15] OF CHAR;
       FontType : ARRAY [0..15] OF CHAR;
       textattr : TextAttr;

     BEGIN
     FontType := "topaz.font";
     GravityWarsName := "GravityWars";
     WITH s^ DO
       LeftEdge := 0; TopEdge := 0;
       Width := 640; Height := 400;
       Depth := 4;
       DetailPen := BYTE (0); BlockPen := BYTE (1);
       ViewModes := ModeSet {Lace, Hires};
       Type := CustomScreen;
       Font := ADR(textattr);
       DefaultTitle := ADR (GravityWarsName);
       Gadgets := NULL;
       CustomBitMap := NULL
     END;
     WITH textattr DO
       taName :=ADR(FontType);
       taYSize := 9;
       taStyle := NormalStyle;
       taFlags := FontFlagSet{ROMFont};
     END;
     (* Now open the screen *)
     RETURN OpenScreen (s)
   END InitScreen;
(*++++++++++++++++++++++++++++++++++++++ *)
(* Initialize and open a window.         *)
  PROCEDURE InitWindow (screen : ScreenPtr) : WindowPtr;
    VAR
      w : NewWindow;

    BEGIN
      WITH w DO
        LeftEdge := 0; TopEdge := 0; Width := 640; Height := 400;
        DetailPen := BYTE (0);
        BlockPen := BYTE (1);
        Title := NULL;
        Flags := WindowFlagSet {Activate, Borderless};
        IDCMPFlags := IDCMPFlagSet {MenuPick,MouseButtons};
        Type := CustomScreen;
        CheckMark := NULL;
        FirstGadget := NULL;;
        Screen := screen;
        BitMap := NULL;
        MinWidth := 10; MinHeight := 10;
        MaxWidth := 640; MaxHeight := 400;
      END;
     (* Now open the window *)
      RETURN OpenWindow (w)
  END InitWindow;
(*++++++++++++++++++++++++++++++++++++++ *)
(* Initialize and open an IO window.  *)
PROCEDURE OpenIOWin(VAR W: Conport;VAR w :WindowPtr; scn: ScreenPtr): BOOLEAN;

    VAR
      Win     : NewWindow;
      error   : LONGINT;

    BEGIN
      WITH Win DO
        LeftEdge := 0; TopEdge := 0; Width := 640; Height := 30;
        DetailPen := BYTE (2);
        BlockPen := BYTE (1);
        Title := NULL;
        Flags := WindowFlagSet {Borderless};
        IDCMPFlags := IDCMPFlagSet {InactiveWindow};
        Type := CustomScreen;
        CheckMark := NULL;
        FirstGadget := NULL;;
        Screen := scn;
        BitMap := NULL;
        MinWidth := 639; MinHeight := 10;
        MaxWidth := 640; MaxHeight := 50;
      END;
     (* Now open the window *)
       w:=OpenWindow(Win);
     RETURN OpenWConsole(W,w);
  END OpenIOWin;
(*++++++++++++++++++++++++++++++++++++++ *)
  PROCEDURE CloseIOWin (VAR W: Conport;w :WindowPtr );

    BEGIN
        CloseWConsole(W);
        CloseWindow(w);
    END CloseIOWin;
(*++++++++++++++++++++++++++++++++++++++ *)
PROCEDURE InitMenu (VAR GravityWarsmenu: MenuData);

     PROCEDURE InitItems ();

       VAR
         i : CARDINAL;
       BEGIN
         WITH GravityWarsmenu DO
           FOR i := 0 TO 34 DO
             (* Initialize Item record fields *)
             WITH Items[i] DO
               NextItem := ADR (Items[i+1]);
               IF ((i=8) OR (i=12) OR (i=17) OR (i=22) OR (i=34)) THEN
                 NextItem := NULL
               END;
               LeftEdge := 0;
               Width := 190; Height := 10;
               Flags := ItemFlagSet {ItemText, ItemEnabled} + HighComp;
               MutualExclude := 0;
               ItemFill := ADR (Itemtext[i]);
               SelectFill := NULL; Command := BYTE (0);
               SubItem := NULL;  NextSelect := 0;
             END;
             WITH Itemtext [i] DO
               FrontPen := BYTE(0); BackPen := BYTE (1);
               DrawMode := BYTE (DrawingModeSet {Jam2});
               LeftEdge := 0; TopEdge := 1;
               ITextFont := NULL; NextText := NULL;
               IText := ADR (Text[i])
            END;
          END;
          FOR i:= 0 TO 8 DO
            Items[i].TopEdge := i* 10;
            Items[i].Width := 250;
          END;
          FOR i:= 9 TO 12 DO          
            Items[i].TopEdge := (i-9) * 10;
            Items[i].Width := 120;
          END;
          FOR i:= 13 TO 17 DO
            Items[i].TopEdge := (i-13) * 10;
            Items[i].Width := 230;
          END; 
          FOR i:= 18 TO 22 DO
            Items[i].TopEdge := (i-18) * 10;
            Items[i].Width := 130;
          END; 
          FOR i:= 23 TO 34 DO
            Items[i].TopEdge := (i-23) * 10;
          END; 
          (* Now put text into the text arrays *)
          Text[0] := "written by Ed Bartz";
          Text[1] := "with TDI Modula 2";
          Text[2] := " Version 1.04";
          Text[3] := "   Copyright March 1987";
          Text[4] := "            ";
          Text[5] := "This Program is Shareware";
          Text[6] := "Send  Donation to ";
          Text[7] := "    12 Roosevelt St.";
          Text[8] := "    SouthRiver,N.J. 08882";
          Text[9] := "Random Setup ";
          Text[10] := "Play Game";
          Text[11] := "Stop Game";
          Text[12] := "Quit";
          Text[13] := "Maximum Planets =  9";
          Text[14] := "Erase Missle Trails";
          Text[15] := "Redraw Screen";
          Text[16] := "Plain Planets";
          Text[17] := "Practice";
          Text[18] := "Move Ship";
          Text[19] := "Move Planet";
          Text[20] := "Change Planet";
          Text[21] := "Make Planet";
          Text[22] := "Delete Planet";
          Text[23] := "Velocity: 0 to 10";
          Text[24] := "         ";
          Text[25] := "Angle:   90";
          Text[26] := "         |";
          Text[27] := "   180 --+-- 0";
          Text[28] := "         |";
          Text[29] := "        270";
          Text[30] := "         ";
          Text[31] := "Planet Density:";
          Text[32] := "   Low - Red";
          Text[33] := "   Medium - Green";
          Text[34] := "   High - Blue ";
      END;
    END InitItems;

    BEGIN 
      InitItems ();
      (* Init the single menu *)
        WITH GravityWarsmenu DO
          WITH menu[0] DO
            NextMenu := ADR (menu[1]);
            LeftEdge := 3; TopEdge := 0;
            Width := 55; Height := 10;
            Flags := MenuFlagSet {MenuEnabled};
            FirstItem := ADR (Items[0]);
            MenuName := ADR (menuname[0])
          END;
          WITH menu[1] DO
            NextMenu := ADR (menu[2]);
            LeftEdge := 65; TopEdge := 0;
            Width := 44; Height := 10;
            Flags := MenuFlagSet {MenuEnabled};
            FirstItem := ADR (Items[23]);
            MenuName := ADR (menuname[1])
          END;
          WITH menu[2] DO
            NextMenu := ADR (menu[3]);
            LeftEdge := 119; TopEdge := 0;
            Width := 132; Height := 10;
            Flags := MenuFlagSet {MenuEnabled};
            FirstItem := ADR (Items[9]);
            MenuName := ADR (menuname[2])
          END;
          WITH menu[3] DO
            NextMenu := ADR (menu[4]);
            LeftEdge := 261; TopEdge := 0;
            Width := 77; Height := 10;
            Flags := MenuFlagSet {MenuEnabled};
            FirstItem := ADR (Items[13]);
            MenuName := ADR (menuname[3])
          END;
          WITH menu[4] DO
            NextMenu := NULL;
            LeftEdge := 348; TopEdge := 0;
            Width := 132; Height := 10;
            Flags := MenuFlagSet {MenuEnabled};
            FirstItem := ADR (Items[18]);
            MenuName := ADR (menuname[4])
          END;
          menuname[0] := "About";
          menuname[1] := "Help";
          menuname[2] := "Game Control";
          menuname[3] := "Options";
          menuname[4] := "Modify Setup";
              END;
  END InitMenu;
(*++++++++++++++++++++++++++++++++++++++ *)
  PROCEDURE SetColors (sp : ScreenPtr);
    BEGIN
      WITH sp^ DO
        SetRGB4 (ADR(VPort), 0, 0, 0, 0);
        SetRGB4 (ADR(VPort), 1, 15, 15, 15);
        SetRGB4 (ADR(VPort), 2, 15, 0, 0);
        SetRGB4 (ADR(VPort), 3, 8, 8, 9);
        SetRGB4 (ADR(VPort), 4, 6, 0, 0);
        SetRGB4 (ADR(VPort), 5, 9, 1, 0);
        SetRGB4 (ADR(VPort), 6, 12, 2, 0);
        SetRGB4 (ADR(VPort), 7, 15, 3, 0);
        SetRGB4 (ADR(VPort), 8, 0, 5, 0);
        SetRGB4 (ADR(VPort), 9, 1, 8, 0);
        SetRGB4 (ADR(VPort), 10, 2, 12, 0);
        SetRGB4 (ADR(VPort), 11, 7, 15, 0);
        SetRGB4 (ADR(VPort), 12, 0, 0, 6);
        SetRGB4 (ADR(VPort), 13, 0, 2, 9);
        SetRGB4 (ADR(VPort), 14, 0, 4, 12);
        SetRGB4 (ADR(VPort), 15, 0, 6, 15);
       END
   END SetColors;

  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
    PROCEDURE ReadMenu(wp : WindowPtr): INTEGER;

      CONST
        MenuNull = 0FFFFH;

      VAR
        msgptr : IntuiMessagePtr;
        code   : CARDINAL;
        class  : IDCMPFlagSet;

    (* ++++++++++++++++++++++++++++++++++++++ *)
    (* Get the item number from the number    *)
    (* gotten from the intuition message.     *)

      PROCEDURE ItemPicked (code : CARDINAL) : CARDINAL;
        TYPE
          ShortSet = SET OF [0..15];
        VAR
          menunumber,code1  : CARDINAL;

        BEGIN
          code1 := code;
          code1 := CARDINAL (ShortSet(code1) * ShortSet (0001FH));
          code := CARDINAL (ShortSet(code DIV 32) * ShortSet (003FH));
          IF (code1 = 0) THEN code:= 0;END;
          IF (code1 = 1) THEN code:= 0;END;
          IF (code1 = 2) THEN code:= code + 1;END;
          IF (code1 = 3) THEN code:= code + 5;END;
          IF (code1 = 4) THEN code:= code + 10;END;
          RETURN code
        END ItemPicked;

      BEGIN
        msgptr := GetMsg (wp^.UserPort);
        IF msgptr <> NULL THEN
          (* If message is gotten. Process it *)
          REPEAT
             class := msgptr^.Class;  code  := msgptr^.Code;
             ReplyMsg (MessagePtr(msgptr));
             msgptr := GetMsg (wp^.UserPort);
             (* If something was picked from the menu, act on it *)
             (* If not a menu event check next message *)
          UNTIL ((msgptr=NULL) OR (class = IDCMPFlagSet {MenuPick}));
             IF (class = IDCMPFlagSet {MenuPick}) AND (code <> MenuNull) THEN
               (* Figure out what item was picked *)
               RETURN ItemPicked (code);
             END
         END; (* IF msgptr <> NULL *)
      RETURN 0;
    END ReadMenu;
  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
    PROCEDURE QueueMenu(wp : WindowPtr): BOOLEAN;

      CONST
        MenuNull = 0FFFFH;

      VAR
        msgptr : IntuiMessagePtr;
        code   : CARDINAL;
        class  : IDCMPFlagSet;

      BEGIN
        msgptr := GetMsg (wp^.UserPort);
        IF msgptr <> NULL THEN
          REPEAT
             class := msgptr^.Class;  code  := msgptr^.Code;
             msgptr := GetMsg (wp^.UserPort);
          UNTIL ((msgptr=NULL) OR (class = IDCMPFlagSet {MenuPick}));
             IF (class = IDCMPFlagSet {MenuPick}) AND (code <> MenuNull) THEN
               RETURN TRUE;
             END
         END;
      RETURN FALSE;
    END QueueMenu;
  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
    PROCEDURE ReadMouse(wp: WindowPtr;VAR x,y: CARDINAL);

      VAR
        msgptr : IntuiMessagePtr;
        code : CARDINAL;
        class : IDCMPFlagSet;

      BEGIN
        REPEAT
          msgptr:= NULL;
          WHILE (msgptr=NULL) DO
            msgptr:= GetMsg(wp^.UserPort);
          END;
          class:= msgptr^.Class;
          code:= msgptr^.Code;
          x:= CARDINAL(ABS(msgptr^.MouseX));
          y:= CARDINAL(ABS(msgptr^.MouseY));
          ReplyMsg (MessagePtr(msgptr));
        UNTIL ((class=IDCMPFlagSet{MouseButtons})AND(code=SelectDown));
      END ReadMouse;
END MyWindow.
SHAR_EOF
cat << \SHAR_EOF > options.def
DEFINITION MODULE Options;

(**********************************************************************
***************           Written by Ed Bartz           ***************
***************           Copyright  5/21/87            ***************
***************    This program may be redistributed    ***************
***************    or modified as long as these         ***************
***************    notices and all other references     ***************
***************    to the author remain intack.         ***************
***************    Also this may not be used for        ***************
***************    profit by anyone without the         ***************
***************    express permission of the author.    ***************
**********************************************************************)

FROM Intuition  IMPORT  WindowPtr;
FROM GW IMPORT Pl;

PROCEDURE DeletePlanet(wp: WindowPtr;VAR pl: ARRAY OF Pl;VAR Pnum: CARDINAL);

PROCEDURE MakePlanet(wp: WindowPtr;VAR Sh,pl: ARRAY OF Pl;VAR Pnum,ptype: CARDINAL);

PROCEDURE ChangePlanet(wp: WindowPtr;VAR pl: ARRAY OF Pl;Pnum,ptype: CARDINAL);

PROCEDURE MoveShip(wp: WindowPtr;VAR Sh,pl: ARRAY OF Pl;Pnum :CARDINAL);

PROCEDURE MovePlanet(wp: WindowPtr;VAR Sh,pl: ARRAY OF Pl;Pnum,ptype :CARDINAL);

PROCEDURE CleanScreen (wp: WindowPtr;VAR Sh,pl: ARRAY OF Pl;Pnum,ptype: CARDINAL);
       
PROCEDURE IdentifyS(x,y: CARDINAL; VAR Sh: ARRAY OF Pl): CARDINAL;

END Options.
SHAR_EOF