Public feed
#381257
program Life;
uses crt;
const max=50; {maximalni velikost pole}
prezije=2; {pocet sousedu potrebnych k preziti bunky}
narodise=3; {pocet sousedu potrebnych k narozeni nove}
type pole=array[0..max,0..max+1] of boolean;
var novepole,starepole:pole;
velikost:byte;
znak,key:char;
vstupni_soubor:string[13];
t:text;
generace:longint;
uhyn:boolean;
{procedure nactipole; {nacte ze souboru nultou generaci
var i,j:byte;
begin read(vstupni_soubor);
if vstupni_soubor='' then vstupni_soubor:='vstupp.txt';
assign(t,vstupni_soubor);
reset(t);
j:=1;
i:=1;
while not eof(t) and (i<max) do
begin while (not eoln(t)) and (j<max) do
begin read(t,Znak); {nacte do charu
case Znak of
'a'..'z','A'..'Z' : novepole[i,j] := true;
else novepole[i,j] := false;
j:=j+1;
end;
readln(t); {skoci na dalsi radek t
i:=i+1;
end;
velikost:=i-1;
generace:=0;
close(t);
end;
end; }
procedure nactipole;
var i,j:byte;
begin readln(velikost);
for i:=1 to velikost do
begin for j:=1 to velikost do
begin read(znak);
case znak of
'a'..'z','A'..'Z' : novepole[i,j] := true;
else novepole[i,j] := false;
end;
readln;
end;
generace:=0;
end;
function prazdne(testpole:pole):boolean; {testuje zda generace nevymrela}
var i,j:byte;
begin prazdne:=true;
for i:=1 to velikost do
for j:=1 to velikost do
if testpole[i,j]=true then prazdne:=false;
end;
procedure novagenerace(minula:pole); {vytvari ze stare generace novou}
var i,j,k,l,sousedu:byte;
begin for i:=1 to velikost do
for j:=1 to velikost do
if minula[i,j]=false then
begin sousedu:=0;
for k:=i-1 to i+1 do
for l:=j-1 to j+1 do
if minula[k,l]=true then sousedu:=sousedu+1;
if sousedu>=narodise then novepole[i,j]:=true;
end
else begin sousedu:=0;
for k:=i-1 to i+1 do
for l:=j-1 to j+1 do
if minula[k,l]=true then sousedu:=sousedu+1;
if sousedu>=prezije then novepole[i,j]:=true;
end;
generace:=generace+1;
end;
procedure vypis(konecnepole:pole); {vypise generaci na obrazovku}
var i,j,k:byte;
begin clrscr;
for j:=1 to velikost do
begin k:=1;
for i:=1 to 2*velikost-1 do
if i mod 2=1 then
begin if konecnepole[j,k]=true then write('*')
else write(' ');
k:=k+1;
end
else write(' | ');
writeln;
for i:= 1 to 2*velikost-1 do write('- ');
end;
writeln('Generace cislo: ',generace);
writeln('ukoncit: ESC, jeden krok: SPACEBAR, jede samo: ENTER');
end;
procedure prepis(zpole,dopole:pole); {prepise generaci do stareho pole}
var i,j:byte; {aby se mohla vztvaret nova}
begin for i:=1 to velikost do {a vyprazdni novepole}
for j:=1 to velikost do
begin starepole[i,j]:=novepole[i,j];
novepole[i,j]:=false;
end;
end;
begin write('zadejte vstupni soubor:');
nactipole;
if prazdne(novepole) then write('zadana generace je prazdna')
else key:=#32;
repeat
begin vypis(novepole);
if KeyPressed then key := readkey;
{kdyz zmacknu, nacte key, jinak jede dal bez cekani}
if key=#27 then halt; {ESC zastavi}
if key=#32 then key:=readkey;
{SPACEBAR jeden krok a ceka na dalsi klavesu}
{na pocatku je key #32, takze pocka}
if key=#13 then delay(400);
{ENTER pocka a jede samo dal}
prepis(novepole,starepole);
uhyn:=prazdne(starepole);
novagenerace(starepole);
end;
until uhyn;
if uhyn then writeln('generace uhynula');
end.