320 lines
6.7 KiB
ObjectPascal
320 lines
6.7 KiB
ObjectPascal
// Èãðà "Æèçíü" íà òîðå
|
|
// Îïòèìèçàöèÿ õåøèðîâàíèåì ïî ðàâíîìåðíîé ñåòêå
|
|
uses Utils,GraphABC;
|
|
|
|
const
|
|
/// Øèðèíà êëåòêè
|
|
w = 4;
|
|
/// Êîëè÷åñòâî êëåòîê ïî øèðèíå
|
|
m = 300;
|
|
/// Êîëè÷åñòâî êëåòîê ïî âûñîòå
|
|
n = 220;
|
|
/// Îòñòóï ïîëÿ îò ëåâîé ãðàíèöû îêíà
|
|
x0 = 1;
|
|
/// Îòñòóï ïîëÿ îò âåðõíåé ãðàíèöû îêíà
|
|
y0 = 21;
|
|
mm = m + 1;
|
|
nn = n + 1;
|
|
/// Êîëè÷åñòâî êëåòîê ñåòêè ïî ãîðèçîíòàëè
|
|
mk = 15;
|
|
/// Êîëè÷åñòâî êëåòîê ñåòêè ïî âåðòèêàëè
|
|
nk = 10;
|
|
|
|
var
|
|
a,b,sosedia,sosedib: array [0..nn,0..mm] of byte;
|
|
obnovA,obnovB: array [1..nk,1..mk] of boolean;
|
|
CountCells: integer;
|
|
obn: boolean;
|
|
gen: integer;
|
|
hn,hm: integer;
|
|
|
|
/// Íàðèñîâàòü ÿ÷åéêó
|
|
procedure DrawCell(i,j: integer);
|
|
begin
|
|
DrawInBuffer := False;
|
|
SetBrushColor(clBlack);
|
|
FillRectangle(x0+(j-1)*w,y0+(i-1)*w,x0+j*w-1,y0+i*w-1);
|
|
DrawInBuffer := True;
|
|
end;
|
|
|
|
/// Ñòåðåòü ÿ÷åéêó
|
|
procedure ClearCell(i,j: integer);
|
|
begin
|
|
DrawInBuffer := False;
|
|
SetBrushColor(clWhite);
|
|
FillRectangle(x0+(j-1)*w,y0+(i-1)*w,x0+j*w-1,y0+i*w-1);
|
|
DrawInBuffer := True;
|
|
end;
|
|
|
|
/// Íàðèñîâàòü âñå èçìåíèâøèåñÿ ÿ÷åéêè
|
|
procedure DrawConfiguration;
|
|
begin
|
|
for var i:=1 to n do
|
|
for var j:=1 to m do
|
|
begin
|
|
var bb := b[i,j];
|
|
if a[i,j]<>bb then
|
|
if bb=1 then DrawCell(i,j)
|
|
else ClearCell(i,j);
|
|
end;
|
|
end;
|
|
|
|
/// Íàðèñîâàòü âñå ÿ÷åéêè
|
|
procedure DrawConfigurationFull;
|
|
begin
|
|
for var i:=1 to n do
|
|
for var j:=1 to m do
|
|
if b[i,j]=1 then DrawCell(i,j)
|
|
else ClearCell(i,j);
|
|
end;
|
|
|
|
/// Íàðèñîâàòü ïîëå
|
|
procedure DrawField;
|
|
begin
|
|
Pen.Color := clLightGray;
|
|
for var i:=0 to m do
|
|
begin
|
|
if i mod hm = 0 then
|
|
Pen.Color := clGray
|
|
else Pen.Color := clLightGray;
|
|
Line(x0+i*w-1,y0,x0+i*w-1,y0+n*w);
|
|
end;
|
|
for var i:=0 to n do
|
|
begin
|
|
if i mod hn = 0 then
|
|
Pen.Color := clGray
|
|
else Pen.Color := clLightGray;
|
|
Line(x0,y0+i*w-1,x0+m*w,y0+i*w-1);
|
|
end;
|
|
end;
|
|
|
|
/// Óâåëè÷èòü ìàññèâ ñîñåäåé äëÿ äàííîé êëåòêè
|
|
procedure IncSosedi(i,j: integer);
|
|
var i1,i2,j1,j2: integer;
|
|
begin
|
|
if i=1 then i1:=n else i1:=i-1;
|
|
if i=n then i2:=1 else i2:=i+1;
|
|
if j=1 then j1:=m else j1:=j-1;
|
|
if j=m then j2:=1 else j2:=j+1;
|
|
SosediB[i1,j1] += 1;
|
|
SosediB[i1,j] += 1;
|
|
SosediB[i1,j2] += 1;
|
|
SosediB[i,j1] += 1;
|
|
SosediB[i,j2] += 1;
|
|
SosediB[i2,j1] += 1;
|
|
SosediB[i2,j] += 1;
|
|
SosediB[i2,j2] += 1;
|
|
end;
|
|
|
|
/// Óìåíüøèòü ìàññèâ ñîñåäåé äëÿ äàííîé êëåòêè
|
|
procedure DecSosedi(i,j: integer);
|
|
var i1,i2,j1,j2: integer;
|
|
begin
|
|
if i=1 then i1:=n else i1:=i-1;
|
|
if i=n then i2:=1 else i2:=i+1;
|
|
if j=1 then j1:=m else j1:=j-1;
|
|
if j=m then j2:=1 else j2:=j+1;
|
|
SosediB[i1,j1] -= 1;
|
|
SosediB[i1,j] -= 1;
|
|
SosediB[i1,j2] -= 1;
|
|
SosediB[i,j1] -= 1;
|
|
SosediB[i,j2] -= 1;
|
|
SosediB[i2,j1] -= 1;
|
|
SosediB[i2,j] -= 1;
|
|
SosediB[i2,j2] -= 1;
|
|
end;
|
|
|
|
/// Ïîñòàâèòü ÿ÷åéêó â êëåòêó (i,j)
|
|
procedure SetCell(i,j: integer);
|
|
begin
|
|
if b[i,j]=0 then
|
|
begin
|
|
b[i,j] := 1;
|
|
obn := True;
|
|
IncSosedi(i,j);
|
|
end;
|
|
CountCells += 1;
|
|
end;
|
|
|
|
/// Óáðàòü ÿ÷åéêó èç êëåòêè (i,j)
|
|
procedure UnSetCell(i,j: integer);
|
|
begin
|
|
if b[i,j]=1 then
|
|
begin
|
|
b[i,j] := 0;
|
|
obn := True;
|
|
DecSosedi(i,j);
|
|
end;
|
|
CountCells -= 1;
|
|
end;
|
|
|
|
/// Èíèöèàëèçèðîâàòü ìàññèâû è êîíôèãóðàöèþ ïîëÿ
|
|
procedure Init;
|
|
var
|
|
xc := n div 2;
|
|
yc := m div 2;
|
|
begin
|
|
for var i:=0 to n+1 do
|
|
for var j:=0 to m+1 do
|
|
b[i,j] := 0;
|
|
a := b;
|
|
SosediB := b;
|
|
SosediA := SosediB;
|
|
for var ik:=1 to nk do
|
|
for var jk:=1 to mk do
|
|
obnovB[ik,jk] := True;
|
|
obnovA := obnovB;
|
|
CountCells := 0;
|
|
|
|
SetCell(xc,yc);
|
|
SetCell(xc,yc+1);
|
|
SetCell(xc,yc+2);
|
|
SetCell(xc-1,yc+2);
|
|
SetCell(xc+1,yc+1);
|
|
end;
|
|
|
|
/// Îáðàáîòàòü ÿ÷åéêó
|
|
procedure ProcessCell(i,j: integer);
|
|
begin
|
|
case SosediA[i,j] of
|
|
0..1,4..9:
|
|
if b[i,j]=1 then
|
|
begin
|
|
b[i,j] := 0;
|
|
obn := True;
|
|
DecSosedi(i,j);
|
|
ClearCell(i,j);
|
|
Dec(CountCells);
|
|
end;
|
|
3: if b[i,j]=0 then
|
|
begin
|
|
b[i,j] := 1;
|
|
obn := True;
|
|
IncSosedi(i,j);
|
|
DrawCell(i,j);
|
|
Inc(CountCells);
|
|
end;
|
|
end; {case}
|
|
end;
|
|
|
|
/// Ïåðåéòè ê ñëåäóþùåìó ïîêîëåíèþ
|
|
procedure NextGen;
|
|
var ifirst,jfirst,ilast,jlast: integer;
|
|
begin
|
|
for var ik:=1 to nk do
|
|
begin
|
|
for var jk:=1 to mk do
|
|
begin
|
|
obn := False;
|
|
ifirst := (ik-1)*hn+1;
|
|
ilast := (ik-1)*hn+hn;
|
|
jfirst := (jk-1)*hm+1;
|
|
jlast := (jk-1)*hm+hm;
|
|
if obnovA[ik,jk] then
|
|
begin
|
|
for var i:=ifirst to ilast do
|
|
for var j:=jfirst to jlast do
|
|
ProcessCell(i,j);
|
|
end
|
|
else
|
|
begin
|
|
var ik1,jk1,ik2,jk2: integer;
|
|
if ik=1 then ik1:=nk else ik1:=ik-1;
|
|
if ik=nk then ik2:=1 else ik2:=ik+1;
|
|
if jk=1 then jk1:=mk else jk1:=jk-1;
|
|
if jk=mk then jk2:=1 else jk2:=jk+1;
|
|
var l := obnovA[ik,jk1];
|
|
var r := obnovA[ik,jk2];
|
|
var u := obnovA[ik1,jk];
|
|
var d := obnovA[ik2,jk];
|
|
var lu := obnovA[ik1,jk1];
|
|
var ld := obnovA[ik2,jk1];
|
|
var ru := obnovA[ik1,jk2];
|
|
var rd := obnovA[ik2,jk2];
|
|
if u then
|
|
for var j:=jfirst+1 to jlast-1 do
|
|
ProcessCell(ifirst,j);
|
|
if d then
|
|
for var j:=jfirst+1 to jlast-1 do
|
|
ProcessCell(ilast,j);
|
|
if l then
|
|
for var i:=ifirst+1 to ilast-1 do
|
|
ProcessCell(i,jfirst);
|
|
if r then
|
|
for var i:=ifirst+1 to ilast-1 do
|
|
ProcessCell(i,jlast);
|
|
if u or l or lu then
|
|
ProcessCell(ifirst,jfirst);
|
|
if u or r or ru then
|
|
ProcessCell(ifirst,jlast);
|
|
if d or l or ld then
|
|
ProcessCell(ilast,jfirst);
|
|
if d or r or rd then
|
|
ProcessCell(ilast,jlast);
|
|
end;
|
|
obnovB[ik,jk] := obn;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
/// Ïåðåðèñîâêà ñîäåðæèìîãî îêíà
|
|
procedure LifeRedrawProc;
|
|
begin
|
|
Redraw;
|
|
DrawConfigurationFull;
|
|
end;
|
|
|
|
/// Âûâîä íîìåðà ïîêîëåíèÿ è êîëè÷åñòâà ÿ÷ååê
|
|
procedure DrawInfo;
|
|
begin
|
|
Brush.Color := clWhite;
|
|
TextOut(25,0,'Ïîêîëåíèå '+IntToStr(gen));
|
|
TextOut(WindowWidth - 130,0,'Æèòåëåé: '+IntToStr(CountCells)+' ');
|
|
end;
|
|
|
|
begin
|
|
SetConsoleIO;
|
|
if (m mod mk<>0) or (n mod nk<>0) then
|
|
begin
|
|
writeln('Ðàçìåð êëàñòåðà íå ñîãëàñîâàí ñ ðàçìåðîì ïîëÿ. Ïðîãðàììà çàâåðøåíà');
|
|
exit
|
|
end;
|
|
hm := m div mk;
|
|
hn := n div nk;
|
|
SetWindowSize(x0+m*w,y0+n*w);
|
|
CenterWindow;
|
|
Window.Title := 'Èãðà "Æèçíü"';
|
|
Window.IsFixedSize := True;
|
|
Font.Name := 'Arial';
|
|
Font.Size := 10;
|
|
Init;
|
|
|
|
LockDrawing;
|
|
DrawInfo;
|
|
DrawField;
|
|
DrawConfiguration;
|
|
UnLockDrawing;
|
|
|
|
var mil := Milliseconds;
|
|
gen := 0;
|
|
RedrawProc := LifeRedrawProc;
|
|
while True do
|
|
begin
|
|
gen += 1;
|
|
|
|
if gen mod 11 = 0 then
|
|
DrawInfo;
|
|
|
|
SosediA := SosediB;
|
|
obnovA := obnovB;
|
|
NextGen;
|
|
|
|
if gen mod 1000 = 0 then
|
|
begin
|
|
var mil1 := Milliseconds;
|
|
writeln(gen,' ',(mil1-mil)/1000);
|
|
mil := mil1;
|
|
end;
|
|
end;
|
|
end.
|