Umiestnenie súboru www.TrSek.com/pas/zivot.pas{ ZIVOT.PAS Copyright (c) Ludovit Mydla }
{ Simuluje zivot rastlin na policku }
{ Vstup : rozmiestnenie rastlin }
{ Vystup: semigraficke znazornenie rastlin }
{ Priklad: 4 rastlinky a suradnice [1,2], [1,3], [2,2], [2,3] }
{ }
{ Datum:10.04.2003 http://www.trsek.com }
program zivot;
uses crt;
var sus,kvet:array[1..10,1..10] of integer;
ras,poc:integer;
k:char;
{ zisti suseda rastlinke }
procedure ZistiSuseda;
var i,j:integer;
begin
for i:= 1 to 10 do begin
for j:= 1 to 10 do begin
sus[i,j]:=0;
if ((i<10) and (j<10) and (kvet[i+1,j+1]=2)) then inc( sus[i,j]);
if ((i<10) and (kvet[i+1,j ]=2)) then inc( sus[i,j]);
if ((i<10) and (j> 1) and (kvet[i+1,j-1]=2)) then inc( sus[i,j]);
if ((j<10) and (kvet[i ,j+1]=2)) then inc( sus[i,j]);
if ((i> 1) and (j<10) and (kvet[i-1,j+1]=2)) then inc( sus[i,j]);
if ((j> 1) and (kvet[i ,j-1]=2)) then inc( sus[i,j]);
if ((i> 1) and (j> 1) and (kvet[i-1,j-1]=2)) then inc( sus[i,j]);
if ((i> 1) and (kvet[i-1,j ]=2)) then inc( sus[i,j]);
end;
end;
end;
{ priebeh mnozenia }
procedure Mnozenie(i,j:integer);
begin
if ((i<10) and (j<10) and (kvet[i+1,j+1]=0)) then kvet[i+1,j+1]:=1;
if ((i<10) and (kvet[i+1,j ]=0)) then kvet[i+1,j ]:=1;
if ((i<10) and (j> 1) and (kvet[i+1,j-1]=0)) then kvet[i+1,j-1]:=1;
if ((j<10) and (kvet[i ,j+1]=0)) then kvet[i ,j+1]:=1;
if ((j> 1) and (kvet[i ,j-1]=0)) then kvet[i ,j-1]:=1;
if ((i> 1) and (j>10) and (kvet[i-1,j+1]=0)) then kvet[i-1,j+1]:=1;
if ((i> 1) and (kvet[i-1,j ]=0)) then kvet[i-1,j ]:=1;
if ((i> 1) and (j> 1) and (kvet[i-1,j-1]=0)) then kvet[i-1,j-1]:=1;
end;
procedure ZistiDalej;
var i,j:integer;
begin
for i:= 1 to 10 do begin
for j:= 1 to 10 do begin
if (sus[i,j]<=2) and (kvet[i,j]=2) then kvet[i,j]:=0;
if (sus[i,j]>=5) and (kvet[i,j]=2) then kvet[i,j]:=0;
if (sus[i,j]>2) and (sus[i,j]<5) and (kvet[i,j]=2) then mnozenie(i,j);
end;
end;
end;
procedure VynulujMlade;
var i,j:integer;
begin
for i:= 1 to 10 do
for j:= 1 to 10 do
if kvet[i,j]=1 then kvet[i,j]:=2;
end;
{ semigraficke zobrazenie stavu rastliniek }
procedure Vykresli;
var i,j:integer;
begin
clrscr;
for i:=1 to 10 do begin
for j:=1 to 10 do begin
if kvet[i,j]=0 then
begin
textcolor(darkgray);
gotoxy(i*4,j*2);Write('');
end;
if kvet[i,j]=2 then
begin
textcolor(green);
gotoxy(i*4,j*2);Write('');
end;
end;
end;
end;
{ precita z klavesnice kde su zasadene rastlinky }
procedure Nacitaj;
var x,y:integer;
begin
for poc:=1 to ras do
begin
clrscr;
Writeln('Zadajte polohu ',poc,'. rastliny (v tvare x,y)');
Readln(x,y);
kvet[x,y]:=2;
end;
end;
{ hlavny program }
begin
clrscr;textcolor(white);
Writeln('Zadajte pocet rastlin (maximalne 10)');
Readln(ras);
Nacitaj;
poc:=1;
Repeat
Vykresli;
textcolor(white);Gotoxy(56,24);Write(poc,'. rok (stlac ENTER)');
poc:=poc+1;
k:=Readkey;
ZistiSuseda;
ZistiDalej;
VynulujMlade;
Until k=#27;