 | | | | | |||||||
| | | | | |||||||
| |
| | | |||||||
| | | | | |||||||
| | | | |
|
Beispielprogramm in Turbo Pascal 6.0
program Lineare_zellulare_Automaten;
{Simulation von kuenstlichen Leben}
uses crt;
var Kette,Kette_Neu : array[1..80] of boolean;
Auswahl,Beenden : boolean;
procedure Anfangsbelegung;
var Wahl,j : byte;
hilfe : word;
begin
WriteLn('Festlegen des Ausgangszustandes der Automaten');
WriteLn('=============================================');
WriteLn;
WriteLn('1 - Belegung Tot-Lebend-Tot-Lebend...');
WriteLn('2 - Belegung Lebend-Tot-Lebend-Tot...');
WriteLn('3 - Zufällige Belegung');
WriteLn('4 - Eigene Belegung');
WriteLn;
Write('Wahl = ');
ReadLn(Wahl);
if Wahl=1 then
begin
for j:=1 to 40 do Kette[2*j-1]:=false;
for j:=1 to 40 do Kette[2*j]:=true;
end;
if Wahl=2 then
begin
for j:=1 to 40 do Kette[2*j-1]:=true;
for j:=1 to 40 do Kette[2*j]:=false;
end;
if Wahl=3 then
begin
Randomize;
for j:=1 to 80 do
begin
hilfe:=random(2);
if hilfe=0
then Kette[j]:=false
else Kette[j]:=true;
end;
end;
if Wahl=4 then
begin
ClrScr;
WriteLn('Eingabe von 0 für
Tot und 1 für Lebend');
WriteLn;
for j:=1 to 80 do
begin
Write('Automat[',j,']
= ');
ReadLn(hilfe);
if hilfe=0
then Kette[j]:=false
else Kette[j]:=true;
end;
end;
end;
procedure Ausgabe;
var i : byte;
begin
for i:=1 to 80 do
begin
if Kette[i]=true then write('Û')
else write(' ');
end;
end;
procedure Berechnung;
var i,j : byte;
begin
ClrScr;
WriteLn('Anzeigen und Beenden der Grafik mit ENTER');
ReadLn;
for i:=1 to 24 do
begin
Ausgabe;
Kette_Neu[1]:=Kette[1];
Kette_Neu[80]:=Kette[80];
for j:=2 to 79 do
begin
{Die folgenden Bedingungen stellen die Regeln für das
Leben der einzelnen Automaten dar. Natürlich können
diese verändert werden - viel Spaß beim Ausprobieren.}
if (Kette[j-1]=false)
and (Kette[j+1]=false)
then Kette_Neu[j]:=Kette[j];
if (Kette[j-1]=true)
and (Kette[j+1]=false)
then Kette_Neu[j]:=true;
if (Kette[j-1]=false)
and (Kette[j+1]=true)
then Kette_Neu[j]:=true;
if (Kette[j-1]=true)
and (Kette[j+1]=true)
then Kette_Neu[j]:=not(Kette[j]);
end;
for j:=1 to 80 do Kette[j]:=Kette_Neu[j];
end;
ReadLn;
end;
procedure Ende;
var Wahl : byte;
begin
ClrScr;
Beenden:=false;
WriteLn('1 - Programmstart');
WriteLn('2 - Beenden');
WriteLn;
Write('Auswahl = ');
ReadLn(Wahl);
if Wahl=2 then Beenden:=true;
ClrScr;
end;
begin
repeat
ClrScr;
Anfangsbelegung;
Berechnung;
Ende;
until Beenden=true;
end.
|
