Var
N:integer=600;
LABIRINT:array[0..600,0..600] of integer;
...
procedure setBlankAsDeadblockRec(x,y:integer);
var k:integer;
begin
k:=0;
if LABIRINT[x,y]=blank then
begin
if LABIRINT[x-1,y]<>BLANK then k:=k+1;
if LABIRINT[x,y-1]<>BLANK then k:=k+1;
if LABIRINT[x+1,y]<>BLANK then k:=k+1;
if LABIRINT[x,y+1]<>BLANK then k:=k+1;
if k=4 then LABIRINT[x,y]:=DEADBLOCK;
if k=3 then
begin
LABIRINT[x,y]:=DEADBLOCK;
if LABIRINT[x-1,y]=BLANK then setBlankAsDeadblockRec(x-1,y);
if LABIRINT[x,y-1]=BLANK then setBlankAsDeadblockRec(x,y-1);
if LABIRINT[x+1,y]=BLANK then setBlankAsDeadblockRec(x+1,y);
if LABIRINT[x,y+1]=BLANK then setBlankAsDeadblockRec(x,y+1);
end;
end;
end;
procedure setDeadblock;
var i,j:integer;
begin
for i:=1 to N-1 do
for j:=1 to N-1 do
setBlankAsDeadblockRec(i,j);
end;