PROGRAM worm_war (INPUT, OUTPUT);
USES CRT,graph;
type
graphics=record
A:array[1..70,1..70,1..9] of boolean;
{ Surname:array[1..315,1..33] of boolean;}
end;
VAR invisi,teleport,sides,obstacles,beam,bouts,kset:integer;
n,m,o,p,ch,x,y,ax,ay,w,aw,invx,invy,lbeam:integer;
win,wina,lbx,lby,ballx,bally,balld,ball:integer;
sad,scd,sax,say,sbx,sby,scx,scy,sdx,sdy,fire,firea:integer;
key:char;
graphic:graphics;
death:boolean;
Palette: PaletteType;
keys:array[1..2,1..5] of char;
gd,gm:integer;
procedure intro;
var x,y,n,m,frame:integer;
KEY:CHAR;
inp:file of graphics;
begin
assign(inp,'intro.dat');
reset(inp);
read(inp,graphic);
close(inp);
setcolor(15);
SetTextStyle(gothicfont, HorizDir, 7);
outtextxy(150,50,'Worm War');
rectangle(140,60,450,120);
SetTextStyle(smallfont, HorizDir, 7);
outtextxy(230,200,'Written By');
setcolor(3);
outtextxy(214,290,'dam Hatherly');
frame:=1; key:='ë'; n:=1;
repeat
x:=150; y:=250;
repeat
if graphic.a[x-149,y-249,frame] then
putpixel(x,y,2)
else putpixel(x,y,0);
x:=x+1;
if x>210 then
begin
y:=y+1;
x:=150;
end;
until y=320;
delay(15);
frame:=frame+n;
if frame=9 then n:=-1
else if frame=1 then n:=1;
until keypressed;
end;
procedure setkeys;
begin
cleardevice;
settextstyle(smallfont, HorizDir, 5);
m:=10;
setcolor(7);
for n:=1 to 2 do
begin
if n=1 then outtextxy(10,m,'Input Player 1''s Keys:')
else if n=2 then outtextxy(10,m,'Input Player 2''s Keys:');
outtextxy(10,m+20,'Left: ');
repeat
setpalette(7,random(15)+1);
until keypressed;
keys[n,1]:=readkey;
outtextxy(10,m+40,'Right: ');
repeat
setpalette(7,random(15)+1);
until keypressed;
keys[n,2]:=readkey;
outtextxy(10,m+60,'Up: ');
repeat
setpalette(7,random(15)+1);
until keypressed;
keys[n,3]:=readkey;
outtextxy(10,m+80,'Down: ');
repeat
setpalette(7,random(15)+1);
until keypressed;
keys[n,4]:=readkey;
outtextxy(10,m+100,'Fire: ');
repeat
setpalette(7,random(15)+1);
until keypressed;
keys[n,5]:=readkey;
m:=m+140;
end;
cleardevice;
kset:=1;
end;
procedure invis;
var z,zx,zy:integer;
begin
setfillstyle(1,7);
bar(invx,invy,invx+50,invy+50);
setcolor(15);
rectangle(invx,invy,invx+50,invy+50);
for z:=1 to 10 do
begin
zx:=random(50)+1;
zy:=random(50)+1;
putpixel(zx+invx,zy+invy,15);
end;
end;
procedure dead(g:integer);
var a,b:integer;
begin
death:=true;
if g=1 then
begin
a:=x; b:=y;
end;
if g=2 then
begin
a:=ax; b:=ay;
end;
for n:=1 to 266 do
begin
setcolor(random(15)+1);
circle(a,b,n*3);
if n>1 then begin setcolor(0); circle(a,b,(n-1)*3); end;
sound(round(200-(n/2)));
end;
nosound;
setcolor(15);
if g=1 then
begin
outtextxy(200,200,'Player 1 is Dead');
wina:=wina+1;
end
else
begin
outtextxy(200,200,'Player 2 is Dead');
win:=win+1;
end;
repeat
repeat until keypressed;
key:=readkey;
until key=' ';
end;
procedure laser;
var a,b:integer;
begin
setfillstyle(1,1);
bar(lbx,lby,lbx+20,lby+20);
bar(lbx+80,lby,lbx+100,lby+20);
setcolor(0);
circle(lbx+10,lby+10,8);
circle(lbx+90,lby+10,8);
setfillstyle(1,0);
bar(lbx+20,lby+2,lbx+80,lby+18);
setfillstyle(1,3);
if lbeam<60 then bar(lbx+20,lby+2,lbx+lbeam+20,lby+18);
if lbeam=60 then bar(lbx+20,lby+2,lbx+80,lby+18);
if lbeam>60 then bar(lbx+20+(lbeam-60),lby+2,lbx+80,lby+18);
lbeam:=lbeam+1;
if lbeam>120 then lbeam:=1;
end;
procedure telep;
begin
setfillstyle(1,1);
bar(100,40,110,0);
bar(140,40,150,0);
bar(500,470,510,430);
bar(540,470,550,430);
setcolor(2);
line(100,40,110,0);
line(140,40,150,0);
line(100,0,110,40);
line(140,0,150,40);
line(500,470,510,430);
line(540,470,550,430);
line(500,430,510,470);
line(540,430,550,470);
setfillstyle(1,0);
bar(111,50,139,0);
bar(511,470,539,420);
end;
procedure drawball(x,y,c:integer);
begin
putpixel(x-3,y-1,c);
putpixel(x-3,y,c);
putpixel(x-3,y+1,c);
putpixel(x+3,y-1,c);
putpixel(x+3,y,c);
putpixel(x+3,y+1,c);
putpixel(x-1,y-3,c);
putpixel(x,y-3,c);
putpixel(x+1,y-3,c);
putpixel(x-1,y+3,c);
putpixel(x,y+3,c);
putpixel(x+1,y+3,c);
putpixel(x-2,y-2,c);
putpixel(x-2,y+2,c);
putpixel(x+2,y-2,c);
putpixel(x+2,y+2,c);
putpixel(x-1,y-1,c);
putpixel(x+1,y-1,c);
putpixel(x-1,y+1,c);
putpixel(x,y+1,c);
putpixel(x+1,y+1,c);
end;
procedure moveball;
var x,y,d:integer;
begin
d:=balld; x:=ballx; y:=bally;
if d=1 then
begin
if getpixel(x+4,y)<>0 then d:=4
else if getpixel(x,y-4)<>0 then d:=2;
end
else if d=2 then
begin
if getpixel(x+4,y)<>0 then d:=3
else if getpixel(x,y+4)<>0 then d:=1;
end
else if d=3 then
begin
if getpixel(x-4,y)<>0 then d:=2
else if getpixel(x,y+4)<>0 then d:=4;
end
else if d=4 then
begin
if getpixel(x-4,y)<>0 then d:=1
else if getpixel(x,y-4)<>0 then d:=3;
end;
balld:=d;
if d=1 then
begin
x:=x+1;
y:=y-1;
end
else if d=2 then
begin
x:=x+1;
y:=y+1;
end
else if d=3 then
begin
x:=x-1;
y:=y+1;
end
else if d=4 then
begin
x:=x-1;
y:=y-1;
end;
if x>639 then x:=1
else if x<1 then x:=639
else if y>470 then
begin
if (teleport=1) and (x>510) and (x<540) then x:=x-400;
y:=1;
end
else if y<1 then
begin
if (teleport=1) and (x>110) and (x<140) then x:=x+400;
y:=470;
end;
drawball(ballx,bally,0);
drawball(x,y,4);
ballx:=x; bally:=y;
end;
procedure shoot(VAR d,x,y,ax,ay,fr:integer; c:integer);
begin
if (d=1) and (getpixel(x-1,y)<>0) then fr:=fr+1
else if (d=1) and (getpixel(ax+1,y)<>0) then fr:=fr+1
else if (d=2) and (getpixel(x,y-1)<>0) then fr:=fr+1
else if (d=2) and (getpixel(x,ay+1)<>0) then fr:=fr+1
else
begin
if d=1 then
begin
x:=x-1;
ax:=ax+1;
end
else if d=2 then
begin
y:=y-1;
ay:=ay+1;
end;
end;
putpixel(x,y,c);
putpixel(ax,ay,c);
end;
procedure game;
begin
repeat
cleardevice;
death:=false; fire:=0; firea:=0;
randomize;
SetAllPalette(Palette);
setcolor(15);
if sides=1 then rectangle(0,0,639,470);
if obstacles>0 then
begin
for n:=1 to obstacles do
begin
setfillstyle(1,random(5)+3);
o:=random(609)+5;
p:=random(440)+5;
bar(o,p,o+20,p+20);
end;
end;
if invisi=1 then
begin
invx:=random(579)+1;
invy:=random(410)+1;
invis;
end;
if beam=1 then
begin
lbx:=random(529)+5;
lby:=random(410)+1;
laser;
end;
if ball=1 then
begin
ballx:=random(579)+1;
bally:=random(410)+1;
balld:=random(4)+1;
drawball(ballx,bally,4);
end;
if teleport=1 then telep;
x:=20; y:=20; ax:=619; ay:=450;
putpixel(x,y,3);
putpixel(x+1,y,3);
putpixel(x+1,y+1,3);
putpixel(x,y+1,3);
putpixel(ax,ay,8);
putpixel(ax+1,ay,8);
putpixel(ax+1,ay+1,8);
putpixel(ax,ay+1,8);
w:=2; aw:=4; lbeam:=1;
repeat
repeat until keypressed;
key:=readkey;
until key=' ';
repeat
key:='Ë';
if keypressed then key:=readkey;
if key=keys[1,1] then w:=4
else if key=keys[1,2] then w:=2
else if key=keys[1,3] then w:=1
else if key=keys[1,4] then w:=3
else if (key=keys[1,5]) and ((fire=0) or (fire=5)) then
begin
fire:=fire+1;
if w=1 then
begin
sad:=1; sax:=x-1; say:=y;
sbx:=x+2; sby:=y;
end
else if w=2 then
begin
sad:=2; sax:=x; say:=y-1;
sbx:=x; sby:=y+2;
end
else if w=3 then
begin
sad:=1; sax:=x-1; say:=y;
sbx:=x+2; sby:=y;
end
else if w=4 then
begin
sad:=2; sax:=x; say:=y-1;
sbx:=x; sby:=y+2;
end;
end
else if key=keys[2,1] then aw:=4
else if key=keys[2,2] then aw:=2
else if key=keys[2,3] then aw:=1
else if key=keys[2,4] then aw:=3
else if (key=keys[2,5]) and ((firea=0) or (firea=2)) then
begin
firea:=firea+1;
if aw=1 then
begin
scd:=1; scx:=ax-1; scy:=ay;
sdx:=ax+2; sdy:=ay;
end
else if aw=2 then
begin
scd:=2; scx:=ax; scy:=ay-1;
sdx:=ax; sdy:=ay+2;
end
else if aw=3 then
begin
scd:=1; scx:=ax-1; scy:=ay;
sdx:=ax+2; sdy:=ay;
end
else if aw=4 then
begin
scd:=2; scx:=ax; scy:=ay-1;
sdx:=ax; sdy:=ay+2;
end;
end;
if (fire=1) or (fire=3) then shoot(sad,sax,say,sbx,sby,fire,4);
if (firea=1) or (firea=3) then shoot(scd,scx,scy,sdx,sdy,firea,9);
setfillstyle(1,0);
if invisi=1 then bar(invx,invy,invx+50,invy+50);
if (w=1) and (getpixel(x,y-1)<>0) then dead(1);
if (w=2) and (getpixel(x+2,y)<>0) then dead(1);
if (w=3) and (getpixel(x,y+2)<>0) then dead(1);
if (w=4) and (getpixel(x-1,y)<>0) then dead(1);
if (aw=1) and (getpixel(ax,ay-1)<>0) then dead(2);
if (aw=2) and (getpixel(ax+2,ay)<>0) then dead(2);
if (aw=3) and (getpixel(ax,ay+2)<>0) then dead(2);
if (aw=4) and (getpixel(ax-1,ay)<>0) then dead(2);
if w=1 then y:=y-1
else if w=2 then x:=x+1
else if w=3 then y:=y+1
else if w=4 then x:=x-1;
if x>639 then x:=1
else if x<1 then x:=639
else if y>470 then
begin
if (teleport=1) and (x>510) and (x<540) then x:=x-400;
y:=1;
end
else if y<1 then
begin
if (teleport=1) and (x>110) and (x<140) then x:=x+400;
y:=470;
end;
if aw=1 then ay:=ay-1
else if aw=2 then ax:=ax+1
else if aw=3 then ay:=ay+1
else if aw=4 then ax:=ax-1;
if ax>639 then ax:=1
else if ax<1 then ax:=639
else if ay>470 then
begin
if (teleport=1) and (ax>510) and (ax<540) then ax:=ax-400;
ay:=1;
end
else if ay<1 then
begin
if (teleport=1) and (ax>110) and (ax<140) then ax:=ax+400;
ay:=470;
end;
if invisi=1 then invis;
if beam=1 then laser;
if ball=1 then moveball;
putpixel(x,y,3);
putpixel(x+1,y,3);
putpixel(x+1,y+1,3);
putpixel(x,y+1,3);
putpixel(ax,ay,8);
putpixel(ax+1,ay,8);
putpixel(ax+1,ay+1,8);
putpixel(ax,ay+1,8);
delay(15);
until death;
until (win=bouts) or (wina=bouts);
cleardevice;
setcolor(15);
if win=bouts then outtextxy(200,200,'Player 1 is the overall winner')
else outtextxy(200,200,'Player 2 is the overall winner');
win:=0; wina:=0;
repeat
repeat until keypressed;
key:=readkey;
until key=' ';
end;
Label 1;
BEGIN
gd:=detect;
initgraph(gd,gm,'');
if GraphResult <> grOk then
begin
writeln('Error initialising graphics');
Halt(1);
end;
cleardevice;
intro;
cleardevice;
randomize; kset:=0;
getpalette(palette);
bouts:=1; ball:=0;
1:repeat
setcolor(1);
SetTextStyle(gothicfont, HorizDir, 7);
outtextxy(40,20,' Worm War');
setcolor(2);
SetTextStyle(smallfont, HorizDir, 8);
outtextxy(50,100,'Menu');
setcolor(3);
SetTextStyle(smallfont, HorizDir, 6);
if sides=1 then
outtextxy(30,150,'1. Side walls On')
else
outtextxy(30,150,'1. Side walls Off');
setcolor(4);
SetTextStyle(smallfont, HorizDir, 6);
case obstacles of
0:outtextxy(30,170, '2. Obstacles 0');
1:outtextxy(30,170, '2. Obstacles 1');
2:outtextxy(30,170, '2. Obstacles 2');
3:outtextxy(30,170, '2. Obstacles 3');
4:outtextxy(30,170, '2. Obstacles 4');
5:outtextxy(30,170, '2. Obstacles 5');
6:outtextxy(30,170, '2. Obstacles 6');
end;
setcolor(5);
SetTextStyle(smallfont, HorizDir, 6);
if invisi=1 then
outtextxy(30,190,'3. Invisiblock On')
else
outtextxy(30,190,'3. Invisiblock Off');
setcolor(6);
SetTextStyle(smallfont, HorizDir, 6);
if teleport=1 then
outtextxy(30,210,'4. Teleporter On')
else
outtextxy(30,210,'4. Teleporter Off');
setcolor(7);
SetTextStyle(smallfont, HorizDir, 6);
case bouts of
1:outtextxy(30,230, '5. First to 1');
2:outtextxy(30,230, '5. First to 2');
3:outtextxy(30,230, '5. First to 3');
4:outtextxy(30,230, '5. First to 4');
5:outtextxy(30,230, '5. First to 5');
6:outtextxy(30,230, '5. First to 6');
7:outtextxy(30,230, '5. First to 7');
8:outtextxy(30,230, '5. First to 8');
9:outtextxy(30,230, '5. First to 9');
10:outtextxy(30,230, '5. First to 10');
end;
setcolor(8);
SetTextStyle(smallfont, HorizDir, 6);
if beam=1 then
outtextxy(30,250,'6. Laser Beam On')
else
outtextxy(30,250,'6. Laser Beam Off');
setcolor(9);
SetTextStyle(smallfont, HorizDir, 6);
outtextxy(30,270,'7. Set Keys');
setcolor(10);
SetTextStyle(smallfont, HorizDir, 6);
if ball=1 then
outtextxy(30,290,'8. Bouncer On')
else
outtextxy(30,290,'8. Bouncer Off');
setcolor(11);
SetTextStyle(smallfont, HorizDir, 6);
outtextxy(30,310,'9. Play');
setcolor(12);
SetTextStyle(smallfont, HorizDir, 6);
outtextxy(30,330,'0. Quit');
setcolor(13);
SetTextStyle(smallfont, HorizDir, 4);
if kset=0 then
outtextxy(30,370,' You Have not yet set your keys');
for n:=1 to 15 do
setpalette(n,random(15)+1);
until keypressed;
key:=readkey;
if (key='1') and (sides=0) then sides:=1
else if (key='1') and (sides=1) then sides:=0
else if (key='2') and (obstacles<6) then inc(obstacles)
else if (key=