2.pas

小游戏源码之扫雷

uses crt;
var
num,a:array[1..20,1..20] of integer;
i,j,next,dif:integer;
key:char;
fail,win:boolean;
fo:text;
re:char;

procedure choose;
var
ip:integer;
begin
writeln('CHOOSE: 1.EASY 2.ORDINARILY 3.HARD');
READLN(ip);
case ip of
1:dif:=1;
2:dif:=2;
3:dif:=3;
end;
end;

procedure winner;
begin
if next=0 then win:=true else win:=false;
end;

procedure count(ii,jj:integer);

var
k,m,n:integer;
begin


if (ii=1) and (jj=1) then
begin
k:=0;
for m:=ii to ii+1 do
for n:=jj to jj+1 do
if ord(a[m,n]=0)+ord(a[m,n]=3)+ord(a[m,n]=10)+ord(a[m,n]=13)>=1
then k:=k+1; num[ii,jj]:=k;
end;


if (ii=1) and (jj>1) and (jj<20) then
begin
k:=0;
for m:=ii to ii+1 do
for n:=jj-1 to jj+1 do
if ord(a[m,n]=0)+ord(a[m,n]=3)+ord(a[m,n]=10)+ord(a[m,n]=13)>=1
then k:=k+1; num[ii,jj]:=k;
end;


if (ii=1) and (jj=20) then
begin
k:=0;
for m:=ii to ii+1 do
for n:=jj-1 to jj do
if ord(a[m,n]=0)+ord(a[m,n]=3)+ord(a[m,n]=10)+ord(a[m,n]=13)>=1
then k:=k+1; num[ii,jj]:=k;
end;


if (ii>1) and (ii<20) and (jj=1)then
begin
k:=0;
for m:=ii-1 to ii+1 do
for n:= jj to jj+1 do
if ord(a[m,n]=0)+ord(a[m,n]=3)+ord(a[m,n]=10)+ord(a[m,n]=13)>=1
then k:=k+1; num[ii,jj]:=k;
end;


if (ii>1) and (ii<20) and (jj>1) and (jj<20) then
begin
k:=0;
for m:=ii-1 to ii+1 do
for n:=jj-1 to jj+1 do
if ord(a[m,n]=0)+ord(a[m,n]=3)+ord(a[m,n]=10)+ord(a[m,n]=13)>=1
then k:=k+1; num[ii,jj]:=k;
end;


if (ii>1) and (ii<20) and (jj=20) then
begin
k:=0;
for m:=ii-1 to ii+1 do
for n:=jj-1 to jj do
if ord(a[m,n]=0)+ord(a[m,n]=3)+ord(a[m,n]=10)+ord(a[m,n]=13)>=1
then k:=k+1; num[ii,jj]:=k;
end;

if (ii=20) and (jj=1) then
begin
k:=0;
for m:=ii-1 to ii do
for n:=jj to jj+1 do
if ord(a[m,n]=0)+ord(a[m,n]=3)+ord(a[m,n]=10)+ord(a[m,n]=13)>=1
then k:=k+1; num[ii,jj]:=k;
end;


if (ii=20) and (jj>1) and (jj<20) then
begin
k:=0;
for m:=ii-1 to ii do
for n:=jj-1 to jj+1 do
if ord(a[m,n]=0)+ord(a[m,n]=3)+ord(a[m,n]=10)+ord(a[m,n]=13)>=1
then k:=k+1; num[ii,jj]:=k;
end;


if (ii=20) and (jj=20) then
begin
k:=0;
for m:=ii-1 to ii do
for n:=jj-1 to jj do
if ord(a[m,n]=0)+ord(a[m,n]=3)+ord(a[m,n]=10)+ord(a[m,n]=13)>=1
then k:=k+1; num[ii,jj]:=k;
end;
end;

procedure make;

var
m,n,zz:integer;
begin
randomize;
for m:=1 to 20 do
for n:=1 to 20 do
begin
zz:=random(100);
case dif of

1:begin if zz<8 then begin a[m,n]:=0; next:=next+1; end else a[m,n]:=1; end;
2:begin if zz<16 then begin a[m,n]:=0; next:=next+1; end else a[m,n]:=1; end;
3:begin if zz<21 then begin a[m,n]:=0; next:=next+1; end else a[m,n]:=1; end;
end;
end;
end;

procedure dig(mm,nn:integer);
var
m1,m2,n1,n2,m3,n3,m,n:integer;

aa:array[1..20,1..20] of boolean;
begin
if num[mm,nn]=0 then
begin
if (mm=1) and (nn=1) then
begin
for m:=mm to mm+1 do
for n:=nn to nn+1 do
begin
count(m,n);a[m,n]:=2;
end;

