1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:

Program Gol;
// Game of life als gol.dpr speichern
{$IFDEF FPC}
  {$Mode delphi}
{$ELSE}
  {$Apptype Console}
{$ENDIF}
uses
  sysutils,crt;

const
  colMax = 79;
  rowMax = 23;
//Feld um eine Zeile,Spalte  davor und dahinter erweitern,
//das laesst sich einfeacher bearbeiten, ohne Sonderregeln für den Rand
type
  tFeld = byte;
  tRow = array[0..colMax+1] of tFeld;//0..1 oder 0..3 /sum
  tprow = ^tRow;
  tBoard = array[0..rowMax+1] of tRow;
  tpBoard = ^tBoard;
  tpBoards = array[0..1] of tpBoard;
const
  dr = sizeOf(trow);
type
  tIntArr = array[0..2*dr+2] of tFeld;
  tpIntArr = ^tIntArr;

var
  aBoard,bBoard : tBoard;
  pBoards :tpBoards;
  gblAktBoard : integer;

  gblGenCount : integer;

function Survive(p: tpIntArr):byte;
//p zeigt auf aktuelles Board adresse [row-1,col-1]
const
  cSurvives : array[boolean,0..8] of integer=
              //0,1,2,3,4,5,6,7,8     Nachbarn
              ((0,0,0,1,0,0,0,0,0),   {alive =false}
               (0,0,1,1,0,0,0,0,0));  {alive =true}
var
  sum : integer;
begin
  // Zeile darueber
  // sum := byte(aBoard[row-1,col-1])+byte(aBoard[row-1,col])+byte(aBoard[row-1,col+1]);
  sum :=      integer(p[     0])+integer(p[    1]) +integer(p[     2]);
  sum := sum+ integer(p[  dr+0])                   +integer(p[  dr+2]);
  sum := sum +integer(p[2*dr+0])+integer(p[2*dr+1])+integer(p[2*dr+2]);

  survive := cSurvives[p[dr+1]<>0,sum];
end;

procedure Raender;
var
  p0 : tpIntArr;
  row: integer;
begin
  //Spalten ergaenzen
  p0 := @pBoards[gblAktBoard]^[1,0];
  For row := 1 to rowMax do
    begin
    p0^[0] := p0^[colMax];
    p0^[colmax+1] := p0^[1];
    p0 := Pointer(PtrUint(p0)+SizeOf(tRow));
    end;
  //oberste Zeile 1 nach unten rowMax+1 kopieren
  move(pBoards[gblAktBoard]^[1,0],pBoards[gblAktBoard]^[rowMax+1,0],sizeof(trow));
  //unterste Zeile rowMax nach oben 0 kopieren
  move(pBoards[gblAktBoard]^[rowMax,0],pBoards[gblAktBoard]^[0,0],sizeof(trow));
end;

procedure NextGen;
var
  p0,p1 : tpIntArr;
  col,row: integer;
begin
  Raender;
  For row := 1 to rowMax do
  begin
    p0 := @pBoards[gblAktBoard]^[row-1,0];
    p1 := @pBoards[1-gblAktBoard]^[row,0];
    For col := 1 to colMax do
      p1[col] := Survive(@p0[col-1]);
  end;
  //aBoard := bBoard;
  gblAktBoard :=1-gblAktBoard;
  inc(gblGenCount);
end;

procedure PrintGen;
const
  cChar: array[0..1] of char = (' ','#');
var
  p0 : tpIntArr;
  col,row: integer;
  s : string;
begin
  setlength(s,colmax);
  gotoxy(1,1);
  writeln(gblGenCount:10);
  For row := 1 to rowMax do
  begin
    p0 := @pBoards[gblAktBoard]^[row,0];;
    For col := 1 to colMax do
      s[col] := cChar[p0[col]];
    writeln(s);
  end;
end;

procedure Init;
var
  col,row : integer;
begin
  randseed := 1;
  clrscr;
  fillchar(aBoard,SizeOf(aBoard),#0);
  pBoards[0] := @aBoard;
  pBoards[1] := @bBoard;
  For row := 1 to rowMax do
    For col := 1 to colMax do
      aBoard[row,col]:= Byte(random>0.9);
  gblAktBoard := 0;
end;

var
  cnt : integer;
  T1,T0 :TDateTime;
begin
  Init;
  cnt := 100000;
  T0 := Time;
  repeat
    PrintGen;
    NextGen;
    dec(cnt);
  until (cnt <= 0) OR keypressed;
  // (Leerschleife also nur dec(cnt) etwa 24 ms ~ 840 CPU-Takte
  T1 := Time;
  Writeln((T1-t0)*86400*1000:0:3,' ms');
end.