Public feed #381257

Unnamed

public text v1 · immutable
Raw Edit
·published 2007-03-04 19:07 UTC
rendered paste body
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.