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 2 of 2)
Message-ID: <292@s.cc.purdue.edu>
Date: Mon, 15-Jun-87 16:02:10 EDT
Article-I.D.: s.292
Posted: Mon Jun 15 16:02:10 1987
Date-Received: Sat, 27-Jun-87 07:00:48 EDT
Sender: doc@s.cc.purdue.edu
Reply-To: doc@s.cc.purdue.edu (Craig Norborg)
Distribution: world
Organization: Purdue University Computing Center
Lines: 1154
Approved: doc@j.cc.purdue.edu


#	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  2 out of  2.
#	Run the following text with /bin/sh to create:
#	console.mod
#	grav.mod
#	options.mod
# This archive created: Fri Jun 12 13:56:35 1987
# By: Craig Norborg (Purdue University Computing Center)
cat << \SHAR_EOF > console.mod
IMPLEMENTATION 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 IO IMPORT IOStdReqPtr, DoIO, SendIO, CmdRead, CmdWrite, AbortIO;
  FROM PortUtils IMPORT CreatePort,DeletePort,CreateStdIO,DeleteStdIO;
  FROM Ports IMPORT WaitPort, MsgPortPtr, MessagePtr, GetMsg;
  FROM Intuition IMPORT WindowPtr;
  FROM Devices IMPORT OpenDevice, CloseDevice;
  FROM SYSTEM IMPORT ADR, NULL;

  (*+,+*)

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 *)

        BEGIN
                Rport.IO^.ioReq.ioCommand := CmdRead;
                Rport.IO^.ioData := ADR(Rport.buf[0]);
                Rport.IO^.ioLength := 1;
                SendIO(Rport.IO^.ioReq);
        END QueueRead;

PROCEDURE OpenWRConsole(VAR Wport, Rport: Conport; w: WindowPtr):BOOLEAN;
(* Open a console device *)
         VAR
           i : INTEGER;
           error :LONGCARD;
           err : BOOLEAN;
           c : CHAR;

         BEGIN
                error:=1;
                Wport.msg := CreatePort("my.con.write",0);
                Wport.IO := CreateStdIO(Wport.msg);
                Rport.msg := CreatePort("my.con.read",0);
                Rport.IO := CreateStdIO(Rport.msg);
IF NOT((Wport.msg=NULL)OR(Wport.IO=NULL)OR(Rport.msg=NULL)OR(Rport.IO=NULL))THEN
                Wport.IO^.ioData:= w;
                Wport.IO^.ioLength := SIZE(w^);
                error := OpenDevice("console.device", 0, Wport.IO, 0);
                Rport.IO^.ioReq.ioDevice := Wport.IO^.ioReq.ioDevice;
                Rport.IO^.ioReq.ioUnit := Wport.IO^.ioReq.ioUnit;
                        (* clone required parts of the request *)
             END;
             IF error>0 THEN err:=FALSE;ELSE err:=TRUE;END;
             QueueRead(Rport);
             FOR i := 0 TO 79 DO
               Rport.buf[i]:= 0C;
               Wport.buf[i]:= 0C;
             END;
             RETURN err
         END OpenWRConsole;

PROCEDURE OpenWConsole(VAR Wport: Conport; w: WindowPtr):BOOLEAN;
(* Open a console device *)
         VAR
           i : INTEGER;
           error :LONGCARD;
           err : BOOLEAN;
           c : CHAR;

         BEGIN
                error:=1;
                Wport.msg := CreatePort("my.con.write",0);
                Wport.IO := CreateStdIO(Wport.msg);
                IF NOT((Wport.msg=NULL)OR(Wport.IO=NULL))THEN
                  Wport.IO^.ioData:= w;
                  Wport.IO^.ioLength := SIZE(w^);
                  error := OpenDevice("console.device", 0, Wport.IO, 0);
                END;
               IF error>0 THEN err:=FALSE;ELSE err:=TRUE;END;
               FOR i := 0 TO 79 DO
                 Wport.buf[i]:= 0C;
               END;
               RETURN err
         END OpenWConsole;

