1
2(********************************************************************)
3(*                                                                  *)
4(*  cellauto.sd7  Simulate a one-dimensional cellular automaton     *)
5(*  Copyright (C) 2008  Thomas Mertes                               *)
6(*                                                                  *)
7(*  This program is free software; you can redistribute it and/or   *)
8(*  modify it under the terms of the GNU General Public License as  *)
9(*  published by the Free Software Foundation; either version 2 of  *)
10(*  the License, or (at your option) any later version.             *)
11(*                                                                  *)
12(*  This program is distributed in the hope that it will be useful, *)
13(*  but WITHOUT ANY WARRANTY; without even the implied warranty of  *)
14(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the   *)
15(*  GNU General Public License for more details.                    *)
16(*                                                                  *)
17(*  You should have received a copy of the GNU General Public       *)
18(*  License along with this program; if not, write to the           *)
19(*  Free Software Foundation, Inc., 51 Franklin Street,             *)
20(*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
21(*                                                                  *)
22(********************************************************************)
23
24
25$ include "seed7_05.s7i";
26  include "float.s7i";
27  include "draw.s7i";
28  include "keybd.s7i";
29
30
31const type: generationType is array boolean;
32
33
34const func generationType: nextGeneration (in bitset: rule,
35    in generationType: currGeneration) is func
36  result
37    var generationType: nextGeneration is 0 times FALSE;
38  local
39    var integer: index is 0;
40    var integer: pattern is 0;
41  begin
42    nextGeneration := length(currGeneration) times FALSE;
43    for index range 2 to pred(length(currGeneration)) do
44      pattern := ord(currGeneration[pred(index)]) * 4 +
45                 ord(currGeneration[index])       * 2 +
46                 ord(currGeneration[succ(index)]);
47      nextGeneration[index] := pattern in rule;
48    end for;
49  end func;
50
51
52const proc: drawGeneration (in integer: generationNumber,
53    in generationType: currentGeneration) is func
54  local
55    var integer: index is 0;
56  begin
57    for index range 1 to length(currentGeneration) do
58      if currentGeneration[index] then
59        point(index, generationNumber, black);
60      end if;
61    end for;
62  end func;
63
64
65const proc: main is func
66  local
67    const bitset: rule30 is bitset(30);
68    const bitset: rule110 is bitset(110);
69    var integer: generationNumber is 0;
70    var generationType: currentGeneration is 0 times FALSE;
71  begin
72    screen(1024, 768);
73    clear(white);
74    KEYBOARD := GRAPH_KEYBOARD;
75    currentGeneration := 1024 times FALSE;
76    currentGeneration[512] := TRUE;
77    drawGeneration(generationNumber, currentGeneration);
78    for generationNumber range 1 to 500 do
79      currentGeneration := nextGeneration(rule30, currentGeneration);
80      drawGeneration(generationNumber, currentGeneration);
81    end for;
82    flushGraphic;
83    ignore(getc(KEYBOARD));
84  end func;
85