Приложение б
program MINER;
const n=9;
type mass=array[0..10,0..10] of string;
mass1=array[0..10,0..10] of integer;
var i,j,x,code:integer;
s:string;
ok,over:boolean;
A,B:mass;
procedure Field;
begin
randomize;
for i:=0 to 10 do begin
for j:=0 to 10 do begin
if (i=0) or (j=0) or (i=10) or (j=10) then B[i,j]:='!';
end;
end;
for i:=1 to n do
begin
for j:=1 to n do
A[i,j]:='0';
end;
while x<10 do
begin
i:=trunc ((9-1)*random+1);
j:=trunc ((9-1)*random+1);
A[i,j]:='*';
x:=0;
for i:=1 to n do
begin
for j:=1 to n do
if A[i,j]='*' then x:=x+1;
end;
end;
for i:=1 to n do
begin
for j:=1 to n do
begin
B[i,j]:='#';
if A[i,j]<>'*' then
begin
x:=0;
if A[i-1,j-1]='*' then x:=x+1;
if A[i-1,j]='*' then x:=x+1;
if A[i-1,j+1]='*' then x:=x+1;
if A[i,j-1]='*' then x:=x+1;
if A[i,j+1]='*' then x:=x+1;
if A[i+1,j-1]='*' then x:=x+1;
if A[i+1,j]='*' then x:=x+1;
if A[i+1,j+1]='*' then x:=x+1;
Str(x,s);
A[i,j]:=s;
end
else A[i,j]:='*'
end;
end;
end;
procedure Show(const Z:mass);
begin
writeln;
writeln;
write(' X');
for j:=1 to n do
write(' ',j);
writeln;write('Y');
for i:=1 to n do
begin
writeln;
write(i,' ');
for j:=1 to n do
write(' ',Z[i,j]);
end;
end;
procedure Scan(const i,j:integer);
begin
if A[i,j]='*'
then begin
B:=A;
over:=true;
ok:=true;
end
else begin
val(A[i,j],x,code);
if x>0
then
B[i,j]:=A[i,j]
else if A[i,j]='0'
then begin
B[i,j]:=' ';
if (A[i-1,j]<>'!') and (B[i-1,j]<>' ') then
Scan(i-1,j); {up}
if (A[i,j-1]<>'!') and (B[i,j-1]<>' ') then
Scan(i,j-1); {left}
if (A[i,j+1]<>'!') and (B[i,j+1]<>' ') then
Scan(i,j+1); {right}
if (A[i+1,j]<>'!') and (B[i+1,j]<>' ') then
Scan(i+1,j); {down}
if (A[i-1,j-1]<>'!') and (B[i-1,j-1]<>' ') then
Scan(i-1,j-1);
if (A[i-1,j+1]<>'!') and (B[i-1,j+1]<>' ') then
Scan(i-1,j+1);
if (A[i+1,j-1]<>'!') and (B[i+1,j-1]<>' ') then
Scan(i+1,j-1);
if (A[i+1,j+1]<>'!') and (B[i+1,j+1]<>' ') then
Scan(i+1,j+1);
end;
end;
end;
procedure Check;
begin
x:=0;
for i:=1 to n do
for j:=1 to n do
if B[i,j]='#' then x:=x+1;
if x=10 then ok:=true;
end;
BEGIN
repeat
Field;
{Show(A);}
Show(B);
over:=false;
ok:=false;
repeat
writeln;
writeln('Enter X and Y');
readln(j,i);
writeln(j,',',i);
Scan(i,j);
Show(B);
Check;
until ok=true;
writeln;
writeln;
write(' ___________');
writeln;
if over=false
then writeln('| YOU WIN!! |')
else writeln('| GAME OVER |');
{writeln;}
writeln(' ___________');
writeln;
writeln('Enter 1 for Repeat or any key for Exit');
readln(x);
until x<>1;
END.