PROCEDURE OpenRConsole(VAR Rport: Conport; w: WindowPtr):BOOLEAN;
(* Open a console device *)
         VAR
           i : INTEGER;
           error :LONGCARD;
           err : BOOLEAN;
           c : CHAR;

         BEGIN
                error:=1;
                Rport.msg := CreatePort("my.con.read",0);
                Rport.IO := CreateStdIO(Rport.msg);
                IF NOT((Rport.msg=NULL)OR(Rport.IO=NULL))THEN
                  Rport.IO^.ioData:= w;
                  Rport.IO^.ioLength := SIZE(w^);
                  error := OpenDevice("console.device", 0, Rport.IO, 0);
                END;
                IF error>0 THEN err:=FALSE;ELSE err:=TRUE;END;
                IF err THEN QueueRead(Rport); END;
                FOR i := 0 TO 79 DO
                  Rport.buf[i]:= 0C;
                END;
                RETURN err
         END OpenRConsole;

 PROCEDURE CloseWRConsole(Wport, Rport: Conport);
 
      BEGIN
        AbortIO(Rport.IO^.ioReq);
        CloseDevice(Wport.IO);
        DeleteStdIO(Wport.IO);
        DeleteStdIO(Rport.IO);
        DeletePort(Wport.msg);
        DeletePort(Rport.msg);
      END CloseWRConsole;

 PROCEDURE CloseWConsole(Wport: Conport);
 
      BEGIN
        CloseDevice(Wport.IO);
        DeleteStdIO(Wport.IO);
        DeletePort(Wport.msg);
      END CloseWConsole;

 PROCEDURE CloseRConsole(Rport: Conport);
 
      BEGIN
        AbortIO(Rport.IO^.ioReq);
        CloseDevice(Rport.IO);
        DeleteStdIO(Rport.IO);
        DeletePort(Rport.msg);
      END CloseRConsole;

PROCEDURE PutChar(Wport: Conport; c: CHAR);
(* Output a single character to a specified console *)

        VAR
         i : LONGINT;

        BEGIN
                Wport.IO^.ioReq.ioCommand := CmdWrite;
                Wport.IO^.ioData := ADR(c);
                Wport.IO^.ioLength := 1;
                i:=DoIO(Wport.IO^.ioReq);
                (* command works because DoIO blocks until command is
                 * done (otherwise pointer to the character could become
                 * invalid in the meantime).
                 *)
        END PutChar;
 
PROCEDURE Writestr(Wport: Conport; VAR s: ARRAY OF CHAR; len: LONGINT);
(* Output a stream of known length to a console *)
        VAR
         i : LONGINT;

        BEGIN
                Wport.IO^.ioReq.ioCommand := CmdWrite;
                Wport.IO^.ioData := ADR(s);
                Wport.IO^.ioLength := len;
                i:=DoIO(Wport.IO^.ioReq);
                (* command works because DoIO blocks until command is
                 * done (otherwise pointer to string could become
                 * invalid in the meantime).
                 *)
        END Writestr;

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

        VAR
         i : LONGINT;

        BEGIN
                Wport.IO^.ioReq.ioCommand := CmdWrite;
                Wport.IO^.ioData := ADR(s);
                Wport.IO^.ioLength := MAX (LONGCARD);
                                          (* tells console to end when it
                                           * sees a terminating zero on
                                           * the string. *)
                i:=DoIO(Wport.IO^.ioReq);
        END PutStr;
        
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 *)


        BEGIN
                IF (GetMsg(Rport.msg)=MessagePtr(0))THEN RETURN FALSE;
                ELSE
                QueueRead(Rport);
                c:= Rport.buf[0];
                RETURN TRUE;
                END;
        END MayGetChar;
 
