Alien Cliché: A Physics Based Shooter
A 2D game I wrote in Pascal using Assembler for the VGA graphics. You shoot missiles that are attracted by the gravity of multiple planets. It can be seen as the forerunner of Angry Birds Space, but without birds and with a background story packed with 90ies nostalgia events.
Features
- 256 color VGA graphics using Assembler code within Pascal
- Pascal code for the game logic
- Single player mode with up to 3 computer players
- AI based on Monte-Carlo simulations of possible outcomes
- Painstakingly hand drawn bitmap font
- Efficient collision detection
- Planets that can be destroyed pixel by pixel
Gameplay
Process
I just started to get the hang of using VGA and Assembler to speed things up. I finally could visualize my passion for doing simulations. With high school physics and math I hoped to be able to visualize the gravitational pull. At the time I played the game Worms a lot and also had fond memories of the similarly funny game Scorched. With this inspiration I set out to write my own Worms clone but in space with an actual physics engine.
I do not recall much of the actual process. I remember struggling with doing Monte-Carlo simulations for the computer player where the missiles would be fired in the background and not on screen to simulate the computer player considering several options and choosing the best one. The planets are sprites with one of the 256 colors available set as alpha (transparent) color. The sprites had to be altered by the exploding missiles and were designed in Photoshop and saved into my own format including my own palette of 256 colors. I relied heavily on snippets of code I found online to do the assembler part.
All-in-all the programming from start to finish lasted about a month (looking at the file dates).
Reflection
This was my major transition from text based games and standard library graphics to fast assembler-accelerated VGA graphics. The game was almost finished to a level that I could actually play it with friends and have fun, but I never gave it the podium it should have gotten.
Backstory of the game
Below is the backstory that is shown in the opening credits of the game (sic). It contains many 90ies references, many of which I picked up from watching Jay Leno late at night. It features the character Jan Null. It had no clue when writing this where that name came from, but Googling him I found out he is a famous meteorologist. I can't recall why he would have made an impact on me other than his name.
The Story.
The year is 1998.
A humongous asteroid is heading for our precious little earth. If you have seen the god knows why blockbuster movies Deep Impact and Armageddon you kinda know the story. Except now the president of the US of A wasn't so concerned with his people. He gave NASA the orders to create a hyperengine-driven spaceship to make a brand new start on a different planet. Just before Fox Mulder could discover this sceem, Mr. Clinton took off with his closest friends such as Al Gore, Ross Perot and of course Miss Jones and Lewinsky leaving Hillary and the rest of America with no clue behind.
At the same time mother russia overspied the USA and Jeltsin created a vodka-driven spacemachine. Even Saddam Hussein has prepared himself by creating a Kurd-driven apparatus in the UN-free factories. The last escapists were prince Willem-Alexander of the Netherlands and his maybe soon to became wife emily.
A few hours before impact the ships left earth to let mankind survive. Two hours later all life on earth was scorched or drowned. Because of the impact the earth started spinning, solar winds were generated and the four ships were pulled by an antigravity protonflux field which opened a temporary timespace gate. This gate changed the people inside the ships. The prince was replaced by ThePudge from Pudgcom, Clinton by Elvis, Jeltsin by Stalin and Saddam by Jan Null.
It was unfortunate that they all ended up in the same solar system and or course only one may survive even if whole planets would be destroyed.
Welcome to Alien Cliché.
Brutal in-game talk
While not shown in the gameplay video, because for some reason it did not work in the latest compiled version of the game. At some point the players would shout (in on-screen text) war cries when firing and last words when killed. The idea for this was inspired by the fantastic game Scorched. The following is the data file I found defining the battle cries of the players.
NAME
Player
WARCRY
take this...dirty worm
die in hell
here's a present to die for
i love hi explosives
see you in hell
these shootings make me cry with happiness
i aim to please
bombs away!
LASTNOTE
ok so i'm dead
life could end worse...my nails aren't pulled
does this mean i'm gonna wear wings
i see the light..o no wait it was the explosion
i'll get you next time..hmm i can't i'm dead
NAME
Elvis
WARCRY
wow momma..this is one spicy chili-dog
hey man, let's do some wibblywobbly
you're nothing but a hounddog, you
it's time for you to wiggle your hips
you should have given me those cheeseburgers man
here's the proof that i'm still alive
did you steal my glittery costume, you
hey man watch out for elvis the alien-slayer
i shoot but if i weren't that fat i'd punch
they don't call me the king for nothing, eh?
i'm getting angry when i'm not properly fed
LASTNOTE
that ain't fair man, you messed with the hair
oh man... dead again
ladies and gentlemen, elvis has left the solar system
wow man that was one hot mamma
wow man those extra hotdogs gave me sum gas
me dead doesn't mean we'all have to get mushy, eh?
i'm dead man...dead
NAME
Stalin
WARCRY
die you capitalistic schweinski
even the spot on comrad gorbatsjov's head is harder to hit
a little present from mother russia
that's what you get if you don't join the party
i'll give you a one-way ticked to siberia
here's our dogski laika with a bigga surprise for you
LASTNOTE
communism shall prevail, i'll bet my mustache on it
oh well... at least there a still a zillion statues of me
if we're all equal..why am i the only one dying here
better dead than red...no wait
NAME
Jan Null
WARCRY
touch my el nino
there gonna be sum high pressure areas near you
take this...you mousson rain
temperatures are going to rise for you
your forecast is looking flashy
LASTNOTE
is this what they call the fog of war?
it's a bright day to die
oh man.. i forecast rain on my funeral
The Code
The entire project can be downloaded as aliencliche.zip. To run it you need an old computer or a DOS emulator. Below is the main project file. I include it because it is funny to see Pascal code online and to see the bad coding conventions of a teenager.
PROGRAM Alien_Cliche;
{$R-}
{$X+}
USES dos,crt;
TYPE
font = array[1..2040] of string[8];
smfont = array[1..238] of string[4];
planet = array[0..99,0..99] of byte;
acar = record
x,y:real;
vx,vy:real;
end;
aplr = record
x,y:real;
vx,vy:real;
p:byte;
pdir:integer;
name:string[10];
hlth:shortint;
id:byte;
col:byte;
end;
point = record
d,v:real;
end;
source = record
g:real;
gx,gy,size:integer;
end;
Virtual = Array [1..64000] of byte; { The size of our Virtual Screen }
VirtPtr = ^Virtual; { Pointer to the virtual screen }
CONST
VGA=$a000;
VAR
CharSet : font;
CharSml : smfont;
times : integer;
Virscr : VirtPtr; { Our first Virtual screen }
Planscr: VirtPtr;
Planscr2: VirtPtr;
Vaddr : word; { The segment of our virtual screen}
Paddr : word;
Paddr2 : word;
Pall : array[0..255,1..3] of byte;
s : array[1..16] of source;
dot : acar;
plr : array[1..8] of aplr;
NumPlayers,pnr:byte;
simg : planet;
trace : array[1..100] of acar;
t:real;
key:char;
Crash : boolean;
f : text;
NumPlanets:byte;
i,j,x,y,bx,by: integer;
{-------------}
Procedure SetVGA;
BEGIN
asm
mov ax,0013h
int 10h
end;
END;
Procedure SetText;
BEGIN
asm
mov ax,0003h
int 10h
end;
END;
Procedure Move(var source, dest; count: word); Assembler;
asm
push ds
lds si,source {ds,si = source}
les di,dest {es,di = dest}
mov cx,count {cx = count}
mov ax,cx {ax = count}
cld
shr cx,2 {cx = count / 4}
db 66h
rep movsw {copy double words}
mov cl,al {get rest bytes}
and cl,3
rep movsb {copy rest}
pop ds
end;
Procedure Cls(Where:word;Col:byte); assembler;
asm
push es
mov cx, 32000;
mov es,[where]
xor di,di
mov al,[col]
mov ah,al
rep stosw
pop es
End;
Procedure GetPal(ColorNo : Byte; Var R,G,B : Byte);
{ This reads the values of the Red, Green and Blue values of a certain
color and returns them to you. }
Begin
Port[$3c7] := ColorNo;
R := Port[$3c9];
G := Port[$3c9];
B := Port[$3c9];
End;
Procedure SetPal(ColorNo : Byte; R,G,B : Byte);
{ This sets the Red, Green and Blue values of a certain color }
Begin
Port[$3c8] := ColorNo;
Port[$3c9] := R;
Port[$3c9] := G;
Port[$3c9] := B;
End;
Procedure WaitRetrace; Assembler;
Label
L1, L2;
Asm
Mov Dx, 3dAh
L1:
In Al, Dx
Test Al, 8
Jnz L1
L2:
In Al, Dx
Test Al, 8
Jz L2
End;
Procedure Blackout;
{ This procedure blackens the screen by setting the pallette values of
all the colors to zero. }
VAR loop1:integer;
BEGIN
WaitRetrace;
For loop1:=0 to 255 do
SetPal(loop1,0,0,0);
END;
Procedure GrabPallette;
VAR loop1:integer;
BEGIN
For loop1:=0 to 255 do
Getpal (loop1,pall[loop1,1],pall[loop1,2],pall[loop1,3]);
END;
Procedure Fadeup;
VAR loop1,loop2:integer;
Tmp : Array [1..3] of byte;
{ This is temporary storage for the values of a color }
BEGIN
For loop1:=1 to 64 do BEGIN
{ A color value for Red, green or blue is 0 to 63, so this loop only
need be executed a maximum of 64 times }
WaitRetrace;
For loop2:=0 to 255 do BEGIN
Getpal (loop2,Tmp[1],Tmp[2],Tmp[3]);
If Tmp[1]>0 then dec (Tmp[1]);
If Tmp[2]>0 then dec (Tmp[2]);
If Tmp[3]>0 then dec (Tmp[3]);
{ If the Red, Green or Blue values of color loop2 are not yet zero,
then, decrease them by one. }
SetPal(loop2,Tmp[1],Tmp[2],Tmp[3]);
{ Set the new, altered pallette color. }
END;
END;
END;
Procedure RestorePallette;
VAR loop1:integer;
BEGIN
WaitRetrace;
For loop1:=0 to 255 do
SetPal(loop1,Pall[loop1,1],Pall[loop1,2],Pall[loop1,3]);
END;
Function IntToStr(I: Longint): String;
{ Convert any integer type to a string }
var
S: string[11];
begin
Str(I, S);
IntToStr := S;
end;
Function StrToInt(text: string): integer;
{ Convert any integer type to a string }
var
i,j: integer;
begin
Val(text, i,j);
StrToInt := i;
end;
Procedure Putpixel (X,Y : Integer; Col : Byte; where:word);
begin
if(x<0) or (x>319) or (y<0) or (y>199) then {chop} else
asm
mov ax,[where] { 8 }
mov es,ax { 2 }
mov bx,[X] { 8 }
mov dx,[Y] { 8 }
mov di,bx { 2 }
mov bx, dx { 2 }
shl dx, 8 { 8 }
shl bx, 6 { 8 }
add dx, bx { 3 }
add di, dx { 3 }
mov al, [Col] { 8 }
stosb { 11 }
end;
end;
Procedure Circle (oX,oY,rad:integer;Col:Byte);
VAR deg:real;
X,Y:integer;
BEGIN
deg:=0;
repeat
X:=round(rad*COS (deg));
Y:=round(rad*sin (deg));
putpixel (x+ox,y+oy,Col,vga);
deg:=deg+0.005;
until (deg>6.4);
END;
function sgn(a:real):integer;
begin
if a>0 then sgn:=+1;
if a<0 then sgn:=-1;
if a=0 then sgn:=0;
end;
Procedure SetUpVirtual;
VAR
i:integer;
BEGIN
GetMem (VirScr,64000);
vaddr := seg (virscr^);
GetMem (PlanScr,64000);
paddr := seg (planscr^);
GetMem (PlanScr2,64000);
paddr2:= seg (planscr2^);
END;
Procedure ShutDown;
VAR
i:integer;
BEGIN
FreeMem(VirScr,64000);
FreeMem(PlanScr,64000);
FreeMem(PlanScr2,64000);
END;
Procedure Hline (x1,x2,y:word;col:byte;where:word);
{ This draws a horizontal line from x1 to x2 on line y in color col }
BEGIN
if (x2>319) then x2:=319; if (x1<0) then x1:=0;
if(x2<0) or (x1>319) or (y<0) or (y>199) then {chop} else
asm
mov ax,where
mov es,ax
mov ax,y
mov di,ax
shl ax,8
shl di,6
add di,ax
add di,x1
mov al,col
mov ah,al
mov cx,x2
sub cx,x1
shr cx,1
jnc @start
stosb
@Start :
rep stosw
end;
end;
procedure flip(source,dest:Word);
{ This copies the entire screen at "source" to destination }
begin
asm
push ds
mov ax, [Dest]
mov es, ax { ES = Segment of source }
mov ax, [Source]
mov ds, ax { DS = Segment of source }
xor si, si { SI = 0 Faster then mov si,0 }
xor di, di { DI = 0 }
mov cx, 32000
rep movsw { Repeat movsw 32000 times }
pop ds
end;
end;
{------------}
Procedure Planets;
type
xy=record
regel:array[0..319] of byte;
end;
pa=record
r,g,b:byte;
end;
pa2=array[0..255] of pa;
var
i,j : word;
p : file of pa2;
cPa:pa2;
cXy:xy;
count:integer;
f:file of xy;
key:char;
BEGIN
cls($a000,0);
assign(p, 'plan.pal');
reset(p);
read(p,cPa);
for i:=0 to 255 do setpal(i,cPa[i].r,cPa[i].g,cPa[i].b);
close(p);
assign(f,'plan.pic');
reset(f);
for j:=0 to 199 do
begin
read(f,cXy);
for i:=0 to 319 do
begin
if (cXy.regel[i]=156) then cXy.regel[i]:=0;
move(cXy.regel[i], mem[paddr : j*320+i ],1);
move(cXy.regel[i], mem[paddr2: j*320+i ],1);
end;
end;
close(f);
END;
procedure creatergbpalette;
var t:real;
c,loop:integer;
begin
t:=63/100;
for loop:=1 to 100 do setpal(loop,round(t*loop),round(t*loop),round(t*loop));
setpal(101, 30,20,0);
setpal(102, 0,30,30);
setpal(110,63,63,63); {white}
setpal(111,63,00,00); {red}
setpal(112,00,63,00); {green}
setpal(113,00,00,63); {blue}
for loop:=120 to 130 do setpal(loop,63,round(63/11*loop)-120,0); {red-yellow}
end;
Procedure InitCharSets;
VAR
f : file of font;
f2 : file of smfont;
f3 : text;
i,j : byte;
BEGIN
Assign(f,'bos20.fnt');
Reset(f);
Read(f,CharSet);
close(f);
Assign(f2,'alcl.fnt');
Reset(f2);
Read(f2,CharSml);
close(f2);
{Assign(f3,'smfont.fnt');
reset(f3);
for i:=0 to 25 do
begin
readln(f3);
for j:=1 to 6 do readln(f3,charsml[i*6+j]);
end;
close(f3);}
END;
Procedure CWrite(x,y : integer; txt :string;c1,c2 : integer);
VAR
i,j : integer;
line : string;
nr : byte;
Code : integer;
c : byte;
alfa : integer;
f : text;
BEGIN
if (x=-1) then x:=150-(round(8*length(txt)) div 2);
for alfa:=1 to length(txt) do
begin
for j:=1 to 8 do
begin
for i:=1 to 8 do
begin
val(charset[(ord(txt[alfa])-32)*8+j][i],nr,code);
if (nr=1) then c:=c1;
if (nr=2) then c:=c2;
if (nr<>0) then PutPixel(x+(alfa*8)+i,(y-1)+j,c,vaddr);
end;
end;
end;
END;
Procedure CWriteSml(x,y : integer; txt :string;c1 : integer);
VAR
i,j : integer;
line : integer;
c : byte;
alfa : integer;
BEGIN
if (x=-1) then x:=150-(round(5*length(txt)) div 2);
for alfa:=1 to length(txt) do
begin
for j:=1 to 6 do for i:=1 to 4 do
begin
line := (ord(txt[alfa])-97)*6+j;
if (txt[alfa]='0') then line:=156+j;
if (txt[alfa]='1') then line:=162+j;
if (txt[alfa]='2') then line:=168+j;
if (txt[alfa]='3') then line:=174+j;
if (txt[alfa]='4') then line:=180+j;
if (txt[alfa]='5') then line:=186+j;
if (txt[alfa]='6') then line:=192+j;
if (txt[alfa]='7') then line:=198+j;
if (txt[alfa]='8') then line:=204+j;
if (txt[alfa]='9') then line:=210+j;
if (txt[alfa]='.') then line:=216+j;
if (txt[alfa]=',') then line:=222+j;
if (strtoint(charsml[line][i])=1) then c:=c1 else c:=0;
if (y+j<200) then putpixel(x+(alfa*5)+i,y+j,c,vaddr);
end;
end;
END;
function rad(alpha:real):real; begin
rad:=(alpha/180)*pi; end;
function deg(alpha:real):real; begin
deg:=(alpha/pi)*180; end;
Function CalcDir(x,y:real;g:integer) : real;
VAR
lx,ly,c:real;
d:integer;
BEGIN
lx:=(s[g].gx-x); ly:=(s[g].gy-y);
if (lx=0) then lx:=0.000001;
if (sgn(lx)=-1) and (sgn(ly)=-1) then C:=deg(arctan(ly/lx));
if (sgn(lx)=-1) and (sgn(ly)=+1) then C:=360+deg(arctan(ly/lx));
if (sgn(lx)=+1) and (sgn(ly)=-1) then C:=180+deg(arctan(ly/lx));
if (sgn(lx)=+1) and (sgn(ly)=+1) then C:=180+deg(arctan(ly/lx));
if (sgn(lx)=-1) and (ly=0) then C:=0;
if (sgn(lx)=+1) and (ly=0) then C:=180;
CalcDir:=C;
END;
Function CalcVel(x,y:real;nr,g:integer) : real;
VAR
a,b,c,d:real;
BEGIN
d:=CalcDir(x,y,g);
if (nr=1) then
if (d<=90) or (d>=270) then C:=s[g].g else C:=-1*s[g].g;
if (nr=2) then
if (d<=180) then C:=-1*s[g].g else C:=s[g].g;
a:=(s[g].gx-x); b:=(s[g].gy-y);
d:=(a*a+b*b); if (d=0) then CalcVel:=C else CalcVel:=C/d;
END;
Procedure LoadPlanet(g:integer);
VAR
i,j:integer;
BEGIN
case g of
1: for i:= 0 to 99 do for j:=0 to 99 do move(mem[paddr:(84+j)*320+15+i],simg[i][j],1);
2: for i:= 0 to 64 do for j:=0 to 64 do move(mem[paddr:(9+j)*320+10+i],simg[i][j],1);
3: for i:= 0 to 54 do for j:=0 to 54 do move(mem[paddr:(13+j)*320+98+i],simg[i][j],1);
4: for i:= 0 to 44 do for j:=0 to 44 do move(mem[paddr:(88+j)*320+137+i],simg[i][j],1);
5: for i:= 0 to 99 do for j:=0 to 99 do move(mem[paddr:(92+j)*320+215+i],simg[i][j],1);
6: for i:= 0 to 64 do for j:=0 to 64 do move(mem[paddr:(12+j)*320+243+i],simg[i][j],1);
7: for i:= 0 to 54 do for j:=0 to 54 do move(mem[paddr:(12+j)*320+166+i],simg[i][j],1);
8: for i:= 0 to 44 do for j:=0 to 44 do move(mem[paddr:(141+j)*320+136+i],simg[i][j],1);
9: for i:= 0 to 99 do for j:=0 to 99 do move(mem[paddr2:(84+j)*320+15+i],simg[i][j],1);
10: for i:= 0 to 64 do for j:=0 to 64 do move(mem[paddr2:(9+j)*320+10+i],simg[i][j],1);
11: for i:= 0 to 54 do for j:=0 to 54 do move(mem[paddr2:(13+j)*320+98+i],simg[i][j],1);
12: for i:= 0 to 44 do for j:=0 to 44 do move(mem[paddr2:(88+j)*320+137+i],simg[i][j],1);
13: for i:= 0 to 99 do for j:=0 to 99 do move(mem[paddr2:(92+j)*320+215+i],simg[i][j],1);
14: for i:= 0 to 64 do for j:=0 to 64 do move(mem[paddr2:(12+j)*320+243+i],simg[i][j],1);
15: for i:= 0 to 54 do for j:=0 to 54 do move(mem[paddr2:(12+j)*320+166+i],simg[i][j],1);
16: for i:= 0 to 44 do for j:=0 to 44 do move(mem[paddr2:(141+j)*320+136+i],simg[i][j],1);
end;
END;
Procedure SavePlanet(g:integer);
VAR
i,j:integer;
BEGIN
case g of
1: for i:= 0 to 99 do for j:=0 to 99 do move(simg[i][j],mem[paddr:(84+j)*320+15+i],1);
2: for i:= 0 to 64 do for j:=0 to 64 do move(simg[i][j],mem[paddr:(9+j)*320+10+i],1);
3: for i:= 0 to 54 do for j:=0 to 54 do move(simg[i][j],mem[paddr:(13+j)*320+98+i],1);
4: for i:= 0 to 44 do for j:=0 to 44 do move(simg[i][j],mem[paddr:(88+j)*320+137+i],1);
5: for i:= 0 to 99 do for j:=0 to 99 do move(simg[i][j],mem[paddr:(92+j)*320+215+i],1);
6: for i:= 0 to 64 do for j:=0 to 64 do move(simg[i][j],mem[paddr:(12+j)*320+243+i],1);
7: for i:= 0 to 54 do for j:=0 to 54 do move(simg[i][j],mem[paddr:(12+j)*320+166+i],1);
8: for i:= 0 to 44 do for j:=0 to 44 do move(simg[i][j],mem[paddr:(141+j)*320+136+i],1);
9: for i:= 0 to 99 do for j:=0 to 99 do move(simg[i][j],mem[paddr2:(84+j)*320+15+i],1);
0: for i:= 0 to 64 do for j:=0 to 64 do move(simg[i][j],mem[paddr2:(9+j)*320+10+i],1);
1: for i:= 0 to 54 do for j:=0 to 54 do move(simg[i][j],mem[paddr2:(13+j)*320+98+i],1);
2: for i:= 0 to 44 do for j:=0 to 44 do move(simg[i][j],mem[paddr2:(88+j)*320+137+i],1);
3: for i:= 0 to 99 do for j:=0 to 99 do move(simg[i][j],mem[paddr2:(92+j)*320+215+i],1);
4: for i:= 0 to 64 do for j:=0 to 64 do move(simg[i][j],mem[paddr2:(12+j)*320+243+i],1);
5: for i:= 0 to 54 do for j:=0 to 54 do move(simg[i][j],mem[paddr2:(12+j)*320+166+i],1);
6: for i:= 0 to 44 do for j:=0 to 44 do move(simg[i][j],mem[paddr2:(141+j)*320+136+i],1);
end;
END;
Procedure DrawPlanet(x,y,g:integer);
VAR
i,j:integer;
BEGIN
LoadPlanet(g);
if (x+(s[g].size div 2)<0) or (x-(s[g].size div 2)>320)
or (y+(s[g].size div 2)<0) or (y-(s[g].size div 2)>200)
then {nothing}
else
begin
for i:=0 to s[g].size-1 do
for j:=0 to s[g].size-1 do
begin
if (simg[i][j]>0) then
PutPixel(x+i-(s[g].size div 2),y+j-(s[g].size div 2),simg[i][j],vaddr);
end;
end;
END;
Procedure StarryNight;
VAR
i:integer;
j:byte;
BEGIN
for i:=1 to 35 do FillChar(mem[vaddr:trunc(i*3500/cos(i))],1,random(2)+101);
END;
Procedure DrawBorder(xo,yo:integer);
VAR
i:integer;
BEGIN
if (xo<0) then for i:=0 to 199 do putpixel(-xo,i,random(101),vaddr);
if (xo>bx-320) then for i:=0 to 199 do putpixel(bx-xo,i,random(101),vaddr);
if (yo<0) then for i:=0 to 319 do putpixel(i,-yo,random(101),vaddr);
if (yo>by-200) then for i:=0 to 319 do putpixel(i,by-yo,random(101),vaddr);
END;
Procedure DrawDot;
VAR
i,j:integer;
q:integer;
xScr,yScr:integer;
BEGIN
cls(vaddr,0);
StarryNight;
xScr:=x-160;yScr:=y-100;
DrawBorder(xScr,yScr);
for q:=1 to numPlanets do DrawPlanet(s[q].gx-xScr,s[q].gy-yScr,q);
for i:=1 to 99 do PutPixel(trunc(trace[i].x-xScr),trunc(trace[i].y-yScr),100-i,vaddr);
for j:=1 to NumPlayers do for i:=0 to 5 do
hline(trunc(plr[j].x)-xScr-3,trunc(plr[j].x)-xScr+3,trunc(plr[j].y)-yScr-3+i,plr[j].col,vaddr);
flip(vaddr,vga);
END;
Procedure DrawPlr2;
VAR
i,j:integer;
q:integer;
xScr,yScr:integer;
BEGIN
cls(vaddr,0);
StarryNight;
xScr:=trunc(plr[pnr].x)-160;yScr:=trunc(plr[pnr].y)-100;
DrawBorder(xScr,yScr);
for q:=1 to numPlanets do DrawPlanet(s[q].gx-xScr,s[q].gy-yScr,q);
for j:=1 to NumPlayers do for i:=0 to 5 do
hline(trunc(plr[j].x)-xScr-3,trunc(plr[j].x)-xScr+3,trunc(plr[j].y)-yScr-3+i,plr[j].col,vaddr);
flip(vaddr,vga);
END;
Procedure DrawPlr(vel,dir:integer);
VAR
i,j:integer;
q:integer;
xScr,yScr:integer;
dx,dy:integer;
c:byte;
BEGIN
cls(vaddr,0);
StarryNight;
xScr:=trunc(plr[pnr].x)-160;yScr:=trunc(plr[pnr].y)-100;
DrawBorder(xScr,yScr);
for q:=1 to numPlanets do DrawPlanet(s[q].gx-xScr,s[q].gy-yScr,q);
for j:=1 to numPlayers do for i:=0 to 5 do
hline(trunc(plr[j].x)-xScr-3,trunc(plr[j].x)-xScr+3,trunc(plr[j].y)-yScr-3+i,plr[j].col,vaddr);
dx:=round(plr[pnr].x-xScr+cos(rad(dir))*10);dy:=round(plr[pnr].y-yScr+sin(rad(dir))*10);c:=100;
putpixel(dx,dy,c,vaddr);
for i:=0 to 12 do hline(0,319,i,250,vaddr);
CWrite( 10,2,plr[pnr].name,180,197);
Cwrite(100,2,'hlth:'+inttostr(plr[pnr].hlth)+' spd:'+inttostr(vel)+' ang:'+inttostr(dir),100,0);
flip(vaddr,vga);
END;
Procedure MoveDot;
VAR
i,j:integer;
BEGIN
{ if not Crash then}
begin
for i:=1 to numPlanets do dot.vx:=dot.vx+calcvel(dot.x,dot.y,1,i);
for i:=1 to numPlanets do dot.vy:=dot.vy+calcvel(dot.x,dot.y,2,i);
if (dot.x<0) or (dot.x>bx) then dot.vx:=-dot.vx;
if (dot.y<0) or (dot.y>by) then dot.vy:=-dot.vy;
dot.x:=dot.x-dot.vx;
dot.y:=dot.y+dot.vy;
end;
inc(times);
if (times=10) then
begin
for i:=99 downto 1 do begin trace[i+1].x:=trace[i].x; trace[i+1].y:=trace[i].y; end;
trace[1].x:=dot.x;trace[1].y:=dot.y;
times:=0;
end;
END;
Procedure MovePlr;
VAR
i,j:integer;
BEGIN
{ if not Crash then}
begin
for i:=1 to numPlanets do plr[pnr].vx:=plr[pnr].vx+4*calcvel(plr[pnr].x,plr[pnr].y,1,i);
for i:=1 to numPlanets do plr[pnr].vy:=plr[pnr].vy+4*calcvel(plr[pnr].x,plr[pnr].y,2,i);
if (plr[pnr].x<0) or (plr[pnr].x>bx) then plr[pnr].vx:=-plr[pnr].vx;
if (plr[pnr].y<0) or (plr[pnr].y>by) then plr[pnr].vy:=-plr[pnr].vy;
plr[pnr].x:=plr[pnr].x-plr[pnr].vx;
plr[pnr].y:=plr[pnr].y+plr[pnr].vy;
end;
END;
Procedure DecHealth(x,y,frc:integer);
VAR
i,j:integer;
a,b,c:real;
d:integer;
BEGIN
for i:=15 to 30+numPlayers*10 do hline(10,120,i,250,vaddr);
for i:=1 to numPlayers do
begin
a:=(plr[i].x-x); b:=(plr[i].y-y);
c:=(a*a+b*b); if (c=0) then d:=frc*4 else d:=round(frc*4/c);
if (d=0) then
begin
Cwrite(10,15+i*10,plr[i].name,110,0);
Cwrite(80,15+i*10,inttostr(plr[i].hlth),110,0);
end;
if (d>0) then
begin
plr[i].hlth:=plr[i].hlth-d*d;
Cwrite(10,15+i*10,plr[i].name,111,0);
if (plr[i].hlth>0) then Cwrite(80,15+i*10,inttostr(plr[i].hlth),111,0)
else Cwrite(80,15+i*10,'RIP',111,0);
end;
if (plr[i].hlth<0) then
begin
sound(2000);delay(1000);nosound;
for j:=i to numPlayers-1 do plr[j]:=plr[j+1];
dec(numPlayers);
end;
end;
flip(vaddr,vga);delay(5000);
END;
Procedure DoCrash(g:integer);
VAR
i,j:integer;
a,b,c,e,r:integer;
d:real;
BEGIN
for i:=0 to 10 do begin Circle(160,100,i,120+i);Delay(100);sound(i*100); end;
NoSound;
for r:=0 to 10 do
begin
d:=0;
repeat
a:=round(r*COS (d))+x-(s[g].gx)+(s[g].size div 2);
b:=round(r*sin (d))+y-(s[g].gy)+(s[g].size div 2);
d:=d+0.005;
if (a<0) or (a>s[g].size-1) then Continue;
if (b<0) or (b>s[g].size-1) then Continue;
simg[a][b]:=0;
until (d>6.4);
end;
SavePlanet(g);
END;
Procedure checkcrash;
VAR
i,j:integer;
a,b,c,d:integer;
BEGIN
if (Crash=False) then
begin
for i:=1 to numPlanets do
begin
if (dot.x>s[i].gx-(s[i].size div 2)) and (dot.xs[i].gy-(s[i].size div 2)) and (dot.y0) then
begin
Crash:=true;DoCrash(i);
end;
end;
end;
end;
END;
Procedure checkcrashplr;
VAR
i,j:integer;
a,b,c:integer;
d:real;
BEGIN
if (Crash=False) then
begin
for i:=1 to numPlanets do
begin
if (plr[pnr].x>s[i].gx-(s[i].size div 2)) and (plr[pnr].xs[i].gy-(s[i].size div 2)) and (plr[pnr].y0) then
begin
Crash:=true;
plr[pnr].p:=i;
plr[pnr].pdir:=round(CalcDir(plr[pnr].x,plr[pnr].y,i));
end;
end;
end;
end;
END;
Procedure checkcrashcmp;
VAR
i,j:integer;
a,b,c,d:integer;
BEGIN
if (Crash=False) then
begin
for i:=1 to numPlanets do
begin
if (dot.x>s[i].gx-(s[i].size div 2)) and (dot.xs[i].gy-(s[i].size div 2)) and (dot.y0) then
begin
Crash:=true;
end;
end;
end;
end;
END;
Procedure SetPosition;
VAR
j,i:integer;
fail:byte;
planet:integer;
posdeg:integer;
BEGIN
repeat
fail:=0;
begin s[1].gx:=random(bx);s[1].gy:=random(by);s[1].g:=0.8;s[1].size:=100; end;
begin s[2].gx:=random(bx);s[2].gy:=random(by);s[2].g:=0.6;s[2].size:= 65; end;
begin s[3].gx:=random(bx);s[3].gy:=random(by);s[3].g:=0.4;s[3].size:= 55; end;
begin s[4].gx:=random(bx);s[4].gy:=random(by);s[4].g:=0.2;s[4].size:= 45; end;
begin s[5].gx:=random(bx);s[5].gy:=random(by);s[5].g:=0.8;s[5].size:=100; end;
begin s[6].gx:=random(bx);s[6].gy:=random(by);s[6].g:=0.6;s[6].size:= 65; end;
begin s[7].gx:=random(bx);s[7].gy:=random(by);s[7].g:=0.4;s[7].size:= 55; end;
begin s[8].gx:=random(bx);s[8].gy:=random(by);s[8].g:=0.2;s[8].size:= 45; end;
begin s[9].gx:=random(bx);s[9].gy:=random(by);s[9].g:=0.8;s[9].size:=100; end;
begin s[10].gx:=random(bx);s[10].gy:=random(by);s[10].g:=0.6;s[10].size:= 65; end;
begin s[11].gx:=random(bx);s[11].gy:=random(by);s[11].g:=0.4;s[11].size:= 55; end;
begin s[12].gx:=random(bx);s[12].gy:=random(by);s[12].g:=0.2;s[12].size:= 45; end;
begin s[13].gx:=random(bx);s[13].gy:=random(by);s[13].g:=0.8;s[13].size:=100; end;
begin s[14].gx:=random(bx);s[14].gy:=random(by);s[14].g:=0.6;s[14].size:= 65; end;
begin s[15].gx:=random(bx);s[15].gy:=random(by);s[15].g:=0.4;s[15].size:= 55; end;
begin s[16].gx:=random(bx);s[16].gy:=random(by);s[16].g:=0.2;s[16].size:= 45; end;
for i:=1 to numPlayers do
begin
repeat
inc(fail);
if (fail=100) then break;
planet := i;
posdeg := random(360);
plr[i].x := cos(rad(posdeg)) * (s[planet].size div 2) + s[planet].gx;
plr[i].y := sin(rad(posdeg)) * (s[planet].size div 2) + s[planet].gy;
plr[i].vx := 0;
plr[i].vy := 0;
until (plr[i].x>20) and (plr[i].x20) and (plr[i].y0) then yScr:=yScr-10;
80: if (yScr+1000) then xScr:=xScr-10;
77: if (XScr+160 0) then dec(vel);
75: if (dir<359) then dir:=dir+2 else dir:=0;
77: if (dir>0) then dir:=dir-2 else dir:=359;
end;
end;
if (ord(key)=13) then
begin
v:=vel/300;
dot.vx:=-cos(rad(dir))*v; dot.vy:=sin(rad(dir))*v;
dot.x :=plr[pnr].x+cos(rad(dir))*10; dot.y :=plr[pnr].y+sin(rad(dir))*10;
Shooter;
DecHealth(x,y,100);
delay(5000);
plr[pnr].vx:=0;plr[pnr].vy:=0;
for pnr:=1 to numPlayers do FlyShip;
inc(beurt);if (beurt>numPlayers) then beurt:=1;
end;
if (ord(key)=32) then
begin
v:=vel/300;
plr[pnr].vx:=-cos(rad(dir))*v; plr[pnr].vy:=sin(rad(dir))*v;
plr[pnr].x :=plr[pnr].x+cos(rad(dir))*10; plr[pnr].y :=plr[pnr].y+sin(rad(dir))*10;
delay(5000);
FlyShip;
inc(beurt);if (beurt>numPlayers) then beurt:=1;
end;
if (ord(key)=47) then
begin
LookAround;
end;
end;
while keypressed do c:=readkey;
end;
1..100:
begin
FindRoute(plr[pnr].id);
delay(10000);
plr[pnr].vx:=0;plr[pnr].vy:=0;
for pnr:=1 to numPlayers do FlyShip;
inc(beurt);if (beurt>numPlayers) then beurt:=1;
end;
end;
until (ord(key)=27);
END;
Procedure StoryTime;
var
text: array[1..43] of string[50];
ch :char;
lines: byte;
i,j:integer;
BEGIN
lines:=42;
text[ 1]:='the story';
text[ 2]:='';
text[ 3]:='the year is 1998.';
text[ 4]:='a humongous asteroid is heading for our precious';
text[ 5]:='little earth. if you have seen the god knows why';
text[ 6]:='blockbuster movies deep impact and armageddon you';
text[ 7]:='kinda know the story. except now the president of';
text[ 8]:='the us of a wasn`t so concerned with his people.';
text[ 9]:='he gave nasa the orders to create a hyperengine';
text[10]:='driven spaceship to make a brand new start on a';
text[11]:='different planet. just before fox mulder could';
text[12]:='discover this sceem, mr clinton took off with his';
text[13]:='closest friends such as al gore, ross perot and';
text[14]:='of course miss jones and lewinsky leaving hilary';
text[15]:='and the rest of america with no clue behind.';
text[16]:='';
text[17]:='at the same time mother russia overspied the usa';
text[18]:='and jeltsin created a vodka-driven spacemachine.';
text[19]:='even saddam hussein has prepared himself by';
text[20]:='creating a kurd-driven apparatus in the un-free';
text[21]:='factories.';
text[22]:='the last escapists were prince willem-alexander';
text[23]:='of the netherlands and his maybe soon to became';
text[24]:='wife emily.';
text[25]:='';
text[26]:='a few hours before impact the ships left earth';
text[27]:='to let mankind survive. two hours later all life';
text[28]:='on earth was scorched or drowned. because of the';
text[29]:='impact the earth started spinning, solar winds';
text[30]:='were generated and the four ships were pulled by';
text[31]:='an antigravity protonflux field which opened a';
text[32]:='a temporary timespace gate. this gate changed the';
text[33]:='people inside the ships. the prince was replaced';
text[34]:='by thepudge from pudgcom, clinton by elvis,';
text[35]:='jeltsin by stalin and saddam by jan null';
text[36]:='';
text[37]:='it was unfortunate that they all ended up in the';
text[38]:='same solar system and or course only one may';
text[39]:='survive even if whole planets would be destroyed.';
text[40]:='';
text[41]:=' ,';
text[42]:='welcome to alien cliche';
for i:=200 downto -350 do
begin
cls(vaddr,0);
for j:=1 to lines do
begin
if (i+j*8<-10) then continue;
if (i+j*8>200) then continue;
cwritesml(-1,i+j*8,text[j],90);
end;
flip(vaddr,vga);delay(500);if keypressed then begin ch:=readkey; exit; end;
end;
END;
BEGIN
clrscr;
randomize;
numPlanets:=8;
numPlayers:=2;
for i:=1 to numPlayers do plr[i].hlth:=100;
plr[1].name:='ThePudge'; plr[1].id:=0; plr[1].col:=110;
plr[2].name:='Elvis'; plr[2].id:=5; plr[2].col:=112;
plr[3].name:='Stalin'; plr[3].id:=0; plr[3].col:=111;
plr[4].name:='Jan Null'; plr[4].id:=0; plr[4].col:=113;
bx:=600; by:=600;
Assign(f,'dat.pas');Rewrite(f);
InitCharSets;
SetVGA;
SetUpVirtual;
Cls(Vaddr,0);
Planets;
creatergbpalette;
SetPosition;
setpal(1,63,63,63);
StoryTime;
repeat
for pnr:=1 to numPlayers do FlyShip;
StartTurn;
halt;
{until crash;}
{if crash then DoCrash(c);}
until keypressed;
{fadeup;}
ShutDown;
SetText;
END.