end;
if (mm=1) and (nn>1) and (nn<20) then
begin
for m:=mm to mm+1 do
for n:=nn-1 to nn+1 do
begin
count(m,n);a[m,n]:=2;
end;
end;
if (mm=1) and (nn=20) then
begin
for m:=mm to mm+1 do
for n:=nn-1 to nn do
begin
count(m,n);a[m,n]:=2;

end;
end;
if (mm>1) and (mm<20) and (nn=1) then
begin
for m:=mm-1 to mm+1 do
for n:=nn to nn+1 do
begin
count(m,n);a[m,n]:=2;

end;
end;
if (mm>1) and (mm<20) and (nn>1) and (nn<20) then
begin
for m:=mm-1 to mm+1 do
for n:=nn-1 to nn+1 do
begin
count(m,n);a[m,n]:=2;

end;
end;
if (mm>1) and (mm<20) and (nn=20) then
begin
for m:=mm-1 to mm+1 do
for n:=nn-1 to nn do
begin
count(m,n);a[m,n]:=2;

end;
end;
if (mm=20) and (nn=1) then
begin
for m:=mm-1 to mm do
for n:=nn to nn+1 do
begin
count(m,n);a[m,n]:=2;

end;
end;
if (mm=20) and (nn>1) and (nn<20) then
begin
for m:=mm to mm+1 do
for n:=nn-1 to nn+1 do
begin
count(m,n);a[m,n]:=2;

end;
end;
if (mm=20) and (nn=20) then
begin
for m:=mm-1 to mm do
for n:=nn-1 to nn do
begin
count(m,n);a[m,n]:=2;

end;
end;
end;
end;
procedure print;
var
ii,jj:integer;
begin
clrscr;
for ii:=1 to 20 do
begin
for jj:=1 to 20 do
case a[ii,jj] of
0:write({fo,}'*'{'0'},' '); {full,close}
1:write({fo,}'*'{'1'},' '); {empty,close}
2: if num[ii,jj]=0 then write(' ') else write({fo,}num[ii,jj],' '); {empty,open}
3:write({fo,}chr(1),' '); {full,size}
4:write({fo,}chr(2),' '); {full,open}
5:write({fo,}chr(1),' '); {entpy,size}
10:write({fo,}'*'{'0'},'<'); {full,close,<}
11:write({fo,}'*','<'); {empty,close,<}
12: if num[ii,jj]=0 then write(' <') else write({fo,}num[ii,jj],'<'); {empey,open,<}
13:write({fo,}chr(1),'<'); {full,size,<}
14:write({fo,}chr(2),'<'); {full,open,<}
15:write({fo,}chr(1),'<'); {empty,size,<}
end;

writeln{(fo)};
end;

end;

procedure change(y:char);
var
k:integer;
begin
case y of
'w': begin
a[i,j]:=a[i,j]-10;
i:=i-1;if i<1 then i:=20;
a[i,j]:=a[i,j]+10;
exit;
end;
'a':begin
a[i,j]:=a[i,j]-10;
j:=j-1;if j<1 then j:=20;
a[i,j]:=a[i,j]+10;
exit;
end;
's':begin
a[i,j]:=a[i,j]-10;
i:=i+1;if i>20 then i:=1;
a[i,j]:=a[i,j]+10;
exit;
end;
'd':begin
a[i,j]:=a[i,j]-10;
j:=j+1; if j>20 then j:=1;
a[i,j]:=a[i,j]+10;
exit;
end;
'e':case a[i,j] of {make it open}
10:begin
a[i,j]:=14;
fail:=true;
exit;
end;
11:begin
count(i,j);
dig(i,j);
a[i,j]:=12;
exit;
end;
end;
'r':case a[i,j] of {size it}
10:begin
a[i,j]:=13;
next:=next-1;
exit;
end;

11:begin a[i,j]:=15; exit; end;
13:begin
a[i,j]:=10;
next:=next+1;
exit;
end;
15: begin a[i,j]:=11; exit; end;
end;
'q':fail:=true;
end;
end;


begin
repeat
randomize;
fail:=false;
next:=0;
{for i:=1 to 20 do
for j:=1 to 20 do
a[i,j]:=1; }
writeln('---------------------D.A.SOFT--------------------');
writeln('----------------Sao Di Lei-----------------------');
writeln('W up  S down  A left  D right  E turn  R flag');
writeln{(fo)};
choose;
make;
i:=1;j:=1;
a[1,1]:=11;
print;
repeat
readln(key);
change(key);
print;
writeln{(fo)};
writeln('There is', next,' have not been found');
winner;
until (win=true) or (fail=true);
if win=true then writeln('You win!')
else writeln('You fail!');
writeln('DO YOU WANT TO PLAY AGAIN?[Y/N]');

readln(re);
UNTIL RE='n';
end.