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=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 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