PROCEDURE GetChar(VAR Rport: Conport; VAR c: CHAR);
        (* go and get a character; put the task to sleep if
          there isn't one present *)
        VAR
          i : MessagePtr;
        BEGIN
                WHILE GetMsg(Rport.msg) = MessagePtr(0) DO
                  IF WaitPort(Rport.msg) = MessagePtr(0) THEN END;
                END;
                QueueRead(Rport);
                c:= Rport.buf[0];
        END GetChar;

PROCEDURE GetStr(VAR Rport, Wport: Conport; VAR s: ARRAY OF CHAR): BOOLEAN;
     VAR
       i,j : INTEGER;
       str : ARRAY [0..80] OF CHAR;
       c : CHAR;

     BEGIN
        i:=0;
        c:=' ';
        QueueRead(Rport);
        WHILE ((i<79)AND(c#15C)) DO
          GetChar(Rport,c);
          s[i] := c;
          IF c #15C THEN
            IF (c=10C)OR(c=177C) THEN 
              c:=10C;
              i:=i-2;
              IF i<(-1) THEN i:=(-1);END;
            END;
            i:=i+1;
            PutChar(Wport,c);
          END;
        END;
        QueueRead(Rport);
        IF i#0 THEN
          s[i]:=0C;
          RETURN TRUE;
        END;
        RETURN FALSE;
     END GetStr;

END Console.
SHAR_EOF
cat << \SHAR_EOF > grav.mod
MODULE GravityWars;
(*+,+*)

(**********************************************************************
***************           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 Title IMPORT Showpic; Title screen not included due to copyright
      problems .*)
FROM Libraries IMPORT CloseLibrary;
FROM Intuition  IMPORT
     IntuitionName, IntuitionBase, WindowPtr, ScreenPtr, Menu, Window,
     ItemFlagSet, ItemEnabled, MenuToggle, MenuItem, ItemText;
FROM Menus IMPORT SetMenuStrip, HighComp;
FROM GraphicsLibrary IMPORT GraphicsName, GraphicsBase;
FROM Windows IMPORT OpenWindow, CloseWindow;
FROM Screens IMPORT NewScreen, OpenScreen, CloseScreen, ShowTitle;
FROM RandomNumbers IMPORT Random;
FROM MathLib0 IMPORT real,entier,sin,cos,ln,exp;
FROM GW IMPORT 
     Pl, Mdata, Shell, String, DrawPlanet, Distance, Pposition,
     Sposition, Stars, Sexplosion, Pexplosion, DrawLine,
     DrawShip;
FROM MyWindow IMPORT
     OpenLibraries, InitScreen, InitWindow, OpenIOWin, CloseIOWin,
     InitMenu, SetColors, ReadMenu, MenuData, ReadMouse;
FROM Rasters IMPORT SetRast;
FROM Console IMPORT  
     OpenWConsole, CloseWConsole, PutChar, PutStr, GetChar, GetStr,
     QueueRead,  Conport, OpenRConsole, CloseRConsole, MayGetChar;
FROM M2Conversions IMPORT 
     ConvertCardinal, ConvertReal, ConvertToReal, ConvertToCardinal;
FROM Pens IMPORT SetAPen, WritePixel, ReadPixel;
FROM Options IMPORT
     DeletePlanet, MakePlanet, ChangePlanet, MovePlanet, CleanScreen,
     MoveShip,  IdentifyS;
FROM InOut IMPORT WriteInt,WriteCard;

VAR
     wp         : WindowPtr;
     IOwp       : WindowPtr;
     sp         : ScreenPtr;
     Wport,Rport : Conport;
     GravityWarsmenu  : MenuData;
     ptype,Pnum,MaxPlan : CARDINAL;
     erase      : BOOLEAN;

  PROCEDURE Game ();
    CONST
      round = 0.83;

    VAR
      playernum,color,index  : CARDINAL;
      PlanetPos : ARRAY [0..15] OF Pl;
      Ship : ARRAY [0..1] OF Pl;
      p,player : INTEGER;
      temp,Set,GameOn,Quit : BOOLEAN;
      Outmsg,Inmsg : String;
      LastShot : Mdata;
      Missle : Shell;
      c,char : CHAR;

    PROCEDURE Setup;
      BEGIN
        SetRast(wp^.RPort,0);
        Set:=TRUE;
        Pnum:= Random(MaxPlan- 4)+4;
        Stars(wp);
        Pposition(PlanetPos,Pnum,ptype,wp);
        Sposition(wp,Ship,PlanetPos,Pnum);
      END Setup;
  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
    PROCEDURE Maximum;

      VAR
        results1,results : BOOLEAN;
        str : ARRAY [0..80] OF CHAR;
 
      BEGIN
        results:=OpenIOWin(Wport,IOwp,sp);
        IF results THEN
          PutStr(Wport,"Input maximum number of planets (5 to 15) ");
          results:= GetStr(Rport,Wport,str);
          IF results THEN
            ConvertToCardinal(str,results,MaxPlan);
            IF NOT(results) THEN MaxPlan:=9; END;
          ELSE MaxPlan:=9;
          END;
          IF MaxPlan>15 THEN MaxPlan:= 15; END;
          IF MaxPlan<5 THEN MaxPlan:= 5; END;
          ConvertCardinal(MaxPlan,2,str);
          WITH GravityWarsmenu DO
            Text[13][18]:=str[0];
            Text[13][19]:=str[1];
          END;
          CloseIOWin(Wport,IOwp);
        END;
   END Maximum;
  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
    PROCEDURE ChooseSide;

      VAR
        results1,results : BOOLEAN;
        str : ARRAY [0..80] OF CHAR;
 
      BEGIN
        results:=OpenIOWin(Wport,IOwp,sp);
        IF results THEN
          PutStr(Wport,"Choose which ship to practice with (1 or 2):");
          results:= GetStr(Rport,Wport,str);
          IF results THEN
            ConvertToCardinal(str,results,playernum);
            IF playernum > 2 THEN playernum := 0; END;
          ELSE playernum := 0;
          END;
          CloseIOWin(Wport,IOwp);
        END;
   END ChooseSide;
  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
    PROCEDURE READMenu;

      VAR
        p,c : CARDINAL;

      BEGIN
         c:=0;
         c:=ReadMenu(wp);
             CASE c OF
            1: (* Setup Game *)
                Setup;                               |
            2: (* Play Game *)
                IF Set THEN
                  GameOn := TRUE;
                  FOR p := 18 TO 22 DO
                    WITH GravityWarsmenu.Items[p] DO
                      Flags:=Flags-ItemFlagSet{ItemEnabled};
                    END;
                  END;
                  WITH GravityWarsmenu.Items[9] DO
                    Flags:=Flags-ItemFlagSet{ItemEnabled};
                  END;
                END;                                 |
            3: (* Stop Game *)
                GameOn:=FALSE;
                FOR p:=18 TO 22 DO
                  WITH GravityWarsmenu.Items[p] DO
                    Flags:=ItemFlagSet{ItemText, ItemEnabled} + HighComp;
                  END;
                END;
                WITH GravityWarsmenu.Items[9] DO
                  Flags:=ItemFlagSet{ItemText, ItemEnabled} + HighComp;
                END;                                 |
            4: (* QUIT *)
                Quit:=TRUE;                          |
            5: (* Set Maximum Planets *)
                Maximum;                             |
            6:(* erase trails *)
                IF erase THEN 
                erase:= FALSE;
                GravityWarsmenu.Text[14]:="Erase Missle Trails";
                ELSE erase := TRUE;
                GravityWarsmenu.Text[14]:="Leave Missle Trails";
                END;                                 |
            7:(* Redraw screen *)
                CleanScreen(wp,Ship,PlanetPos,Pnum,ptype); |
            8:(* Change Planet Type *)
                IF ptype = 1 THEN
                  GravityWarsmenu.Text[16]:="Fancy Planets";
                  ptype := 0;
                ELSE
                  GravityWarsmenu.Text[16]:="Plain Planets";
                  ptype := 1;
                END;                                  |
            9:(* One Player/Two Player *)
                IF playernum = 0 THEN
                  ChooseSide;
                ELSE playernum := 0;
                END;   
                IF playernum = 0 THEN
                    GravityWarsmenu.Text[17]:="Practice";
                ELSE  GravityWarsmenu.Text[17]:="Compete";
                END;                                     |
            10: (* MoveShip *)
                Set:=TRUE;
                IF NOT(GameOn) THEN
                  MoveShip(wp,Ship,PlanetPos,Pnum);
                END;                                 |   
            11: (* MovePlanet *)
                Set:=TRUE;
                IF NOT(GameOn) THEN
                  MovePlanet(wp,Ship,PlanetPos,Pnum,ptype);
                END;                                 |   
            12: (*ChangePlanet*)
                Set:=TRUE;
                IF NOT(GameOn) THEN
                  ChangePlanet(wp,PlanetPos,Pnum,ptype);
                END;                                 |   
            13: (*MakePlanet*)
                Set:=TRUE;
                IF NOT(GameOn) THEN
                  MakePlanet(wp,Ship,PlanetPos,Pnum,ptype);
                END;                                 |   
            14: (*DeletePlanet*)
                Set:=TRUE;
                IF NOT(GameOn) THEN
                  DeletePlanet(wp,PlanetPos,Pnum);
                END;
             ELSE;
             END;
    END READMenu;
  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
    PROCEDURE Play;

      VAR
        ang,vel : REAL;
        p : INTEGER;
 
      BEGIN
        temp := MayGetChar(Rport,c);
        player := 1;
        WITH LastShot DO
          P1ang:=0.0;
          P1vel:=0.0;
          P2ang:=0.0;
          P2vel:=0.0;
        END;
        WHILE GameOn AND NOT(Quit) DO
          IF player=0 THEN
            player:= 1;
            ang:=LastShot.P2ang;
            vel:=LastShot.P2vel;
          ELSE
            player:=0;
            ang:=LastShot.P1ang;
            vel:=LastShot.P1vel;
          END;
          IF playernum > 0 THEN 
            player := playernum -1;
            IF player=1 THEN
              ang:=LastShot.P2ang;
              vel:=LastShot.P2vel;
            ELSE
              ang:=LastShot.P1ang;
              vel:=LastShot.P1vel;
          END;
          END;
          GetData(ang,vel,player);
          IF vel>10.0 THEN vel:=10.0; END;
          IF vel<(-10.0) THEN vel:=(-10.0); END;
          IF player=1 THEN
            LastShot.P2ang:=ang;
            LastShot.P2vel:=vel;
          ELSE
            LastShot.P1ang:=ang;
            LastShot.P1vel:=vel;
          END;
          WITH Missle DO
            vx:=vel*cos((-ang)*0.0174533);
            vy:=vel*sin(0.0174533*(-ang));
            x:=Ship[player].x;
            y:=Ship[player].y;
          END;
          READMenu;
          Launch(Missle);
          READMenu;
        END;
    END Play;
  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
    PROCEDURE Gravity(VAR mis:Shell);

      VAR
        dr3,dr,dx,dy,ax,ay : REAL;
        p,j,k : INTEGER;

      BEGIN

(* This is here to work around a bug in the console device. If the read
  device isn't read immediately it goes crazy. If you can fix it let me know
  were I went wrong. *)
        temp := MayGetChar(Rport,char);

        ax := 0.0;
        ay := 0.0;
        FOR p:= 0 TO Pnum-1 DO
          WITH PlanetPos[p] DO
            dx:=real(x-mis.x);
            dy:=real(y-mis.y);
            IF (ABS(dx)>5.0) OR (ABS(dy)>5.0) THEN
              dr:=1.5*ln(dx*dx+dy*dy);
              dr3:=exp(dr);
              ax:=ax+(m*dx)/dr3;
              ay:=ay+(m*dy)/dr3;
            END;
          END;
        END;
        WITH mis DO
          vx:=ax+vx;
          vy:=ay+vy;
          x:=entier(vx)+x;
          y:=entier(vy)+y;
        END;
    END Gravity;
  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
    PROCEDURE Launch(VAR Mis:Shell);
      VAR
       c,i,j,n : CARDINAL;
       Outside : BOOLEAN;
       oldx,oldy,x1,y1,x2,y2,k,l : INTEGER;
       eMis : Shell;

      BEGIN
        eMis:= Mis;
        Gravity (Mis);
        i:=ReadPixel(wp^.RPort,Mis.x,Mis.y);
        i:=3;
        Outside:=FALSE;
        REPEAT
          Gravity (Mis);
          IF (((Mis.x-eMis.x)>18)OR((Mis.x-eMis.x)<(-18))) THEN 
            Outside:=TRUE;
          END;
          IF (((Mis.y-eMis.y)>7)OR((Mis.y-eMis.y)<(-7))) THEN 
            Outside:=TRUE;
          END;
        UNTIL Outside;
        i:=0;
        Outside:=FALSE;
        oldx:=Mis.x;
        oldy:=Mis.y;
        WITH Mis DO
          REPEAT 
            READMenu;
            SetAPen(wp^.RPort,1);
            Gravity(Mis);
            IF (x>0)AND(x<639)AND(y>0)AND(y<398)THEN
              x1:= (x - oldx);
              y1:= (y - oldy);
              IF ABS(x1)>ABS(y1) THEN k:=ABS(2*x1);
              ELSE k:=ABS(2*y1);
              END;
              FOR l:=1 TO k DO
                x:= ((x1*l) DIV k)+oldx;
                y:= ((y1*l) DIV k)+oldy;
                n:=ReadPixel(wp^.RPort,x,y);
                IF n<3 THEN
                  WritePixel(wp^.RPort,x,y);
                ELSE 
                  i:=n;
                  x2:=x;
                  y2:=y;
                END;
              END;
            END;
           IF i>2 THEN 
             x:=x2;
             y:=y2;
           END;
           IF (x<1)THEN oldx:=1; ELSIF (x>638)THEN oldx:=638; ELSE oldx:=x; END;
           IF (y<1)THEN oldy:=1; ELSIF (y>398)THEN oldy:=398; ELSE oldy:=y; END;
            IF (x<(-320))OR(x>940)OR(y<(-200))OR(y>600)THEN
              Outside:=TRUE;
            END;
          UNTIL (Outside OR (i>2) OR NOT(GameOn) OR Quit);
        END;
        IF Outside THEN
          PutString("Missle Left The Galaxy");
        END;
        IF i>3 THEN
          Pexplosion(Mis,wp);
        END;
        IF i=3 THEN
          j:= IdentifyS(Mis.x,Mis.y,Ship);
          IF j<2 THEN 
            Sexplosion(Mis,wp);
            IF j=0 THEN
              PutString("Player 2 Wins!!!");
            ELSE
              PutString("Player 1 Wins!!!");
            END;
            FOR j:=18 TO 22 DO
              WITH GravityWarsmenu.Items[j] DO
                Flags:=ItemFlagSet{ItemText, ItemEnabled} + HighComp;
              END;
            END;
            WITH GravityWarsmenu.Items[9] DO
              Flags:=ItemFlagSet{ItemText, ItemEnabled} + HighComp;
            END;
            Set:=FALSE;
            GameOn:=FALSE;
          ELSE i:=0;
          END;
        END;
        IF erase AND NOT(i=3) THEN
          Mis:= eMis;
          Gravity (Mis);
          i:=ReadPixel(wp^.RPort,Mis.x,Mis.y);
          i:=3;
          Outside:=FALSE;
          REPEAT
            Gravity (Mis);
            IF (((Mis.x-eMis.x)>18)OR((Mis.x-eMis.x)<(-18))) THEN 
              Outside:=TRUE;
            END;
            IF (((Mis.y-eMis.y)>7)OR((Mis.y-eMis.y)<(-7))) THEN 
              Outside:=TRUE;
            END;
          UNTIL Outside;
          i:=0;
          Outside:=FALSE;
          oldx:=Mis.x;
          oldy:=Mis.y;
          WITH Mis DO
            REPEAT 
              READMenu;
              SetAPen(wp^.RPort,0);
              Gravity(Mis);
              IF (x>0)AND(x<639)AND(y>0)AND(y<398)THEN
                x1:= (x - oldx);
                y1:= (y - oldy);
                IF ABS(x1)>ABS(y1) THEN k:=ABS(2*x1);
                ELSE k:=ABS(2*y1);
                END;
                FOR l:=1 TO k DO
                  x:= ((x1*l) DIV k)+oldx;
                  y:= ((y1*l) DIV k)+oldy;
                  n:=ReadPixel(wp^.RPort,x,y);
                  IF n<3 THEN
                    WritePixel(wp^.RPort,x,y);
                  ELSE 
                    i:=n;
                    x2:=x;
                    y2:=y;
                  END;
                END;
              END;
              IF i>2 THEN 
                x:=x2;
                y:=y2;
              END;
           IF (x<1)THEN oldx:=1; ELSIF (x>638)THEN oldx:=638; ELSE oldx:=x; END;
           IF (y<1)THEN oldy:=1; ELSIF (y>398)THEN oldy:=398; ELSE oldy:=y; END;
              IF (x<(-320))OR(x>940)OR(y<(-200))OR(y>600)THEN
                Outside:=TRUE;
              END;
            UNTIL (Outside OR (i>2) OR NOT(GameOn) OR Quit);
          END;
        END;
    END Launch;
  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
    PROCEDURE PutString(msg:String);
      
      VAR
       p : LONGCARD;
       results,results1 : BOOLEAN;

      BEGIN
        results:= OpenIOWin(Wport,IOwp,sp);
        IF results THEN 
          PutStr(Wport,msg);
          FOR p := 0 TO 150000 DO;
          END;
        END;
        CloseIOWin(Wport,IOwp);
    END PutString;
  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
   PROCEDURE Newline;
     BEGIN
       PutChar(Wport,12C);
       PutChar(Wport,15C);
     END Newline;
  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
    PROCEDURE GetData(VAR ang,vel:REAL;player:INTEGER);

      VAR
        results,results1 : BOOLEAN;
        p : CARDINAL;
        String : ARRAY [0..80] OF CHAR;
        c : CHAR;

      BEGIN
        results:=OpenIOWin(Wport,IOwp,sp);
        IF results THEN
          IF player=0 THEN PutStr(Wport,"Player 1");
            ELSE PutStr(Wport,"Player 2");
          END;
          Newline;
          PutStr(Wport,"Input Firing angle [");
          ConvertReal(ang,9,6,String);
          PutStr(Wport,String);
          PutStr(Wport,"]: ");
          results:= GetStr(Rport,Wport,String);
          IF results THEN
            ConvertToReal(String,results,ang);
            IF NOT(results) THEN ang:=0.0; END;
          END;
          Newline;
          PutStr(Wport,"Input Firing Velocity [");
          ConvertReal(vel,9,6,String);
          PutStr(Wport,String);
          PutStr(Wport,"]: ");
          results:= GetStr(Rport,Wport,String);
          IF results THEN
            ConvertToReal(String,results,vel);
            IF NOT(results) THEN vel:=1.0; END;
          END;
        END;
        CloseIOWin(Wport,IOwp);
  END GetData;
  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
    BEGIN
      ShowTitle (sp,FALSE);
      Set := FALSE;
      Quit:=FALSE;
      GameOn:=FALSE;
      ptype := 1;
      playernum := 0;
      erase := FALSE;

      LOOP (***** Main GravityWars loop *****)
        temp := MayGetChar(Rport,c);
        p:=Random(700);(*Randomize*)
        READMenu;
          IF GameOn THEN
            Play;
          END;
          IF Quit THEN
            EXIT;
           END;
      END; (* LOOP *)
  END Game;
(*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)

  BEGIN
    (* This is here because, NIL <> ADDRESS (0) *)
    (* Open assorted libraries *)
     MaxPlan:= 9;
     Pnum := 0;
(* Normally the title screen routine would be called here. However since
most of that routine was the showilbm.mod program I removed it from the 
source rather than worry about copyright problems.
        Showpic('title');    *)
     IF  OpenLibraries () THEN
        (* Intialize everything else *)
        sp := InitScreen ();
        wp := InitWindow (sp);
        InitMenu (GravityWarsmenu);
        (* Attach the menu to the window *)
        SetMenuStrip (wp, GravityWarsmenu.menu[0]);
        (* Set up colors *)
        SetColors (sp);
        (* Lets Play*)
        erase := OpenRConsole(Rport,wp);        
        IF erase THEN
          Game ();
        END;
        (* Close windows etc...*)
        CloseRConsole(Rport);
        CloseWindow (wp);
        CloseScreen (sp);
        CloseLibrary (IntuitionBase);
        CloseLibrary (GraphicsBase)
      END
 END GravityWars.
SHAR_EOF
cat << \SHAR_EOF > options.mod
IMPLEMENTATION 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
     IntuitionName, IntuitionBase, WindowPtr, ScreenPtr, Menu, Window,
     ItemFlagSet, ItemEnabled, MenuToggle, MenuItem, ItemText;
FROM RandomNumbers IMPORT Random;
FROM MathLib0 IMPORT real,entier,sqrt;
FROM GW IMPORT 
       Pl, Mdata, Shell, DrawPlanet, Distance,  Stars, DrawLine,
       DrawShip;
FROM MyWindow IMPORT
       OpenIOWin, CloseIOWin, ReadMouse;
FROM Rasters IMPORT SetRast;
FROM Console IMPORT  
       OpenRConsole, CloseRConsole, PutChar, PutStr, GetChar, GetStr,
       QueueRead,  Conport;
FROM M2Conversions IMPORT 
       ConvertCardinal, ConvertReal, ConvertToReal, ConvertToCardinal;
FROM Pens IMPORT SetAPen, WritePixel, ReadPixel;

PROCEDURE DeletePlanet(wp: WindowPtr;VAR pl: ARRAY OF Pl;VAR Pnum: CARDINAL);
      VAR
        i,x,y : CARDINAL;

      BEGIN 
        ReadMouse(wp,x,y);
        i:= IdentifyP(x,y,Pnum,pl);
        DeletePlanet1(wp,pl,i,Pnum);
    END DeletePlanet;
  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
PROCEDURE MakePlanet(wp: WindowPtr;VAR Sh,pl: ARRAY OF Pl;VAR Pnum,ptype: CARDINAL);
      VAR
        ok : BOOLEAN;
        density,i,x,y : CARDINAL;
        temp : Pl;
        r3 : REAL;
        mass : ARRAY [0..2] OF REAL;

      BEGIN
        mass[0]:=0.02;
        mass[1]:=0.025;
        mass[2]:=0.03;
        ReadMouse(wp,x,y);
        i:= Pnum;
        IF i<15 THEN
          pl[i].x:=x;
          pl[i].y:=y;
          ReadMouse(wp,x,y);
          temp.x:=x;
          temp.y:=y;
          pl[i].r:= Distance(pl[i],temp); 
          IF pl[i].r>255 THEN pl[i].r :=255; END;
          r3:= real(pl[i].r);
          IF Room(pl,Sh,pl[i],Pnum,0) THEN
            r3:=r3*r3*r3;
            density:= Random(3);
            pl[i].color:= (density*4)+4;
            pl[i].m:=r3*mass[density];
            WITH pl[i] DO
              DrawPlanet(x,y,r,color,ptype,wp);
            END;
            Pnum:=i+1;
          END;
        END;
     END MakePlanet;
  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
    PROCEDURE ChangePlanet(wp: WindowPtr;VAR pl: ARRAY OF Pl;Pnum,ptype: CARDINAL);
      VAR
        c,x,y,i : CARDINAL;

      BEGIN
        ReadMouse(wp,x,y);
        i:= IdentifyP(x,y,Pnum,pl);
        c:= pl[i].color;
        IF c=4 THEN c:=8;
        ELSE IF c=8 THEN c:=12;
          ELSE IF c=12 THEN c:=4; END;
          END;
        END;
        pl[i].color:=c;
        WITH pl[i] DO
          DrawPlanet(x,y,r,color,ptype,wp);
        END;
     END ChangePlanet;
  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
    PROCEDURE MoveShip(wp: WindowPtr;VAR Sh,pl: ARRAY OF Pl;Pnum :CARDINAL);
      VAR
        x,y,i : CARDINAL;
        c : CHAR;
        ok : BOOLEAN;
        temp : Pl;

      BEGIN
        ReadMouse(wp,x,y);
        i:= IdentifyS(x,y,Sh);
        IF i< 2 THEN
          deleteship(wp,Sh[i]);
          ReadMouse(wp,x,y);
          temp.x:=x;
          temp.y:=y;
          temp.r:=Sh[i].r;
          ok:= Room(pl,Sh,temp,Pnum,(1+i));
          IF ok THEN
            Sh[i].x:= x;
            Sh[i].y:= y;
          END;
          DrawShip(Sh[0].x,Sh[0].y,Sh[1].x,Sh[1].y,wp);
        END;
      END MoveShip;
  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
      PROCEDURE deleteship(wp: WindowPtr; p: Pl);
        CONST
          round = 0.83;

        VAR
          i,j,k,itr,nx,ny,x1,x2,y1,y2 : INTEGER;

        BEGIN
          WITH p DO
            FOR ny:=0 TO 7 DO
              x1:=x-18;
              x2:=x+18;
              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,x2,y1,0,wp);
              DrawLine(x1,y2,x2,y2,0,wp);
            END;
            SetAPen(wp^.RPort,1);
            FOR i:= 0 TO 3 DO
              j:= INTEGER(Random(36))-18;
              k:= INTEGER(Random(14))-7;
              itr:= ReadPixel(wp^.RPort,x+j,y+k);
              IF itr=0 THEN
                WritePixel(wp^.RPort,x+j,y+k);
              END;
            END;
          END;
        END deleteship;
  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
PROCEDURE MovePlanet(wp: WindowPtr;VAR Sh,pl: ARRAY OF Pl;Pnum,ptype :CARDINAL);
      VAR
        x,y,i : CARDINAL;
        temp,temp1 : Pl;
        ok : BOOLEAN;

      BEGIN
        ReadMouse(wp,x,y);
        i:= IdentifyP(x,y,Pnum,pl);
        temp1.x:= pl[i].x;
        temp1.y:= pl[i].y;
        temp1.r:= pl[i].r;
        temp1.color:= pl[i].color;
        temp1.m:= pl[i].m;
        DeletePlanet1(wp,pl,i,Pnum);
        ReadMouse(wp,x,y);
        temp.x:=x;
        temp.y:=y;
        temp.r:=temp1.r;
        ok:= Room(pl,Sh,temp,Pnum,0);
        IF ok THEN 
          pl[Pnum].x:= x;
          pl[Pnum].y:= y;
        ELSE
          pl[Pnum].x:=temp1.x;
          pl[Pnum].y:=temp1.y;
        END;
          pl[Pnum].r:=temp1.r;
          pl[Pnum].m:=temp1.m;
          pl[Pnum].color:=temp1.color;
        WITH pl[Pnum] DO
          DrawPlanet(x,y,r,color,ptype,wp);
        END;
        Pnum:=Pnum+1;
      END MovePlanet;
  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
 PROCEDURE DeletePlanet1(wp: WindowPtr;VAR p: ARRAY OF Pl;VAR l,Pnum:CARDINAL);

        CONST
          round = 0.83;

        VAR
          i,j,k,itr,nx,ny : INTEGER;

        BEGIN
          IF Pnum#0 THEN
            WITH p[l] DO
              DrawPlanet(x,y,r,1,0,wp);
              SetAPen(wp^.RPort,1);
              FOR i:= 0 TO (r DIV 5) DO
                j:= INTEGER(Random(2*r))-r;
                k:= INTEGER(Random(2*r))-r;
                itr:= ReadPixel(wp^.RPort,x+j,y+k);
                IF itr=0 THEN
                  WritePixel(wp^.RPort,x+j,y+k);
                END;
              END;
            END;
            Pnum:= Pnum-1;
            FOR i:= l TO Pnum-1 DO
              p[i].x:= p[i+1].x;
              p[i].y:= p[i+1].y;
              p[i].r:= p[i+1].r;
              p[i].m:= p[i+1].m;
              p[i].color:= p[i+1].color;
            END;
          END;
        END DeletePlanet1;
  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
PROCEDURE CleanScreen (wp: WindowPtr;VAR Sh,pl: ARRAY OF Pl;Pnum,ptype: CARDINAL);
       
       VAR
         i : CARDINAL;
          
       BEGIN
         SetRast(wp^.RPort,0);
         Stars(wp);
         DrawShip(Sh[0].x,Sh[0].y,Sh[1].x,Sh[1].y,wp);
         WHILE (Pnum>0) DO
           Pnum:= Pnum-1;
           WITH pl[Pnum] DO
             DrawPlanet(x,y,r,color,ptype,wp);
           END;
         END;
       END CleanScreen;
  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
 PROCEDURE IdentifyP(x,y,Pnum: CARDINAL; VAR pl: ARRAY OF Pl): CARDINAL;
         VAR
           j,l : INTEGER;
           Mouse : Pl;
           i,k : CARDINAL;

         BEGIN
           Mouse.x := INTEGER(x);
           Mouse.y := INTEGER(y);
           j:= 10000;
           k:= 100;
           FOR i:= 0 TO (Pnum-1) DO
             l:=Distance(Mouse,pl[i]);
             IF j > ABS(l) THEN
               k:= i;
               j:= ABS(l);
             END;
           END;
           RETURN k;
        END IdentifyP;
  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
 PROCEDURE IdentifyS(x,y: CARDINAL; VAR Sh: ARRAY OF Pl): CARDINAL;
         VAR
           j,l : INTEGER;
           Mouse : Pl;
           i,k : CARDINAL;

         BEGIN
           Mouse.x := INTEGER(x);
           Mouse.y := INTEGER(y);
           j:= 10000;
           k:= 100;
           FOR i:= 0 TO 1 DO
             l:=Distance(Mouse,Sh[i]);
             IF j > ABS(l) THEN
               k:= i;
               j:= ABS(l);
             END;
           END;
           IF j<50 THEN
             RETURN k;
           ELSE 
             RETURN 2;
           END;
        END IdentifyS;
  (*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++*)
PROCEDURE Room(VAR Pln,Sh: ARRAY OF Pl;new: Pl;Pn,sh: CARDINAL): BOOLEAN;
       VAR
         i,k : INTEGER;
         ok : BOOLEAN;

       BEGIN
         ok:=TRUE;
         FOR k:=0 TO (Pn-1) DO
           i:= Distance(Pln[k],new);
           IF (i<(Pln[k].r+new.r)) THEN ok:=FALSE;END;
         END;
         IF sh<1 THEN
           FOR k:=0 TO 1 DO
             i:= Distance(Sh[k],new);
             IF (i<(Sh[k].r+new.r)) THEN ok:=FALSE;END;
           END;
         ELSE
         i:= Distance(Sh[1-(sh-1)],new);
         IF (i<(Sh[1-(sh-1)].r+new.r)) THEN ok:=FALSE;END;
         END;
       RETURN ok;
     END Room;

 END Options.
SHAR_EOF