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:

Program gameoflife;
uses crt;
var
     feld1,feld2 : array[0..21,0..21] of boolean;
     i,j:integer;
     taste:char;

procedure anfangswerte;
begin
     for i:=0 to 21 do for j:=0 to 21 do begin
         feld1[i,j]:=false; feld2[i,j]:=false;
         end;
     {Ausgangssituation Fünfer-Gruppe}
     feld1[5,5]:=true; feld1[6,5]:=true;
     feld1[6,6]:=true; feld1[7,6]:=true;
     feld1[6,7]:=true;
end;

procedure anzeige;
begin
    for i:=1 to 20 do for j:=1 to 20 do begin
       gotoxy(i+30,j);
       if feld1[i,j]=true then write('*') else write(' ');
       end;
end;

procedure neuegeneration;
var nachbarn:integer;
begin
     feld2:=feld1;
     for i:=1 to 20 do for j:=1 to 20 do begin
         nachbarn:=0;
         if feld2[i-1,j-1]=true then nachbarn:=nachbarn+1;
         if feld2[i,j-1]=true then nachbarn:=nachbarn+1;
         if feld2[i+1,j-1]=true then nachbarn:=nachbarn+1;
         if feld2[i-1,j]=true then nachbarn:=nachbarn+1;
         if feld2[i+1,j]=true then nachbarn:=nachbarn+1;
         if feld2[i,j+1]=true then nachbarn:=nachbarn+1;
         if feld2[i-1,j+1]=true then nachbarn:=nachbarn+1;
         if feld2[i+1,j+1]=true then nachbarn:=nachbarn+1;
       if nachbarn<2 then feld1[i,j]:=false;
       if nachbarn>3 then feld1[i,j]:=false;
       if nachbarn=3 then feld1[i,j]:=true;
     end;
end;

begin
    clrscr;
    anfangswerte;
   repeat
    anzeige;
    repeat
       taste:=readkey;
    until taste in ['e',' '];    {Taste ‚e’ für Abbruch, Leertaste … neue Generation}
    neuegeneration;
   until taste='e';
end.                    

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:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:

