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