$ include "seed7_05.s7i";
include "stdio.s7i";
include "console.s7i";
include "window.s7i";
include "keybd.s7i";
const string: MARKEDFIELD is "#";
const string: EMPTYFIELD is " ";
const integer: MAXDIGITS is 7;
const integer: MINLINE is -114;
const integer: MAXLINE is 140;
const integer: MINCOLUMN is -87;
const integer: MAXCOLUMN is 168;
var text: scr is STD_NULL;
var text: win is STD_NULL;
var text: gen_win is STD_NULL;
var text: field_win is STD_NULL;
var text: cmd_win is STD_NULL;
var text: map_win is STD_NULL;
var text: header is STD_NULL;
var text: prot is STD_NULL;
const type: coord is new struct
var integer: lin is 0;
var integer: col is 0;
end struct;
const coord: COORD_REC is coord.value;
const type: fieldlinetype is array boolean;
const type: fieldtype is array fieldlinetype;
const type: listtype is array coord;
const type: workplace is new struct
var fieldtype: field is 0 times 0 times FALSE;
var listtype: bact_list is 8001 times COORD_REC;
end struct;
const workplace: WORKPLACE_REC is workplace.value;
var array workplace: workspace is 2 times WORKPLACE_REC;
var array integer: listlength is 2 times 0;
var integer: current is 1;
var integer: next is 0;
var integer: listindex is 0;
var integer: line is 0;
var integer: column is 0;
var boolean: singlestep is FALSE;
var boolean: quit is FALSE;
var integer: generation is 0;
const proc: textcolour (in integer: colour) is noop;
const proc: setbackground (in integer: colour) is noop;
const proc: info1 is func
begin
clear(scr);
setPos(win, 1, 1);
writeln(win, " L I F E");
writeln(win);
writeln(win, " The original game of life was invented by mathematician John Conway. The idea");
writeln(win, "is to initialize the screen with a pattern of bacteria in EDIT mode. The RUN");
writeln(win, "mode or singlestep commands then bring life to the colony. The population");
writeln(win, "increases and decreases according to fixed rules which affect the birth and");
writeln(win, "death of individual bacterium. A rectangular grid (2-dimensional matrix) will");
writeln(win, "be shown on the screen. Each cell in the grid can contain a bacterium or be");
writeln(win, "empty. Each cell has 8 neighbors. The existence of cells from one generation to");
writeln(win, "the next is determined by the following rules:");
writeln(win);
writeln(win, " 1. A bacteria with 2 or 3 neighbors survives from one generation to");
writeln(win, " the next. A bacterium with fewer neighbors dies of isolation.");
writeln(win, " One with more neighbors dies of overcrowding.");
writeln(win);
writeln(win, " 2. An empty cell spawns a bacteria if it has exactly three");
writeln(win, " neighboring cells which contain bacteria.");
writeln(win);
writeln(win);
write (win, " Press the any key to continue ");
end func;
const proc: info2 is func
begin
clear(scr);
setPos(win, 1, 1);
writeln(win, "In EDIT mode the following commands are available:");
writeln(win);
writeln(win, " Cursor keys Move the cursor I Show info pages");
writeln(win, " HJKL Move the cursor Q Quit the program");
writeln(win, " M or * Mark a cell + Scroll down");
writeln(win, " space Erase a cell - Scroll up");
writeln(win, " enter Calculate next generation < Scroll left");
writeln(win, " B Back to previous generation > Scroll right");
writeln(win, " R Enter the RUN mode backspace Erase cell left");
writeln(win, " C Clear the grid tab Forward 8 columns");
writeln(win, " D Redraw the screen shift-tab Backward 8 columns");
writeln(win, " G Load (get) state from file home First column");
writeln(win, " P Save (put) state to file end Last column");
writeln(win);
writeln(win);
writeln(win, "In RUN mode the following commands are available:");
writeln(win);
writeln(win, " any key to enter the EDIT mode to create or change the pattern");
writeln(win, " Q to Quit the game of LIFE");
writeln(win);
writeln(win);
writeln(win, "The EDIT and Quit commands take effect only at the end of a cycle.");
writeln(win);
write (win, " Press the any key to continue ");
end func;
const proc: nextDecimal is func
begin
if generation = 999999 then
generation := 0;
else
incr(generation);
end if;
setPos(gen_win, 1, 1);
write(gen_win, generation lpad MAXDIGITS);
end func;
const proc: writeHeader is func
begin
clear(header);
box(header);
setPos(header, 2, 10);
write(header, "SCIENTIFIC LIFE 2.0");
setPos(header, 5, 13);
write(header, "Copyright 1994");
setPos(header, 7, 19);
write(header, "by");
setPos(header, 9, 13);
write(header, "Thomas Mertes");
flush(header);
end func;
const proc: editInfo is func
begin
textcolour(0);
setbackground(7);
setPos(cmd_win, 1, 1);
write(cmd_win, " EDIT ");
textcolour(7);
setbackground(0);
setPos(cmd_win, 1, 7);
write(cmd_win, " I=Info, HJKL=Move, M=Mark, space=Erase, C=Clear, R=Run, Q=Quit ");
textcolour(15);
setPos(cmd_win, 1, 8);
write(cmd_win, "I");
setPos(cmd_win, 1, 16);
write(cmd_win, "HJKL");
setPos(cmd_win, 1, 27);
write(cmd_win, "M");
setPos(cmd_win, 1, 35);
write(cmd_win, "space");
setPos(cmd_win, 1, 48);
write(cmd_win, "C");
setPos(cmd_win, 1, 57);
write(cmd_win, "R");
setPos(cmd_win, 1, 64);
write(cmd_win, "Q");
end func;
const proc: clearScreen is func
local
var integer: index is 0;
begin
for index range 1 to listlength[current] do
setPos(field_win,
workspace[current].bact_list[index].lin + MINLINE,
workspace[current].bact_list[index].col + MINCOLUMN);
write(field_win, EMPTYFIELD);
end for;
end func;
const proc: writeScreen is func
local
var integer: index is 0;
begin
for index range 1 to listlength[current] do
setPos(field_win,
workspace[current].bact_list[index].lin + MINLINE,
workspace[current].bact_list[index].col + MINCOLUMN);
write(field_win, MARKEDFIELD);
end for;
end func;
const proc: writeMap (inout text: map_win) is func
local
var integer: index is 0;
var integer: line_div is 0;
var integer: column_div is 0;
var integer: line is 0;
var integer: column is 0;
var array array integer: mapfield is 0 times 0 times 0;
begin
mapfield := height(map_win) times width(map_win) times 0;
line_div := pred(length(workspace[current].field)) div pred(height(map_win)) ;
column_div := pred(length(workspace[current].field[1])) div pred(width(map_win));
for index range 1 to listlength[current] do
line := succ((workspace[current].bact_list[index].lin - 2) div line_div);
column := succ((workspace[current].bact_list[index].col - 2) div column_div);
if line >= 1 and line <= length(mapfield) and
column >= 1 and column <= length(mapfield[1]) then
incr(mapfield[line][column]);
end if;
end for;
box(map_win);
clear(map_win);
for line range 1 to height(map_win) do
for column range 1 to width(map_win) do
case mapfield[line][column] of
when {0}:
noop;
when {1, 2, 3, 4}:
setPos(map_win, line, column);
write(map_win, "1");
when {5, 6, 7, 8}:
setPos(map_win, line, column);
write(map_win, "2");
when {9, 10, 11, 12, 13}:
setPos(map_win, line, column);
write(map_win, "3");
when {14, 15, 16, 17}:
setPos(map_win, line, column);
write(map_win, "4");
when {18, 19, 20, 21, 22}:
setPos(map_win, line, column);
write(map_win, "5");
when {23, 24, 25, 26}:
setPos(map_win, line, column);
write(map_win, "6");
when {27, 28, 29, 30}:
setPos(map_win, line, column);
write(map_win, "7");
when {31, 32, 33, 34, 35}:
setPos(map_win, line, column);
write(map_win, "8");
when {36, 37, 38, 39}:
setPos(map_win, line, column);
write(map_win, "9");
when {40, 41, 42, 43, 44}:
setPos(map_win, line, column);
write(map_win, "0");
end case;
end for;
end for;
setPos(win, 3, 67);
write(win, "Living: ");
setPos(win, 3, 75);
write(win, str(listlength[current]));
setPos(win, 23, 67);
write(win, "Press a key");
end func;
const proc: redraw is func
begin
box(field_win);
clear(field_win);
editInfo();
setPos(gen_win, 1, 1);
write(gen_win, " ");
setPos(gen_win, 1, 1);
write(gen_win, generation lpad MAXDIGITS);
writeScreen();
end func;
const proc: shiftField (inout fieldtype: curr_field, inout listtype: curr_list,
in integer: lindiff, in integer: coldiff) is func
local
var integer: index is 0;
var integer: line is 0;
var integer: column is 0;
begin
for index range 1 to listlength[current] do
line := curr_list[index].lin;
column := curr_list[index].col;
curr_field[line][column] := FALSE;
setPos(field_win, line + MINLINE, column + MINCOLUMN);
write(field_win, EMPTYFIELD);
end for;
for index range 1 to listlength[current] do
line := curr_list[index].lin;
column := curr_list[index].col;
if line + lindiff >= 1 and line + lindiff <=
length(curr_field) then
line +:= lindiff;
curr_list[index].lin := line;
end if;
if column + coldiff >= 1 and column + coldiff <=
length(curr_field[1]) then
column +:= coldiff;
curr_list[index].col := column;
end if;
curr_field[line][column] := TRUE;
setPos(field_win, line + MINLINE, column + MINCOLUMN);
write(field_win, MARKEDFIELD);
end for;
end func;
const proc: mark (in integer: win_line, in integer: win_column) is func
begin
if not workspace[current].field[win_line - MINLINE][win_column - MINCOLUMN] then
workspace[current].field[win_line - MINLINE][win_column - MINCOLUMN] := TRUE;
incr(listlength[current]);
workspace[current].bact_list[listlength[current]].lin := win_line - MINLINE;
workspace[current].bact_list[listlength[current]].col := win_column - MINCOLUMN;
setPos(field_win, win_line, win_column);
write(field_win, MARKEDFIELD);
setPos(field_win, win_line, win_column);
end if;
end func;
const proc: erase (in integer: win_line, in integer: win_column) is func
local
var boolean: found is FALSE;
var integer: index is 0;
var integer: number is 0;
begin
if workspace[current].field[win_line - MINLINE][win_column - MINCOLUMN] then
if listlength[current] >= 1 then
found := FALSE;
index := listlength[current];
repeat
if workspace[current].bact_list[index].lin = win_line - MINLINE and
workspace[current].bact_list[index].col = win_column - MINCOLUMN then
found := TRUE;
else
decr(index);
end if;
until found or index < 1;
if found then
for number range index to pred(listlength[current]) do
workspace[current].bact_list[number].lin := workspace[current].bact_list[succ(number)].lin;
workspace[current].bact_list[number].col := workspace[current].bact_list[succ(number)].col;
end for;
decr(listlength[current]);
workspace[current].field[win_line - MINLINE][win_column - MINCOLUMN] := FALSE;
setPos(field_win, win_line, win_column);
write(field_win, EMPTYFIELD);
setPos(field_win, win_line, win_column);
else
redraw();
setPos(field_win, win_line, win_column);
end if;
end if;
end if;
end func;
const proc: clearField is func
local
var integer: index is 0;
begin
if listlength[current] <> 0 then
clearScreen();
next := current;
current := 3 - current;
for index range 1 to listlength[current] do
workspace[current].field
[workspace[current].bact_list[index].lin]
[workspace[current].bact_list[index].col] := FALSE;
end for;
listlength[current] := 0;
end if;
generation := 0;
setPos(gen_win, 1, 1);
write(gen_win, generation lpad MAXDIGITS);
end func;
const proc: readFilename (in string: prompt, inout string: filename) is func
local
var integer: startPos is 0;
var integer: pos is 0;
var char: ch is ' ';
begin
clear(cmd_win);
textcolour(0);
setbackground(7);
setPos(cmd_win, 1, 1);
write(cmd_win, prompt);
textcolour(7);
setbackground(0);
startPos := 3 + length(prompt);
setPos(cmd_win, 1, startPos);
filename := "";
pos := 0;
repeat
flush(cmd_win);
ch := getc(KEYBOARD);
if ch >= ' ' and ch <= '~' then
if pos <= 50 then
incr(pos);
filename := filename & str(ch);
setPos(cmd_win, 1, startPos + pos - 1);
write(cmd_win, filename[pos]);
end if;
elsif ch = '\b' then
if pos >= 1 then
decr(pos);
filename := filename[ .. pos];
setPos(cmd_win, 1, startPos + pos);
write(cmd_win, " ");
end if;
end if;
setPos(cmd_win, 1, startPos + pos);
until ch = '\n';
end func;
const proc: load (in string: filename) is func
local
var file: loadfile is STD_NULL;
var integer: index is 0;
var integer: line is 0;
var integer: column is 0;
var integer: startcolumn is 0;
var char: ch is ' ';
begin
loadfile := open(filename, "r");
if loadfile <> STD_NULL then
clear(field_win);
ch := getc(loadfile);
if ch = '+' then
read(loadfile, generation);
read(loadfile, line);
read(loadfile, startcolumn);
line -:= pred(MINLINE);
startcolumn -:= MINCOLUMN;
if line < 1 then
line := 1;
end if;
if startcolumn < 1 then
startcolumn := 1;
end if;
ch := getc(loadfile);
else
line := 1 - MINLINE;
startcolumn := 1 - MINCOLUMN;
end if;
index := 0;
while not eof(loadfile) and line <= MAXLINE - MINLINE - 1 do
column := startcolumn;
while ch <> '\n' do
if ch <> ' ' and ch <> '\r' and
column <= MAXCOLUMN - MINCOLUMN - 1 then
workspace[current].field[line][column] := TRUE;
incr(index);
workspace[current].bact_list[index].lin := line;
workspace[current].bact_list[index].col := column;
setPos(field_win, line + MINLINE, column + MINCOLUMN);
write(field_win, MARKEDFIELD);
end if;
incr(column);
ch := getc(loadfile);
end while;
incr(line);
ch := getc(loadfile);
end while;
listlength[current] := index;
setPos(gen_win, 1, 1);
write(gen_win, generation lpad MAXDIGITS);
close(loadfile);
end if;
end func;
const proc: save (in string: filename) is func
local
var file: savefile is STD_NULL;
var integer: index is 0;
var integer: startline is 0;
var integer: startcolumn is 0;
var integer: stopline is 0;
var integer: stopcolumn is 0;
var integer: end_of_current_line is 0;
var integer: line is 0;
var integer: column is 0;
var coord: current_element is COORD_REC;
begin
savefile := open(filename, "w");
if savefile <> STD_NULL then
startline := MAXLINE;
startcolumn := MAXCOLUMN;
stopline := MINLINE;
stopcolumn := MINCOLUMN;
for index range 1 to listlength[current] do
current_element := workspace[current].bact_list[index];
if current_element.lin < startline then
startline := current_element.lin;
end if;
if current_element.col < startcolumn then
startcolumn := current_element.col;
end if;
if current_element.lin > stopline then
stopline := current_element.lin;
end if;
if current_element.col > stopcolumn then
stopcolumn := current_element.col;
end if;
end for;
writeln(savefile, "+ " <& generation <& " " <&
startline + MINLINE - 1 <& " " <& startcolumn + MINCOLUMN);
for line range startline to stopline do
end_of_current_line := stopcolumn;
while end_of_current_line >= startcolumn and
not workspace[current].field[line][end_of_current_line] do
decr(end_of_current_line);
end while;
for column range startcolumn to end_of_current_line do
if workspace[current].field[line][column] then
write(savefile, "#");
else
write(savefile, " ");
end if;
end for;
writeln(savefile);
end for;
close(savefile);
end if;
end func;
const proc: pressakey is func
local
var string: stri is "";
begin
stri := gets(KEYBOARD, 1);
if stri <> "" then
if stri[1] = 'Q' or stri[1] = 'q' then
quit := TRUE;
end if;
end if;
end func;
const proc: editmode (inout boolean: quit) is func
local
var boolean: endEdit is FALSE;
var boolean: backstep is FALSE;
var integer: win_line is 0;
var integer: win_column is 0;
var integer: oldgeneration is 0;
var integer: help is 0;
var string: filename is "";
var char: ch is ' ';
begin
editInfo();
singlestep := FALSE;
win_line := 12;
win_column := 39;
setPos(field_win, win_line, win_column);
oldgeneration := 0;
backstep := FALSE;
endEdit := FALSE;
repeat
flush(field_win);
ch := getc(KEYBOARD);
case ch of
when {'H', 'h', KEY_LEFT}:
if win_column > 1 then
decr(win_column);
setPos(field_win, win_line, win_column);
end if;
when {'J', 'j', KEY_DOWN}:
if win_line < height(field_win) then
incr(win_line);
setPos(field_win, win_line, win_column);
end if;
when {'K', 'k', KEY_UP}:
if win_line > 1 then
decr(win_line);
setPos(field_win, win_line, win_column);
end if;
when {'L', 'l', KEY_RIGHT}:
if win_column < width(field_win) then
incr(win_column);
setPos(field_win, win_line, win_column);
end if;
when {' '}:
erase(win_line, win_column);
if win_column < width(field_win) then
incr(win_column);
setPos(field_win, win_line, win_column);
end if;
when {'\b'}:
if win_column > 1 then
decr(win_column);
setPos(field_win, win_line, win_column);
end if;
erase(win_line, win_column);
when {KEY_DEL}:
erase(win_line, win_column);
when {'\t'}:
if win_column + 8 < width(field_win) then
win_column +:= 8;
else
win_column := width(field_win);
end if;
setPos(field_win, win_line, win_column);
when {KEY_BACKTAB}:
if win_column - 8 > 1 then
win_column := win_column - 8;
else
win_column := 1;
end if;
setPos(field_win, win_line, win_column);
when {KEY_HOME}:
win_column := 1;
setPos(field_win, win_line, win_column);
when {KEY_END}:
win_column := width(field_win);
setPos(field_win, win_line, win_column);
when {'+', KEY_SFT_F1}:
shiftField(workspace[current].field,
workspace[current].bact_list, 1, 0);
setPos(field_win, win_line, win_column);
when {'-', KEY_SFT_F2}:
shiftField(workspace[current].field,
workspace[current].bact_list, -1, 0);
setPos(field_win, win_line, win_column);
when {'>', KEY_SFT_F3}:
shiftField(workspace[current].field,
workspace[current].bact_list, 0, 1);
setPos(field_win, win_line, win_column);
when {'<', KEY_SFT_F4}:
shiftField(workspace[current].field,
workspace[current].bact_list, 0, -1);
setPos(field_win, win_line, win_column);
when {KEY_NL}:
endEdit := TRUE;
singlestep := TRUE;
when {'M', 'm', '*'}:
mark(win_line, win_column);
if win_column < width(field_win) then
incr(win_column);
setPos(field_win, win_line, win_column);
end if;
when {'R', 'r'}:
endEdit := TRUE;
when {'D', 'd'}:
redraw();
setPos(field_win, win_line, win_column);
when {'C', 'c'}:
if listlength[current] <> 0 then
oldgeneration := generation;
end if;
clearField;
win_line := 12;
win_column := 39;
setPos(field_win, win_line, win_column);
when {'B', 'b'}:
clearScreen();
next := current;
current := 3 - current;
if not backstep then
backstep := TRUE;
if generation = 0 then
help := generation;
generation := oldgeneration;
oldgeneration := help;
else
oldgeneration := generation;
decr(generation);
end if;
else
help := generation;
generation := oldgeneration;
oldgeneration := help;
end if;
writeScreen();
setPos(gen_win, 1, 1);
write(gen_win, generation lpad MAXDIGITS);
setPos(field_win, win_line, win_column);
when {'O', 'o'}:
writeMap(map_win);
pressakey();
if not quit then
redraw();
setPos(field_win, win_line, win_column);
end if;
when {'I', 'i'}:
info1();
setPos(win, 1, 1);
pressakey();
if not quit then
info2();
setPos(win, 1, 1);
pressakey();
if not quit then
redraw();
setPos(field_win, win_line, win_column);
end if;
end if;
when {'P', 'p'}:
readFilename("SAVE?", filename);
if filename <> "" then
save(filename);
end if;
editInfo();
setPos(field_win, win_line, win_column);
when {'G', 'g'}:
readFilename("LOAD?", filename);
if filename <> "" then
load(filename);
end if;
editInfo();
setPos(field_win, win_line, win_column);
when {'Q', 'q'}:
quit := TRUE;
end case;
until endEdit or quit;
end func;
const proc: runinfo is func
begin
textcolour(0);
setbackground(7);
setPos(cmd_win, 1, 1);
write(cmd_win, " RUN ");
textcolour(7);
setbackground(0);
setPos(cmd_win, 1, 6);
write(cmd_win, " Q=Quit, any key=Edit -------------------------------------------");
textcolour(15);
setPos(cmd_win, 1, 7);
write(cmd_win, "Q");
setPos(cmd_win, 1, 15);
write(cmd_win, "any key");
end func;
const proc: init is func
begin
workspace[1].field :=
1 times
MAXCOLUMN - MINCOLUMN + 1 times TRUE &
(MAXLINE - MINLINE - 1) times
(1 times TRUE & MAXCOLUMN - MINCOLUMN - 1 times FALSE & 1 times TRUE) &
1 times
MAXCOLUMN - MINCOLUMN + 1 times TRUE;
workspace[2].field := workspace[1].field;
end func;
const proc: markcell (in integer: line, in integer: column, inout fieldtype: nextfield, inout listtype: nextlist) is func
begin
incr(listindex);
nextlist[listindex].lin := line;
nextlist[listindex].col := column;
nextfield[line][column] := TRUE;
setPos(field_win, line + MINLINE, column + MINCOLUMN);
write(field_win, MARKEDFIELD);
end func;
const proc: nextgeneration (in fieldtype: currfield, inout fieldtype: nextfield,
in listtype: currlist, inout listtype: nextlist) is func
local
var integer: index is 0;
var integer: neighbors is 0;
var boolean: cell1 is FALSE;
var boolean: cell2 is FALSE;
var boolean: cell3 is FALSE;
var boolean: cell4 is FALSE;
var boolean: cell5 is FALSE;
var boolean: cell6 is FALSE;
var boolean: cell7 is FALSE;
var boolean: cell33 is FALSE;
var boolean: cell55 is FALSE;
begin
for index range 1 to listlength[next] do
nextfield[nextlist[index].lin][nextlist[index].col] := FALSE;
end for;
listindex := 0;
for index range 1 to listlength[current] do
line := currlist[index].lin;
column := currlist[index].col;
cell2 := currfield[pred(line)][succ(column)];
cell3 := currfield[line][succ(column)];
cell4 := currfield[succ(line)][succ(column)];
cell5 := currfield[succ(line)][column];
cell6 := currfield[succ(line)][pred(column)];
cell7 := currfield[line][pred(column)];
cell33 := currfield[line][column + 2];
cell55 := currfield[line + 2][column];
if currfield[pred(line)][column] then
cell1 := TRUE;
neighbors := 1;
else
cell1 := FALSE;
neighbors := 0;
if (ord(cell2) + ord(cell3) + ord(cell7) +
ord(currfield[pred(line)][pred(column)]) +
ord(currfield[line - 2][pred(column)]) +
ord(currfield[line - 2][column]) +
ord(currfield[line - 2][succ(column)])) = 2 then
markcell(pred(line), column, nextfield, nextlist);
end if;
end if;
if cell2 then
incr(neighbors);
else
if not cell3 then
if (ord(cell1) + ord(cell33) +
ord(currfield[line - 2][column]) +
ord(currfield[line - 2][succ(column)]) +
ord(currfield[line - 2][column + 2]) +
ord(currfield[pred(line)][column + 2])) = 2 then
markcell(pred(line), succ(column), nextfield, nextlist);
end if;
end if;
end if;
if cell3 then
incr(neighbors);
else
if not (cell4 or cell5) then
if (ord(cell1) + ord(cell2) + ord(cell33) +
ord(currfield[succ(line)][column + 2]) +
ord(currfield[pred(line)][column + 2])) = 2 then
markcell(line, succ(column), nextfield, nextlist);
end if;
end if;
end if;
if cell4 then
incr(neighbors);
else
if not (cell5 or cell55 or
currfield[line + 2][succ(column)]) then
if (ord(currfield[line + 2][column + 2]) +
ord(cell3) + ord(cell33) +
ord(currfield[succ(line)][column + 2])) = 2 then
markcell(succ(line), succ(column), nextfield, nextlist);
end if;
end if;
end if;
if cell5 then
incr(neighbors);
else
if not (cell6 or cell7 or cell55 or
currfield[line + 2][pred(column)]) then
if (ord(cell3) + ord(cell4) +
ord(currfield[line + 2][succ(column)])) = 2 then
markcell(succ(line), column, nextfield, nextlist);
end if;
end if;
end if;
if cell6 then
incr(neighbors);
else
if cell5 and cell55 then
if not (cell7 or currfield[line + 2][pred(column)] or
currfield[line + 2][column - 2] or
currfield[succ(line)][column - 2] or
currfield[line][column - 2]) then
markcell(succ(line), pred(column), nextfield, nextlist);
end if;
end if;
end if;
neighbors := neighbors + ord(cell7) +
ord(currfield[pred(line)][pred(column)]);
if neighbors <> 2 and neighbors <> 3 then
setPos(field_win, line + MINLINE, column + MINCOLUMN);
write(field_win, EMPTYFIELD);
else
incr(listindex);
nextlist[listindex].lin := line;
nextlist[listindex].col := column;
nextfield[line][column] := TRUE;
end if;
end for;
listlength[next] := listindex;
end func;
const proc: main is func
local
var char: ch is ' ';
begin
scr := open(CONSOLE);
cursor(scr, TRUE);
win := openWindow(scr, 1, 1, 25, 80);
field_win := openWindow(scr, 2, 2, 23, 78);
gen_win := openWindow(scr, 1, 3, 1, 8);
cmd_win := openWindow(scr, 25, 2, 1, 78);
map_win := openWindow(scr, 2, 2, 23, 63);
header := openWindow(scr, 6, 21, 10, 38);
prot := openWindow(scr, 2, 2, 22, 20);
writeHeader();
quit := FALSE;
current := 1;
next := 2;
listlength[1] := 0;
listlength[2] := 0;
init();
box(field_win);
clear(field_win);
generation := 0;
clear(gen_win);
setPos(gen_win, 1, 1);
write(gen_win, generation lpad MAXDIGITS <& " ");
editmode(quit);
if not quit then
runinfo();
repeat
if singlestep then
nextDecimal();
nextgeneration(workspace[current].field, workspace[next].field,
workspace[current].bact_list, workspace[next].bact_list);
next := current;
current := 3 - current;
ch := KEY_NONE;
else
cursor(scr, FALSE);
repeat
nextDecimal();
nextgeneration(workspace[current].field, workspace[next].field,
workspace[current].bact_list, workspace[next].bact_list);
next := current;
current := 3 - current;
ch := getc(KEYBOARD, NO_WAIT);
until ch <> KEY_NONE;
cursor(scr, TRUE);
end if;
if ch = KEY_NONE then
ch := 'E';
end if;
if singlestep then
if ch <> '\r' then
editmode(quit);
runinfo();
end if;
else
if ch <> 'Q' and ch <> 'q' then
editmode(quit);
runinfo();
else
quit := TRUE;
end if;
end if;
until quit;
end if;
clear(scr);
end func;