language-Modula2-0.1: examples/Modula-2_Libraries/andrea-m2/applications/multiscope/defect/defect.mod
MODULE Defect;
(* Cellular Automata Defects *)
(* See A.K. Dewdney, Scientific American, Aug.89 "Computer Recreations" *)
(* V4.0, J.Andrea, Jun.22/93 -general fixups *)
(* V3.2, jaa, Jun.13/93 -only 4 neighbours *)
(* V3.0, jaa, May.2/92 - eat neighbours *)
(* This code may be freely used and distributed, it may not be sold *)
FROM Break IMPORT EnableBreak;
FROM Graphics IMPORT gph16CHiRes, ScreenMode, GetScreenMode, Circle;
FROM Terminal IMPORT Read, KeyPressed;
FROM Random IMPORT RandomInt;
FROM InOut IMPORT WriteString, WriteInt, ReadInt, WriteLn;
CONST
size = 100;
min_states = 8; max_states = 15; (* number useful that is, 0-15 is range *)
first_state = 'a';
abs_last_state = 'o'; (* 15 - 1 past 'a' *)
radius = 2;
offset = 40;
diameter = 2 * radius;
old = 1;
new = 2;
TYPE
StateType = CHAR;
StateRange = [first_state..abs_last_state];
Space = ARRAY [1..size] OF ARRAY [1..size] OF StateType;
VAR
space :ARRAY [old..new] OF Space;
neighbour :ARRAY [1..4] OF RECORD
row, col :INTEGER;
END;
state_map :ARRAY StateRange OF INTEGER; (* clut *)
state_wrap :ARRAY StateRange OF StateType;
s, s_to_eat :StateType;
n_states :INTEGER;
last_state :StateType;
i, j, k, l, m :INTEGER;
screen_mode :INTEGER;
c :CHAR;
row, col :INTEGER;
changes :BOOLEAN;
BEGIN EnableBreak;
WriteString( 'how many states (' );
WriteInt( min_states, 0 ); WriteString( ' to ' );
WriteInt( max_states, 0 ); WriteString( ') ? ' );
ReadInt( n_states );
WriteLn;
IF n_states < min_states THEN n_states := min_states END;
IF n_states > max_states THEN n_states := max_states END;
last_state := CHR( ORD( first_state ) + CARDINAL(n_states) - 1 );
WriteInt( n_states, 0 ); WriteString( ' states,' ); WriteLn;
WriteString( 'in a space of ' ); WriteInt( size, 0 );
WriteString( ' by ' ); WriteInt( size, 0 ); WriteLn;
(* define the offsets of the neighbours *);
(* N *) neighbour[1].row := -1; neighbour[1].col := +0;
(* E *) neighbour[2].row := +0; neighbour[2].col := +1;
(* S *) neighbour[3].row := +1; neighbour[3].col := +0;
(* W *) neighbour[4].row := +0; neighbour[4].col := -1;
(* initialize the states as the first colours *)
i := 1;
FOR c := first_state TO last_state DO
state_map[c] := i;
i := i + 1;
END;
(* and define the wrap of states from one end to another *)
FOR c := first_state TO last_state DO
state_wrap[c] := CHR( ORD(c) - 1 );
END;
state_wrap[first_state] := last_state;
(* randomize the first space *)
FOR i := 1 TO size DO
FOR j := 1 TO size DO
k := INTEGER( ORD( first_state ) ) + RandomInt( n_states );
space[old][i,j] := CHR(k);
END;
END;
space[new] := space[old];
WriteLn;
WriteString( 'hit any key to start, then any key to quit' );
WriteLn;
Read( c );
GetScreenMode( screen_mode );
ScreenMode( gph16CHiRes );
(* draw the initial state *)
row := radius + offset;
FOR i := 1 TO size DO
col := radius;
FOR j := 1 TO size DO
s := space[old][i,j];
Circle( row, col, row, col+radius, state_map[s], TRUE );
col := col + diameter;
END;
row := row + diameter;
END;
(* now run the rest *)
WHILE NOT KeyPressed() DO
FOR i := 1 TO size DO
FOR j := 1 TO size DO
s_to_eat := state_wrap[ space[old][i,j] ];
m := 1;
WHILE m <= 4 DO
k := i + neighbour[m].row;
l := j + neighbour[m].col;
IF k = 0 THEN k := size ELSE IF k > size THEN k := 1 END; END;
IF l = 0 THEN l := size ELSE IF l > size THEN l := 1 END; END;
IF space[old][k,l] = s_to_eat THEN
space[new][i,j] := s_to_eat;
m := 5;
ELSE
m := m + 1;
END;
END;
END;
END;
(* display the new cells *)
changes := FALSE;
row := radius + offset;
FOR i := 1 TO size DO
col := radius;
FOR j := 1 TO size DO
s := space[new][i,j];
IF s # space[old][i,j] THEN
(* there has been a change, so show it, and save it *)
Circle( row, col, row, col+radius, state_map[s], TRUE );
space[old][i,j] := s;
changes := TRUE;
END;
col := col + diameter;
END;
row := row + diameter;
END;
(* put up a marker to say 'no changes' *)
IF NOT changes THEN
Circle( 10, 200, 10, 200+10, 15, TRUE );
END;
END;
Read( c );
ScreenMode( screen_mode );
END Defect.