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.