program bobo;
uses crt;
type type1=record
h,l,f:integer;
end;
const m:array[1..6,1..16]of integer=
((1,0,1,1,1,0,1,0,1,0,1,1,1,0,0,0),
(1,2,1,2,0,2,1,2,1,2,0,2,0,2,0,2),
(1,1,1,0,1,1,1,0,1,0,1,0,0,1,1,1),
{(0,2,0,2,1,2,0,2,0,2,1,2,1,2,0,2),
(0,0,0,1,1,1,1,1,1,1,1,1,1,1,0,0), }
(0,2,1,2,1,2,0,2,0,2,1,2,1,2,1,2),
(0,0,1,0,1,1,1,0,1,0,1,0,1,1,1,1),
(0,2,1,2,0,2,0,2,1,2,0,2,0,2,1,2));
var yellow,white:type1;
ybomb,wbomb:array[1..10]of type1;
fire:array[1..100]of type1;
map:array[0..6,0..16]of integer;
yb,wb,ybo,wbo,yw,yv,wv,ww,tms,ts,tm,t:integer;
yueshi,weili:array[1..10]of type1;
b:boolean;
procedure pushtype1(var t:array of type1;th,tl,tf:integer);
var i:integer;
begin
for i:=1 to high(t) do
with t[i] do
if f<=0 then
begin
f:=tf;
h:=th;
l:=tl;
exit;
end;
end;
procedure print;
var i,j:integer;
begin
textbackground(black);
clrscr;
for i:=1 to 16 do
for j:=1 to 6 do
if map[j,i] in [1,2] then
begin
if map[j,i]=1 then textcolor(green)
else if map[j,i]=2 then textcolor(brown);
gotoxy(i*4-3,j*4-3);write('>>>>');
gotoxy(i*4-3,j*4-2);write('>>>>');
gotoxy(i*4-3,j*4-1);write('>>>>');
gotoxy(i*4-3,j*4-0);write('>>>>');
end;
for i:=1 to high(fire) do
with fire[i] do
if f>0 then
begin
textcolor(red);
gotoxy(l*4-3,h*4-3);write('>><<');
gotoxy(l*4-3,h*4-2);write('>><<');
gotoxy(l*4-3,h*4-1);write('>><<');
gotoxy(l*4-3,h*4-0);write('>><<');
end;
for i:=1 to high(yueshi) do
with yueshi[i] do
if f>0 then
begin
textcolor(red);
gotoxy(l*4-3,h*4-3);write(' /\ ');
gotoxy(l*4-3,h*4-2);write('/__\');
gotoxy(l*4-3,h*4-1);write('\ /');
gotoxy(l*4-3,h*4-0);write(' \/ ');
end;
for i:=1 to high(weili) do
with weili[i] do
if f>0 then
begin
textcolor(114);
gotoxy(l*4-3,h*4-3);write('____');
gotoxy(l*4-3,h*4-2);write('|/\|');
gotoxy(l*4-3,h*4-1);write('|\/|');
gotoxy(l*4-3,h*4-0);write('/__/');
end;
for i:=1 to high(ybomb) do
with ybomb[i] do
if f>0 then
begin
textcolor(blue);
gotoxy(l*4-3,h*4-3);write(' XX ');
gotoxy(l*4-3,h*4-2);write('| |');
gotoxy(l*4-3,h*4-1);write('| |');
gotoxy(l*4-3,h*4-0);write('\__/');
end;
for i:=1 to high(wbomb) do
with wbomb[i] do
if f>0 then
begin
textcolor(blue);
gotoxy(l*4-3,h*4-3);write(' XX ');
gotoxy(l*4-3,h*4-2);write('| |');
gotoxy(l*4-3,h*4-1);write('| |');
gotoxy(l*4-3,h*4-0);write('\__/');
end;
textbackground(black);
textbackground(black);
if yellow.f>0 then textcolor(14)
else textcolor(12);
gotoxy(yellow.l*4-3,yellow.h*4-3);write('/--\');
gotoxy(yellow.l*4-3,yellow.h*4-2);write('|^^|');
gotoxy(yellow.l*4-3,yellow.h*4-1);write('|\/|');
gotoxy(yellow.l*4-3,yellow.h*4-0);write('\__/');
if white.f>0 then textcolor(15)
else textcolor(12);
gotoxy(white.l*4-3,white.h*4-3);write('/--\');
gotoxy(white.l*4-3,white.h*4-2);write('|^^|');
gotoxy(white.l*4-3,white.h*4-1);write('|\/|');
gotoxy(white.l*4-3,white.h*4-0);write('\__/');
end;
procedure newthing(h,l:integer);
var i:integer;
begin
b:=true;
i:=random(3);
if i<=0 then pushtype1(yueshi,h,l,1)
else if i=1 then pushtype1(weili,h,l,1);
end;
procedure checkthing;
var i:integer;
begin
for i:=1 to high(yueshi) do
with yueshi[i] do
begin
if (f>0)and(h=yellow.h)and(l=yellow.l) then begin b:=true;inc(yb);f:=0;end;
if (f>0)and(h=white.h)and(l=white.l) then begin b:=true;inc(wb);f:=0;end;
end;
for i:=1 to high(weili) do
with weili[i] do
begin
if (f>0)and(h=yellow.h)and(l=yellow.l) then begin b:=true;inc(yw);f:=0;end;
if (f>0)and(h=white.h)and(l=white.l) then begin b:=true;inc(ww);f:=0;end;
end;
end;
procedure runbomby(ch:char);
begin
if ch='q' then halt;
{yellow}
if ch in['f','j','k','l','i'] then
begin
if(ch='f')and(yb>0){and(map[yellow.h,yellow.l]=0)}then
begin dec(yb);pushtype1(ybomb,yellow.h,yellow.l,3);map[yellow.h,yellow.l]:=4;end
else if(ch='j')and(map[yellow.h,yellow.l-1]=0)and(yellow.l>1) then dec(yellow.l)
else if(ch='l')and(map[yellow.h,yellow.l+1]=0)and(yellow.l<16) then inc(yellow.l)
else if(ch='i')and(map[yellow.h-1,yellow.l]=0)and(yellow.h>1) then dec(yellow.h)
else if(ch='k')and(map[yellow.h+1,yellow.l]=0)and(yellow.h<6) then inc(yellow.h);
end
{white}
else if ch in['8','6','5','4','0'] then
begin
if(ch='0')and(wb>0){and(map[white.h,white.l]=0)}then
begin dec(wb);pushtype1(wbomb,white.h,white.l,3);map[white.h,white.l]:=4;end
else if(ch='4')and(map[white.h,white.l-1]=0)and(white.l>1) then dec(white.l)
else if(ch='6')and(map[white.h,white.l+1]=0)and(white.l<16) then inc(white.l)
else if(ch='8')and(map[white.h-1,white.l]=0)and(white.h>1) then dec(white.h)
else if(ch='5')and(map[white.h+1,white.l]=0)and(white.h<6) then inc(white.h);
end;
end;
procedure bomb(h,l,w:integer);
const fx:array[1..4,1..2]of -1..1=((1,0),(0,1),(-1,0),(0,-1));
var i,j,xh,xl:integer;
begin
b:=true;
pushtype1(fire,h,l,5);
for j:=1 to 4 do
begin
xh:=h;xl:=l;
for i:=1 to w do
begin
inc(xh,fx[j,1]);
inc(xl,fx[j,2]);
if (xh<1)or(xh>6)or(xl<1)or(xl>16) then break;
if map[xh,xl]=1 then begin pushtype1(fire,xh,xl,5);map[xh,xl]:=0;newthing(xh,xl);break;end
else if map[xh,xl]=2 then break
else pushtype1(fire,xh,xl,5);
end;
end;
end;
procedure check;
var i,t:integer;
begin
t:=0;
for i:=1 to high(fire) do
with fire[i] do
begin
if (f>0)and(h=yellow.h)and(l=yellow.l) then begin yellow.f:=0;b:=true;end;
if (f>0)and(h=white.h)and(l=white.l) then begin white.f:=0;b:=true;end;
end;
end;
procedure runbomb;
var i:integer;
begin
for i:=1 to high(ybomb) do
with ybomb[i] do
if f>0 then
begin
dec(f);
if f<=0 then
begin
map[h,l]:=0;
bomb(h,l,yw);
inc(yb);
end;
end;
for i:=1 to high(wbomb) do
with wbomb[i] do
if f>0 then
begin
dec(f);
if f<=0 then
begin
map[h,l]:=0;
bomb(h,l,ww);
inc(wb);
end;
end;
end;
procedure init;
var i,j:integer;
begin
yb:=1;wb:=1;yw:=1;ww:=1;
textbackground(black);
clrscr;
fillchar(map,sizeof(map),0);
for i:=1 to 6 do
for j:=1 to 16 do
map[i,j]:=m[i,j];
with yellow do begin f:=1;h:=6;l:=1;end;
with white do begin f:=1;h:=1;l:=16;end;
fillchar(ybomb,sizeof(ybomb),0);
fillchar(wbomb,sizeof(wbomb),0);
fillchar(fire,sizeof(fire),0);
fillchar(yueshi,sizeof(yueshi),0);
fillchar(weili,sizeof(weili),0);
tms:=0;tm:=0;ts:=0;
end;
procedure main;
var ch:char;
i:integer;
begin
t:=0;
while (white.f=1)and(yellow.f=1) do
begin
b:=false;
delay(8);
inc(tms,10);
if tms=1000 then
begin
tms:=0;
inc(ts);
if ts=60 then
begin
inc(tm);
ts:=0;
end;
end;
if tms mod 100=0 then
for i:=1 to high(fire) do
begin
if fire[i].f=0 then b:=true;
dec(fire[i].f);
end;
if keypressed then
begin
ch:=readkey;
b:=true;
runbomby(ch);
end;
if tms=0 then runbomb;
check;
checkthing;
if b then begin print;inc(t);end;
end;
delay(500);
end;
procedure over;
var ch:char;
i:integer;
begin
clrscr;
gotoxy(1,1);
if (white.f=0)and(yellow.f=0) then
begin
writeln('DDD RRR A W W W ');
writeln('D D R R A A W W W W ');
writeln('D D RR AAAAA WW WW ');
writeln('DDD R RR A A W W ');
end
else if yellow.f=0 then
begin
textcolor(15);
writeln('W W W H H IIII TTTTTT EEEEEE W W W OOO N N');
writeln('W W W W HHHHH II TT EE____ W W W W O O NN N');
writeln('WW WW H H II TT EE WW WW O O N NN');
writeln('W W H H IIII TT EEEEEE W W OOO N N');
end
else if white.f=0 then
begin
textcolor(14);
writeln('Y Y EEEEEE L L OOO W W W W W W OOO N N');
writeln(' Y Y EE____ L L O O W W W W W W W W O O NN N');
writeln(' Y EE L L O O WW WW WW WW O O N NN');
writeln(' Y EEEEEE LLLL LLLL OOO W W W W OOO N N');
end;
repeat ch:=readkey;until ch=#13;
end;
begin
while true do
begin
init;
main;
over;
end;
readln;
end.