Simuluje život rastlín na políčku, ich rozmnožovanie a zánik
Delphi & Pascal (česká wiki)
Kategórie: Programy v Pascalu
Autor: Ľudovít Mydla
Program: Zivot.pas
Soubor exe: Zivot.exe
Soubor ubuntu: Zivot
Autor: Ľudovít Mydla
Program: Zivot.pas
Soubor exe: Zivot.exe
Soubor ubuntu: Zivot
Simuluje život rastlín na políčku, ich rozmnožovanie a zánik. Ako príklad použite 4 rastlinky a ich súradnice
{ 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; end.