language-Modula2-0.1: examples/Modula-2_Libraries/andrea-m2/applications/eth-hamburg/life/lifemodul.mod
IMPLEMENTATION MODULE LifeModule;
(* objects needed by Life and life Editor programs *)
(* John Andrea, Nov.16/ 1985 *)
(* This code may be freely used and distributed, it may not be sold. *)
FROM GetCharacter IMPORT Get, GetNoWait, StartGet, StopGet;
FROM Conversions IMPORT CardToString;
FROM VeryScreen IMPORT Home, EraseScreen, EraseLine,
PutCursor, CursorOn, PutString;
FROM InOut IMPORT WriteString, WriteLn, WriteCard,
ReadString, ReadLn, ReadCard, Read,
OpenInput, CloseInput, in;
FROM FileSystem IMPORT Eof, File, Done, EOL;
TYPE
GameType = (conway,con_mod,fredkin,fred_mod,other);
Description = ARRAY [0..80] OF CHAR;
VAR
row, col, population :CARDINAL;
c :CHAR;
game :GameType;
name :Description;
new, old :Generation;
(* ---------------------------------------------------- *)
PROCEDURE Genesis;
(* read a set of coordinates (row,col) of positions that are to
be set to ALIVE positions *)
VAR
input_line :CARDINAL;
row_min, row_max, col_min, col_max :CARDINAL;
BEGIN (* Genesis *)
row_min := 1; row_max := screen_row_max - screen_row_min + 1;
col_min := 1; col_max := screen_col_max - screen_col_min + 1;
population := 0;
new := all_dead;
(* read off the file description at line # 1 *)
Read(c);
col := 0;
WHILE (c # EOL) & (col < 80) DO
name[col] := c;
col := col + 1;
Read(c);
END; (* while *)
name[col] := 0C;
ReadLn;
input_line := 2;
(* read in the coordinates *)
ReadCard(row);
WHILE NOT Eof(in) DO
ReadCard(col); ReadLn;
IF (row >= row_min) & (row <= row_max) THEN
row := row + screen_row_min - 1;
ELSE
WriteString('row out of range, input line #');
WriteCard(input_line,4); WriteLn;
WriteString('min row = '); WriteCard(row_min,3);
WriteString('max row = '); WriteCard(row_max,3); WriteLn;
row := screen_row_min;
END; (* if *)
IF (col >= col_min) & (col <= col_max) THEN
col := col + screen_col_min - 1;
ELSE
WriteString('col out of range, input line #');
WriteCard(input_line,4); WriteLn;
WriteString('min col = '); WriteCard(col_min,3);
WriteString('max col = '); WriteCard(col_max,3); WriteLn;
col := screen_col_min;
END; (* if *)
population := population + 1;
new[row,col] := alive;
input_line := input_line + 1;
ReadCard(row);
END; (* while *)
END Genesis;
(* ---------------------------------------------------- *)
PROCEDURE Genesis2( VAR new :Generation; VAR population :CARDINAL);
(* read a set of coordinates (row,col) of positions that are to
be set to ALIVE positions *)
(* for MAKELIFE only, no error reporting *)
VAR
input_line :CARDINAL;
row_min, row_max, col_min, col_max :CARDINAL;
BEGIN (* Genesis *)
row_min := 1; row_max := screen_row_max - screen_row_min + 1;
col_min := 1; col_max := screen_col_max - screen_col_min + 1;
population := 0;
new := all_dead;
(* read off the file description at line # 1 *)
Read(c);
col := 0;
WHILE (c # EOL) & (col < 80) DO
name[col] := c;
col := col + 1;
Read(c);
END; (* while *)
name[col] := 0C;
ReadLn;
input_line := 2;
(* read in the coordinates *)
ReadCard(row);
WHILE NOT Eof(in) DO
ReadCard(col); ReadLn;
IF (row >= row_min) & (row <= row_max) THEN
row := row + screen_row_min - 1;
END; (* if *)
IF (col >= col_min) & (col <= col_max) THEN
col := col + screen_col_min - 1;
END; (* if *)
population := population + 1;
new[row,col] := alive;
input_line := input_line + 1;
ReadCard(row);
END; (* while *)
END Genesis2;
(* ----------------------------------------------------- *)
PROCEDURE ShowBirths( new, old :Generation; VAR changes :CARDINAL);
(* show the difference between the two generations *)
BEGIN (* ShowBirths *)
changes := 0;
(* run through the whole field *)
FOR row := screen_row_min TO screen_row_max DO
FOR col := screen_col_min TO screen_col_max DO
(* optimize screen updating, only change a position *)
(* if it needs changing *)
IF new[row,col] # old[row,col] THEN
changes := changes + 1;
PutString( ekg[new[row,col]], row, col );
END; (* if *)
END; (* for *) (* col *)
END; (* for *) (* row *)
END ShowBirths;
(* -------------------------------------------------- *)
PROCEDURE StartShow(name : Description);
(* put up the box and name *)
BEGIN (* StartShow *)
(* draw up a box around the playing field *)
FOR col := screen_col_min -1 TO screen_col_max +1 DO
PutString( '-', screen_row_min-1, col );
PutString( '-', screen_row_max+1, col );
END; (* for *)
FOR row := screen_row_min -1 TO screen_row_max +1 DO
PutString( '|', row, screen_col_min-1 );
PutString( '|', row, screen_col_max+1 );
END; (* for *)
(* put up the name *)
PutString( name, 1, 1 );
END StartShow;
(* ----------------------------------------------------- *)
PROCEDURE ShowGeneration( new :Generation );
(* put up a boundary and show the generation *)
VAR
screen_changes :CARDINAL;
BEGIN (* ShowGeneration *)
StartShow(name);
ShowBirths( new , all_dead , screen_changes );
END ShowGeneration;
(* ---------------------------------------------------- *)
PROCEDURE PlayGod;
(* keep generating new generations *)
TYPE
ContinueModes = ( step , go );
VAR
row, col :CARDINAL;
god_function :ARRAY [0..17] OF LifeFunction;
(* what to do with neighbours *)
diagnosis :ARRAY [dead..alive] OF CARDINAL; (* convert it to cardinal *)
c :CHAR;
generation :CARDINAL;
number :ARRAY [0..20] OF CHAR;
screen_changes :CARDINAL;
finished :BOOLEAN;
mode :ContinueModes;
(* --------------------------------------------------- *)
PROCEDURE GiveBirth;
(* make the next generation using the god_function *)
VAR
neighbours, naybor_row, naybor_col :CARDINAL;
new_population :CARDINAL;
BEGIN (* GiveBirth *)
new_population := 0;
(* run through the whole generation *)
FOR row := screen_row_min TO screen_row_max DO
FOR col := screen_col_min TO screen_col_max DO
neighbours := 0;
IF game = conway THEN
FOR naybor_row := row-1 TO row+1 DO
FOR naybor_col := col-1 TO col+1 DO
IF old[naybor_row,naybor_col] = alive THEN
neighbours := neighbours + 1;
END; (* if *)
END; (* for *) (* col *)
END; (* for *) (* row *)
IF old[row,col] = alive THEN
(* remove itself if necessary *)
neighbours := neighbours - 1;
END; (* if *)
neighbours := neighbours + diagnosis[old[row,col]]*9;
ELSIF game = con_mod THEN
FOR naybor_row := row-1 TO row+1 DO
FOR naybor_col := col-1 TO col+1 DO
IF old[naybor_row,naybor_col] = alive THEN
neighbours := neighbours + 1;
END; (* if *)
END; (* for *) (* col *)
END; (* for *) (* row *)
IF old[row,col] = alive THEN
(* remove itself if necessary *)
neighbours := neighbours - 1;
END; (* if *)
ELSIF game = fredkin THEN
IF old[row-1,col] = alive THEN
neighbours := neighbours + 1;
END; (* if *)
IF old[row+1,col] = alive THEN
neighbours := neighbours + 1;
END; (* if *)
IF old[row,col-1] = alive THEN
neighbours := neighbours + 1;
END; (* if *)
IF old[row,col+1] = alive THEN
neighbours := neighbours + 1;
END; (* if *)
ELSE (* modified fredkin *)
IF old[row-1,col-1] = alive THEN
neighbours := neighbours + 1;
END; (* if *)
IF old[row+1,col-1] = alive THEN
neighbours := neighbours + 1;
END; (* if *)
IF old[row-1,col+1] = alive THEN
neighbours := neighbours + 1;
END; (* if *)
IF old[row+1,col+1] = alive THEN
neighbours := neighbours + 1;
END; (* if *)
END; (* if *)
IF god_function[neighbours] = alive THEN
new[row,col] := alive;
new_population := new_population + 1;
ELSE
new[row,col] := dead;
END; (* if *)
END; (* for *) (* col *)
END; (* for *) (* row *)
population := new_population;
END GiveBirth;
(* ----------------------------------------------- *)
PROCEDURE DrawScreen;
BEGIN (* DrawScreen *)
(* initialize the screen *)
Home; EraseScreen;
IF game = conway THEN
PutString('Conways Game Of Life',title_row,title_col);
ELSIF game = con_mod THEN
PutString('Modified Conways',title_row,title_col);
ELSIF game = fredkin THEN
PutString('Fredkins Game Of Life',title_row,title_col);
ELSE
PutString('Modified Fredkins',title_row,title_col);
END; (* if *)
StartShow(name);
PutString('generation:',label_1_row,label_1_col);
PutString('population:',label_2_row,label_2_col);
(* option for menu's *)
PutString('give <CR> for next',menu_row,menu_col);
PutString('Q to quit',menu_row+1,menu_col);
PutString('G to not ask again',menu_row+2,menu_col);
END DrawScreen;
BEGIN (* PlayGod *)
WriteLn;
WriteString('Which type of Life, Conway or Fredkin'); WriteLn;
WriteString(' or Modified Conway or Modified Fredkin'); WriteLn;
WriteString('( C or F or D or G ) ? ');
(* WriteString(' C or F ? '); *)
ReadString(c); ReadLn; c := CAP(c);
WHILE (c # 'C') & (c # 'F') & (c # 'D') & (c # 'G') DO
WriteLn;
WriteString('( C or F or D or G ) ? ');
ReadString(c); ReadLn; c := CAP(c);
END; (* while *)
WriteLn;
(* convert dead,alive to a CARDINAL for function arithmetic *)
diagnosis[dead] := 0;
diagnosis[alive] := 1;
(* define the function to give life or death according to
the number of neighbours *)
FOR row := 0 TO 17 DO
god_function[row] := dead;
END; (* for *)
IF c = 'C' THEN
game := conway;
god_function[3] := alive;
god_function[11] := alive;
god_function[12] := alive;
ELSIF c = 'F' THEN
game := fredkin;
god_function[1] := alive;
god_function[3] := alive;
ELSIF c = 'G' THEN
(* modified fredkin rules are the same as fredkin,
except that it uses the 4 diagonal elements *)
game := fred_mod;
god_function[1] := alive;
god_function[3] := alive;
ELSE
(* modified conway rules are the same as conway
except that it uses the odd/even rules *)
game := con_mod;
god_function[1] := alive;
god_function[3] := alive;
god_function[5] := alive;
god_function[7] := alive;
god_function[9] := alive;
god_function[11] := alive;
god_function[13] := alive;
god_function[17] := alive;
END; (* if *)
DrawScreen;
CursorOn( FALSE );
StartGet;
c := ' ';
screen_changes := population;
generation := 1;
(* run the game, until zero-population or user says Quit *)
mode := step; finished := FALSE;
WHILE NOT finished DO
ShowBirths( new, old, screen_changes );
finished := ( population = 0 ) OR ( screen_changes = 0 );
(* generation number *)
CardToString( generation, 5, number );
PutString( number, label_1_row, label_1_col+12 );
(* population number *)
CardToString( population, 5, number );
PutString( number, label_2_row, label_2_col+12 );
IF NOT finished THEN
old := new; (* flip generations *)
GiveBirth;
generation := generation + 1;
IF mode = step THEN
Get(c);
IF ( c = 'Q' ) OR ( c = 'q' ) THEN
finished := TRUE;
ELSE
IF ( c = 'G' ) OR ( c = 'g' ) THEN
(* enter GO mode *)
(* no more options for menu's *)
PutCursor( menu_row, menu_col ); EraseLine;
PutCursor( menu_row+1, menu_col ); EraseLine;
PutCursor( menu_row+2, menu_col ); EraseLine;
mode := go;
PutCursor( q_row, q_col ); EraseLine;
PutString( 'press a character to stop', q_row, q_col);
END; (* if *)
END; (* if *)
ELSE (* already in GO mode *)
GetNoWait(c);
IF c # 0C THEN
(* return to step mode, and put back the option list *)
mode := step;
PutString('give <CR> for next',menu_row,menu_col);
PutString('Q to quit',menu_row+1,menu_col);
PutString('G to not ask again',menu_row+2,menu_col);
PutCursor( q_row, q_col ); EraseLine;
END; (* if *)
END; (* if *)
END; (* if *)
END; (* while *)
StopGet;
(* finish up *)
PutCursor( menu_row, menu_col ); EraseLine;
PutCursor( menu_row+1, menu_col ); EraseLine;
PutCursor( menu_row+2, menu_col ); EraseLine;
PutCursor( q_row, q_col ); EraseLine;
IF screen_changes = 0 THEN
PutString( 'population STABLE', menu_row, menu_col );
ELSE
IF population = 0 THEN
PutString( 'population EXTINCT', menu_row, menu_col );
ELSE
PutString( 'QUIT', menu_row, menu_col );
END; (* if *)
END; (* if *)
PutCursor( screen_row_max, 1 ); CursorOn( TRUE );
END PlayGod;
BEGIN (* LifeModule *)
(* make all of the old one DEAD *)
FOR row := screen_row_min-1 TO screen_row_max+1 DO
FOR col := screen_col_min-1 TO screen_col_max+1 DO
all_dead[row,col] := dead;
END; (* for *) (* col *)
END; (* for *) (* row *)
(* what the dead and alive elements look like *)
ekg[dead] := ' ';
ekg[alive] := '*';
END LifeModule.