uses GraphABC;
const c: integer=21;
type ar=array [0..c,0..c] of byte;
type pp=array of point;
type mm=array [0..5] of point;// соседи
var r: array [0..6] of color;
a1,a2: ar;
x,y,z: integer;
p1,p2: pp;
m: mm;
a: array of byte;
//----------------------------
Barby: byte=4;
Ken: byte=1;
//----------------------------
function tpoint(i,j: integer): point;
begin
result.X:=i; result.y:=j;
end;
function da(x: integer): integer;
begin
var h: boolean=x in [0..c];
if h then result:=x else result:=0;
end;
function sos(x,y: integer):mm;// соседи
begin
if odd(y) then
begin
result[0]:=tpoint(da(x-1),da(y-1));
result[1]:=tpoint(da(x),da(y-1));
end
else
begin
result[0]:=tpoint(da(x),da(y-1));
result[1]:=tpoint(da(x+1),da(y-1));
end;
result[2]:=tpoint(da(x-1),da(y));
result[3]:=tpoint(da(x+1),da(y));
if odd(y) then
begin
result[4]:=tpoint(da(x-1),da(y+1));
result[5]:=tpoint(da(x),da(y+1));
end
else
begin
result[4]:=tpoint(da(x),da(y+1));
result[5]:=tpoint(da(x+1),da(y+1));
end;
end;
function f(x,y: integer): byte;
begin
result:=0;
m:=sos(x,y);
for var i:=0 to 5 do
if (m[i].X>0)and(m[i].Y>0) then
inc(result,a2[m[i].X,m[i].Y]);
result:=result mod Barby;
end;
{
procedure d(x,y,z: integer);
begin
a1[x,y]:=z;
m:=sos(x,y);
for var i:=0 to 5 do
if (m[i].X>0)and(m[i].Y>0) then a1[m[i].x,m[i].y]:=z;
end;
}
procedure addd(x: point);
begin
var i: integer=length(p2);
for var j:=0 to i-1 do if (p2[j].X=x.X)and(p2[j].Y=x.y) then exit;// уникальность
setlength(p2,i+1);
p2[i]:=x;
end;
begin
r[0]:=clblack; r[1]:=clred; r[2]:=clblue; r[3]:=clyellow; r[4]:=clgreen; r[5]:=clwhite; r[6]:=clfuchsia;
//...
for var i:=0 to c do
for var j:=0 to c do
a1[i,j]:=0;
a2:=a1;
setlength(p2,1);
p2[0]:=tpoint(11,11);
var boo: boolean=true;
//---------------------------------------
repeat
setlength(p1,length(p2));
for var i:=0 to high(p2) do p1[i]:=p2[i];
setlength(p2,0);
setlength(a,length(p1));
for var i:=0 to high(p1) do a[i]:=f(p1[i].x,p1[i].Y);
for var i:=0 to high(p1) do a2[p1[i].x,p1[i].Y]:=1;//
for var i:=0 to high(p1) do
begin
var p:=p1[i];
m:=sos(p.X,p.y);
for var j:=0 to 5 do
if (m[j].X>0)and(m[j].Y>0) then
if a2[m[j].x,m[j].Y]=0 then
addd(tpoint(m[j].x,m[j].Y));
end;
if boo then
begin boo:=false; a2[p1[0].x,p1[0].Y]:=Ken end else
for var i:=0 to high(p1) do a2[p1[i].x,p1[i].Y]:=a[i];
until (length(p2)=0)or(length(p2)>220);
//---------------------------------------
z:=8;
for var i:=1 to c do
for var j:=1 to c do
begin
var t: color=r[a2[i,j]];
if odd(j) then x:=50+i*16 else x:=50+i*16+8;
y:=50+j*12;
SetPenColor(t);
Circle(x,y,z);//Рисуем белую ок
FloodFill(x,y,t);
end;
writeln('the end');
end.
