program GOL;
const
//calculation takes ~500 ns per pixel
{SETUP}
COL_MAX = 150; // width / SCALE
ROW_MAX = 100; // height / SCALE
DELAY_MS = 090; // ms delay between "frames"
LIFE_CHANCE = 10; // value 1-100. chance that a pixel will start "alive"
LIFE_COLOR = $0066ff; // color of "life"
SCALE = 04; // bitmap scale factor
{/SETUP}
ROW_COUNT = COL_MAX + 2;
type
TRow = array[0..COL_MAX + 1] of Byte;
TMat = array[0..ROW_MAX + 1] of TRow;
PMat = ^TMat;
PMats = array[0..1] of PMat;
TBArr = array[0..2*ROW_COUNT + 2] of Byte;
PBArr = ^TBArr;
var
MatA, MatB: TMat;
Mats: PMats;
CurrentMat: Byte;
procedure Init();
begin
Mats[0] := @MatA;
Mats[1] := @MatB;
CurrentMat := 0;
end;
procedure InitRandom();
var
b: Boolean;
x, y: Int32;
begin
Init();
for y := 1 to ROW_MAX do
for x := 1 to COL_MAX do
if (Random(1, 100) <= LIFE_CHANCE) then MatA[y, x] := 1
else MatA[y, x] := 0;
end;
procedure UpdateBitmap();
var
PTemp: PBArr;
x, y, BMP: Int32;
begin
BMP := CreateBitmap(COL_MAX, ROW_MAX);
try
for y := 1 to ROW_MAX do
begin
PTemp := @Mats[CurrentMat]^[y, 0];
for x := 1 to COL_MAX do
if (PTemp^[x]) then
FastSetPixel(bmp, x-1, y-1, LIFE_COLOR);
end;
StretchBitmapResize(bmp, COL_MAX * SCALE, ROW_MAX * SCALE);
DrawBitmapDebugImg(BMP);
finally
FreeBitmap(BMP);
end;
wait(DELAY_MS);
end;
procedure Torus();
var
PTemp: PBArr;
y: Int32;
begin
PTemp := @Mats[CurrentMat]^[1, 0];
for y := 1 to ROW_MAX do
begin
PTemp^[0] := PTemp^[COL_MAX];
PTemp^[COL_MAX + 1] := PTemp^[1];
PTemp := Pointer(Int32(PtrUInt(PTemp) + SizeOf(TRow)));
end;
MemMove(Mats[CurrentMat]^[1, 0], Mats[CurrentMat]^[ROW_MAX + 1, 0], SizeOf(TRow));
MemMove(Mats[CurrentMat]^[ROW_MAX, 0], Mats[CurrentMat]^[0, 0], SizeOf(TRow));
end;
function Survive(p: PBArr): byte;
const
SURVIVES: array[False..True] of array[0..8] of Byte =
[[0, 0, 0, 1, 0, 0, 0, 0, 0],
[0, 0, 1, 1, 0, 0, 0, 0, 0]];
var
Sum: int32;
begin
Sum := Int32(p^[0]) + Int32(p^[1]) + Int32(p^[2]);
Sum := Sum + Int32(p^[ROW_COUNT]) + Int32(p^[ROW_COUNT + 2]);
Sum := Sum + Int32(p^[2 * ROW_COUNT]) + Int32(p^[2 * ROW_COUNT + 1] + Int32(p^[2 * ROW_COUNT + 2]));
result := SURVIVES[Boolean(p^[ROW_COUNT + 1]), Sum];
end;
procedure NextGen();
var
pA, pB: ^Byte;
begin
Torus;
pA := @Mats[CurrentMat]^[0, 0];
pB := @Mats[1 - CurrentMat]^[1, 1];
for 1 to ROW_MAX do
begin
for 1 to COL_MAX do
begin
pB^ := Survive(PBarr(pA));
inc(pA);
inc(pB);
end;
inc(pA, 2);
inc(pB, 2);
end;
CurrentMat := 1 - CurrentMat;
end;
begin
ClearDebug();
DisplayDebugImgWindow(COL_MAX * SCALE, ROW_MAX * SCALE);
InitRandom();
repeat
UpdateBitmap();
NextGen();
until false;
UpdateBitmap();
end.