{$R+,G+}
PROGRAM GAME_OF_LIFE_NACH_ARTHUR_CONWAY;{ zuletzt ge„ndert am 3.11.1989 }
 USES CRT,READEXT;
 CONST ZE=25;SP=82;ZEICHEN:ARRAY[FALSE..TRUE]OF CHAR=('.','*');
 TYPE FELD=ARRAY[1..ZE,1..SP]OF BOOLEAN;
 VAR F,NF:FELD; RUNTER,RECHTS,MZ,MS,NZ,NS,ZEILE,SPALTE:BYTE;
     LOW_LEBEN,HIGH_LEBEN,LOW_GEBURT,HIGH_GEBURT,OZZI:BYTE;
     ANZAHL,MODUS,GZ,LEBENDIG,A,G:WORD; TASTE:CHAR;
     OK,ABBRUCH,GLEICH:BOOLEAN;
     SCREEN:WORD;
 FUNCTION HERC_CARD:BOOLEAN;
  VAR KARTE:BYTE ABSOLUTE $40:$49;
  BEGIN HERC_CARD:=KARTE=7 END;
 PROCEDURE BLINK;
  BEGIN TEXTBACKGROUND(0);TEXTCOLOR(31) END;
 PROCEDURE REVERSE;
  BEGIN TEXTBACKGROUND(7);TEXTCOLOR(0) END;
 PROCEDURE NORMAL;
  BEGIN NORMVIDEO;TEXTCOLOR(YELLOW);TEXTBACKGROUND(BLACK) END;
 PROCEDURE RAND;
  VAR Z,S:BYTE;
  BEGIN
   FOR S:=2 TO NS DO
    BEGIN F[MZ,S]:=F[2,S];F[1,S]:=F[NZ,S] END;
   FOR Z:=2 TO NZ DO
    BEGIN F[Z,MS]:=F[Z,2];F[Z,1]:=F[Z,NS] END;
  END;
 PROCEDURE LOESCHEN_NF;
   VAR Z,S:BYTE;
   BEGIN
    FOR Z:=1 TO MZ DO
     FOR S:=1 TO MS DO NF[Z,S]:=FALSE;
   END;{ OF LOESCHEN_NF }
 PROCEDURE AUSGABE(VAR LEBEN:WORD);
  BEGIN
    ASM
             MOV BX,SCREEN
             MOV ES,BX
             MOV DI,OFFSET F
             XOR DX,DX  { LEBEN:=0 }
             XOR BX,BX
             MOV BL,RECHTS
             ADD BL,BL
             MOV AL,RUNTER
             MOV CL,160
             MUL CL
             ADD AX,BX
             XCHG AX,BX
             ADD DI,83
             MOV CL,NZ
             DEC CL
     @FOR_Z: PUSH BX
             PUSH DI
             MOV AH,14
             MOV CH,NS
             DEC CH
     @FOR_S: MOV AL,[DI]
             CMP AL,1
             JNE @UNTEN
             INC DX
             MOV AL,'*'
             JMP @AUSGB
     @UNTEN: MOV AL,'.'
     @AUSGB: MOV ES:[BX],AL
             INC BX
             MOV ES:[BX],AH
             INC BX
             INC DI
             DEC CH
             JNE @FOR_S
             POP DI
             POP BX
             ADD BX,160
             ADD DI,82
             DEC CL
             JNE @FOR_Z
             LDS DI,LEBEN
             MOV [DI],DX
    END
  END;{ OF AUSGABE }
 PROCEDURE EINGABE;
  CONST HOCH=#72;CRUNTER=#80;LINKS=#75;CRECHTS=#77;
        PGUP=#73;PGDN=#81;HOME=#71;ENDE=#79;ENTER=#13;
  VAR Z:CHAR;
      X,Y:BYTE;
  BEGIN
   CLRSCR;AUSGABE(LEBENDIG);X:=NZ DIV 2;Y:=NS DIV 2;
   REPEAT
    GOTOXY(Y+RECHTS,X+RUNTER);
    Z:=READKEY;
    IF Z=#0 THEN IF KEYPRESSED THEN Z:=READKEY;
    CASE Z OF
     HOCH   : IF X=1 THEN X:=NZ-1 ELSE DEC(X);
     CRUNTER: IF X=NZ-1 THEN X:=1 ELSE INC(X);
     LINKS  : IF Y=1 THEN Y:=NS-1 ELSE DEC(Y);
     CRECHTS: IF Y=NS-1 THEN Y:=1 ELSE INC(Y);
     PGUP   : IF (X>1) AND (Y<NS-1) THEN BEGIN DEC(X);INC(Y) END;
     PGDN   : IF (X<NZ-1) AND (Y<NS-1) THEN BEGIN INC(X);INC(Y) END;
     HOME   : IF (X>1) AND (Y>1) THEN BEGIN DEC(X);DEC(Y) END;
     ENDE   : IF (X<NZ-1) AND (Y>1) THEN BEGIN INC(X);DEC(Y) END;
     ENTER  : BEGIN F[X+1,Y+1]:=NOT F[X+1,Y+1];WRITE(ZEICHEN[F[X+1,Y+1]]) END
    END
   UNTIL Z=#27;
   AUSGABE(LEBENDIG)
  END;
 PROCEDURE ZAEHLEN(Z,S:BYTE;VAR A:BYTE);
  BEGIN
   ASM
           MOV DI,OFFSET F
           MOV SI,OFFSET @ZAEHL  { SI = Zeiger auf ZAEHL im Codesegment }
           MOV AL,Z
           DEC AL
           DEC AL
           MOV BL,82
           MUL BL
           MOV BL,S
           DEC BL
           DEC BL
           XOR BH,BH
           ADD AX,BX
           ADD DI,AX
           MOV CX,8
           XOR AL,AL
   @FOR_Z: MOV BL,CS:[SI]
           MOV AH,[DI+BX]
           ADD AL,AH
           INC SI
           LOOP @FOR_Z
           JMP @ENDE
   @ZAEHL: DB 0,1,2,82,84,164,165,166
   @ENDE:  LES BX,A
           MOV ES:[BX],AL
   END
  END;{ OF ZŽHLEN }
 PROCEDURE WARTE;
  VAR C:CHAR;
  BEGIN REPEAT C:=READKEY UNTIL C=' ' END;

 PROCEDURE BERECHNEN;
  VAR L,Z,S:BYTE;
  BEGIN
   GLEICH:=TRUE;
   FOR Z:=2 TO NZ DO
    FOR S:=2 TO NS DO
     BEGIN
      ZAEHLEN(Z,S,L);
      IF F[Z,S] THEN NF[Z,S]:=(L>=LOW_LEBEN) AND (L<=HIGH_LEBEN)
      ELSE NF[Z,S]:=(L>=LOW_GEBURT) AND (L<=HIGH_GEBURT);
      GLEICH:=GLEICH AND (F[Z,S]=NF[Z,S]);
     END
  END;{ OF BERECHNEN }
 BEGIN{ OF MAIN }
  RANDOMIZE;CLRSCR;
  IF HERC_CARD THEN SCREEN:=$B000 ELSE SCREEN:=$B800;
  BLINK;WRITE('Game of Life nach Arthur Conway (Life 2333)':60);NORMAL;WRITELN;
  WRITELN('Dieses Programm simuliert primitive Lebensvorg„nge. Gegeben ist');
  WRITELN('ein rechteckiger Lebensraum. Jedes Feld dieses Lebensraumes kann');
  WRITE('von einem ');REVERSE;WRITE('lebendem');NORMAL;
  WRITELN(' Individuum besetzt sein oder nicht. Alle Felder');
  WRITE('des Lebensraumes werden ');REVERSE;WRITE('gleichzeitig');NORMAL;
  WRITELN(' nach folgenden Regeln ver„ndert :');WRITELN;
  WRITE('1. Ein Lebewesen ');REVERSE;WRITE('�berlebt');NORMAL;
  WRITELN(', wenn auf den 8 Nachbarfeldern zusammen');
  WRITELN('   mindestens 2 oder h”chstens 3 Lebewesen existieren.');
  WRITE('2. Ein Lebewesen ');REVERSE;WRITE('stirbt');NORMAL;
  WRITELN(',   wenn auf den 8 Nachbarfeldern zusammen');
  WRITELN('   weniger   als 2 Lebewesen existieren (sterben an Isolierung)');
  WRITELN('   oder mehr als 3 Lebewesen existieren (sterben an šberbev”lkerung.)');
  WRITE('3. Ein Lebewesen wird auf ein leeres Feld ');
  REVERSE;WRITE('geboren');NORMAL;WRITELN(', wenn auf den');
  WRITELN('   8 Nachbarfeldern zusammen genau 3 Lebewesen existieren.');
  GOTOXY(5,15);WRITE('Anzahl der Zeilen (10-23) : ');
  REPEAT
   OK:=TRUE;GOTOXY(32,15);NZ:=0;READBYTE(NZ,3);
   IF (NZ<10) OR (NZ>23) THEN OK:=FALSE
  UNTIL OK;
  INC(NZ);MZ:=NZ+1;
  GOTOXY(5,16);WRITE('Anzahl der Spalten (10-80) : ');
  REPEAT
   OK:=TRUE;GOTOXY(32,16);NS:=0;READBYTE(NS,3);
   IF (NS<10) OR (NS>80) THEN OK:=FALSE
  UNTIL OK;
  GOTOXY(5,17);WRITE('Lifeversion : ');
  REPEAT
   OK:=TRUE;GOTOXY(34,17);MODUS:=2333;READWORD(MODUS,4);
   IF (MODUS<2222) OR (MODUS>8888) THEN OK:=FALSE
   ELSE
    BEGIN
     LOW_LEBEN:=MODUS DIV 1000;HIGH_LEBEN:=(MODUS DIV 100)MOD 10;
     LOW_GEBURT:=(MODUS DIV 10) MOD 10;HIGH_GEBURT:=MODUS MOD 10;
     IF LOW_LEBEN>HIGH_LEBEN THEN OK:=FALSE;
     IF LOW_GEBURT>HIGH_GEBURT THEN OK:=FALSE;
     IF LOW_GEBURT=0 THEN OK:=FALSE
    END
  UNTIL OK;
  INC(NS);MS:=NS+1;LOESCHEN_NF;F:=NF;
  RUNTER:=(ZE-1-NZ) DIV 2;RECHTS:=(SP-1-NS) DIV 2;
  GOTOXY(5,19);WRITE('Lebewesen eingeben (J/N) ? ');
  REPEAT TASTE:=UPCASE(READKEY) UNTIL TASTE IN['J','N'];WRITELN(TASTE);
  IF TASTE='N' THEN
   BEGIN
    A:=0;
    GOTOXY(5,21);WRITE('Anzahl der Lebewesen (0-',(NS-1)*(NZ-1),') : ');
    REPEAT
     OK:=TRUE;GOTOXY(39,21);READWORD(A,4);
     IF (A<0) OR (A>(NS-1)*(NZ-1)) THEN BEGIN OK:=FALSE;A:=0 END
    UNTIL OK;
    GOTOXY(20,23);BLINK;WRITE('Ich');NORMAL;WRITE(' ');
    REVERSE;WRITE('rechne');NORMAL;WRITE(', bitte warten !');
    FOR G:=1 TO A DO
     BEGIN
      REPEAT
       ZEILE:=RANDOM(NZ-1)+2;SPALTE:=RANDOM(NS-1)+2;
      UNTIL (ZEILE IN[2..NZ]) AND (SPALTE IN[2..NS]) AND NOT F[ZEILE,SPALTE];
      F[ZEILE,SPALTE]:=TRUE
     END;CLRSCR;AUSGABE(LEBENDIG)
   END
  ELSE
   BEGIN
    GOTOXY(10,21);WRITE('Lebewesen setzen oder l”schen mit <ENTER>.');
    GOTOXY(10,22);WRITE('Das Eingeben wird mit <ESC> verlassen.');
    GOTOXY(25,24);WRITE('Weiter mit der Leertaste !');
    REPEAT TASTE:=READKEY UNTIL TASTE=' ';
    EINGABE
  END;
  GZ:=0;ABBRUCH:=FALSE;LEBENDIG:=0;OZZI:=0;RAND;
  REPEAT
   ANZAHL:=LEBENDIG;BERECHNEN;F:=NF;RAND;
   AUSGABE(LEBENDIG);INC(GZ); { WARTE;}
   IF ANZAHL=LEBENDIG THEN INC(OZZI);
   GOTOXY(20,MZ+RUNTER);CLREOL;
   WRITE(GZ:3,'-te Generation ',LEBENDIG,' Lebewesen !');
   IF KEYPRESSED THEN ABBRUCH:=TRUE
  UNTIL ABBRUCH OR GLEICH OR (LEBENDIG=0) OR (OZZI=9);
  GOTOXY(1,MZ+RUNTER);CLREOL;
  IF LEBENDIG=0 THEN
   BEGIN
    GOTOXY(20,MZ+RUNTER);
    WRITE('Nach der ',GZ,'-ten Generation ausgestorben !')
   END;
  IF (OZZI=9) AND NOT GLEICH THEN
   BEGIN
    GOTOXY(20,MZ+RUNTER);
    WRITE('Nach der ',GZ,'-ten Generation ozzilierend unver„ndert!')
   END;
  IF GLEICH THEN
   BEGIN
    GOTOXY(17,MZ+RUNTER);
    WRITE('Nach der ',GZ,'-ten Generation unver„ndert geblieben!')
   END;
  IF ABBRUCH THEN
   BEGIN
    GOTOXY(23,MZ+RUNTER);
    WRITE('Abbruch nach der ',GZ,'-ten Generation!')
   END;
  REPEAT TASTE:=READKEY UNTIL TASTE=#27
 END.