packages feed

language-Modula2-0.1: examples/Modula-2_Libraries/andrea-m2/applications/multiscope/defect/defect-x.mod

MODULE Defect;

(* Cellular Automata Defects *)
(* See A.K. Dewdney, Scientific American, Aug.89 "Computer Recreations *)

(* V4.0, jaa, Jun.22/93 -dynamic matricies *)
(* 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 RandomCard;
FROM InOut IMPORT WriteString, WriteInt, ReadInt, WriteLn;
FROM PackMatrix IMPORT Matrix, Build, Get, Put, Duplicate, Destroy;

CONST
  size  = 220;
  min_states = 8; max_states = 15;  (* number useful that is, 0-15 is range *)
  
  radius   = 1;
  offset   = 40;
  diameter = 2 * radius;
    
  old = 1;
  new = 2;
  
TYPE
  StateType = CARDINAL;
  StateRange = [0..max_states];

VAR
  space     :ARRAY [old..new] OF Matrix;
  neighbour :ARRAY [1..4] OF RECORD
                                 row, col :INTEGER;
                              END;

  state_wrap  :ARRAY StateRange OF StateType;
  s, s_to_eat :StateType;
  
  n_states   :INTEGER;
  
  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;
   
  WriteInt( n_states, 0 ); WriteString( ' states,' ); WriteLn;
  WriteString( 'in a space of ' ); WriteInt( size, 0 );
  WriteString( ' by ' ); WriteInt( size, 0 ); WriteLn;
  
  (* build the matricies *)
  Build( space[old], 0, max_states, size, size );
 
  (* 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;
  
  (* and define the wrap of states from one end to another *)
  FOR i := 1 TO n_states DO
     state_wrap[i] := i - 1;
  END;
  state_wrap[0]        := n_states;
  state_wrap[n_states] := 0;
   
  (* randomize the first space *)
  FOR i := 1 TO size DO
    FOR j := 1 TO size DO
      Put( space[old], i, j, RandomCard( n_states ) );
    END;
  END;
  Duplicate( space[old], space[new] );
  
  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      
       Circle( row, col, row, col+radius, Get( space[old], i, j ), 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[ Get( 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 Get( space[old], k, l ) = s_to_eat THEN
              Put( space[new], i, j, s_to_eat );
              m := 5; (* exit loop *)
            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 := Get( space[new], i, j );
         IF s # Get( space[old], i, j ) THEN
           (* there has been a change, so show it, and save it *)
           Circle( row, col, row, col+radius, s, TRUE );
           Put( 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;

  Destroy( space[old] ); Destroy( space[new] );
  
  Read( c );
  ScreenMode( screen_mode );
 
END Defect.