CONTINUE; end; x:=hr[i].getx; y:=hr[i].gety; x:=x+(random(3)-1); y:=y+(random(3)-1); if x635 then x:=634;if y480 then y:=479; AT:=hr[I].DAIAGE; CTp:=hr[I].DAIZWET; hr[i].done; IF CTp0 THEN BEGIN hr[i].init(x,y,at,CTp); hr[i].show; END; END; UNTIL I>=m; end; {**********************************************************} procedure hrod; begin if (z mod 365)=0 then {Happy New Year!} begin t:=0; for i:=1 to m do begin at:=hr[i].daiage; if (hmin1000) or (m=g;
TG[G].INIT(0,0,0,0);
G:=G-1; j:=j-1; end else begin end; until j>=g; end; end; {**********************************************************} procedure havka; begin if ((z mod 365)=0) and (tt>0) then begin x1:=(tt div ht);{сколько прокормилось в этом году} j:=0; y1:=w;{max vozrast} if x1=0 then begin for i:=1 to m do begin hr[i].init(0,0,0,0); hr[i].done; end; end; if (x10 then begin repeat j:=random(m)+1; hr[j].done; hr[j].init(0,0,0,0); for i:=j+1 to m do begin x1:=hr[i].getx; y1:=hr[i].gety; at1:=hr[i].daiage; ct1:=hr[i].daizwet; hr[i].done; hr[i-1].init(x1,y1,at1,ct1); hr[i-1].show; end; hr[m].done; hr[m].init(0,0,0,0); m:=m-1; until m=y; end; end; {***********************************************************} procedure zasux;{засуха} begin tree:=tree - random(round(tree/10)); end; {***********************************************************} procedure quit; begin window(1,1,80,25); fon(black); clrscr; GOTOXY(1,24); txt(White); WRITELN(' --------------------------------------------------
----------------------------'); txt(yellow); WRITELN(' Antony Sokolov | FidoNet 2:5078/20.4 AKA
2:5078/20.666 AKA 2:5078/22.666'); txt(White); WRITELN(' --------------------------------------------------
----------------------------'); end; {***********************************************************} procedure herb;{травоядные} begin colorwind(3,20,77,25,black,yellow); gotoxy(32,1); writeln('Правила ввода для травоядных'); gotoxy(2,2);write('Кол-во травоядных не более 3000.'); write(' Корм на месяц в килограммах. ');gotoxy(2,3);
-17-
write('Помет - кол-во детенышей. ');write('Цвет вывода от 1 до 15'); colorwind(40,10,65,19,black,green); gotoxy(6,1); txt(Yellow); write('Травоядные'); gotoxy(2,2); write('Кол-во: '); {начальное кол-во травоядных} readln(g); txt(yellow); gotoxy(2,3); write('Корм : ');{кол-во корма в год на одного травоядного} readln(ttt); ttt:=ttt/1000; gotoxy(2,4); write('Помет: '); {рождаемость} readln(tp); gotoxy(2,5); write('Min детородный: '); read(tmin); gotoxy(2,6); write('Max детородный: '); read(tmax); gotoxy(2,7); write('Max возрaст: '); read(v); gotoxy(2,8); write('Цвет вывода: '); read(ct); colorwind(3,20,77,25,black,black); end; {***********************************************************} procedure beast; {хищники} begin colorwind(3,20,77,25,black,yellow); gotoxy(32,1); writeln('Правила ввода для хищников'); gotoxy(2,2);write('Кол-во хищников не более 1000.'); write(' Корм - кол-во травоядных в год. ');gotoxy(2,3); write('Помет - кол-во детенышей. ');write('Цвет вывода от 1 до 15'); colorwind(40,10,65,19,black,red); gotoxy(8,1); txt(Yellow); write('Хищники'); gotoxy(2,2); txt(yellow); write('Кол-во: '); readln(m); gotoxy(2,3); write('Корм: ');{начальное кол-во хищников} readln(ht); gotoxy(2,4); write('Помет: ');{рождаемость}
-18-
readln(hp); gotoxy(2,5); write('Min детородный: '); {естественная смертность} read(hmin); gotoxy(2,6); write('Max детородный: '); {естественная смертность} read(hmax); gotoxy(2,7); write('Max возраст: '); {естественная смертность} read(w); gotoxy(2,8); write('Цвет вывода: '); read(ch); colorwind(3,20,77,25,black,black); end; {***********************************************************} procedure env ; {среда обитания} begin colorwind(3,20,77,25,black,yellow); gotoxy(32,1); writeln('Правила ввода для среды'); gotoxy(2,2);write('Кол-во травы не менее 1000.'); write('Процент восстановления любой.');gotoxy(2,3); write('Катастрофы: 0 или 1 - нет, 2 и более-есть.'); gotoxy(2,4); write('Задержка сообщений в мс. Рекомендуется не менее
1000'); colorwind(40,10,75,17,black,Magenta); gotoxy(13,1); txt(Yellow); write('Среда обитания'); gotoxy(2,2); txt(yellow); write('Кол-во травы: ');{Кол-во востанавливаемой пищи для травоядных в год} readln(tree); gotoxy(2,3); write('Процент восстановления: '); readln(tr); gotoxy(2,4); write('Наличие катастроф: '); readln(kata); gotoxy(2,5); write('Задержка сообщений: '); readln(q); colorwind(3,20,77,25,black,black); end; {***********************************************************} procedure info; begin fon(15); colorwind(1,4,70,16,black,Lightblue); txt(Green); gotoxy(2,2);write('Травоядных-',g,' Хищников-',m); str(ttt:1:2,s);
-19-
gotoxy(2,3); write(s,' т. травы и ',ht,' туш нужно на прокорм животных'); gotoxy(2,4); write('Max возраст травоядных ',v,', хищников ',w); gotoxy(2,5); write('Детородный возраст травоядных от ',tmin,' до ',tmax); gotoxy(2,6); write('Детородный возраст хищников от ',hmin,' до ',hmax); gotoxy(2,7); write('Помет травоядных до ',tp,', хищников до ',hp); gotoxy(2,8);write('Травы ',tree,' тонн '); str(tr:1:2,s); gotoxy(2,9);write('Прирост травы на каждый месяц ',s,'%'); if (kata=0) or (kata=1) then s:='отсутствует' else s:='присутствует'; gotoxy(2,10);write('Вероятность катаклизмов ',s); s:=colword(ct); gotoxy(2,11);write('Цвет травоядных ',s); s:=colword(ch); write(' Цвет хищников ',s); end; {***********************************************************} procedure Gmenu; begin fon(black); clrscr; colorwind(1,1,80,4,black,darkgray); txt(14); gotoxy(5,2); write(' S'); txt(white); write('tart '); txt(yellow); write('O'); txt(white); write('ption '); txt(yellow); write('Q'); txt(white); write('uit'); END; {***********************************************************} PROCEDURE Omenu; begin colorwind(45,3,62,8,black,darkgray); hiddencursor; txt(14); gotoxy(2,2); write('H'); txt(white); writeln('erbivorous'); txt(yellow); gotoxy(2,3); write('B'); txt(white);
-20-
writeln('east of prey'); txt(yellow); gotoxy(2,4); write('E'); txt(white); write('nvironment'); end; {***********************************************************} procedure start; begin randomize; gD := Detect; InitGraph(gD,gM,''); setfillpattern(pal,black); z:=0;{начало эры} tt:=0; {трупы и съеденные} ini; repeat key:=false; z:=z+1; if ((z mod 365)=0) or ((z mod 365)=31) or ((z mod 365)=59) or ((z mod 365)=90) or ((z mod 365)=120) or ((z mod 365)=151) or ((z mod 365)=181) or ((z mod 365)=212) or ((z mod 365)=242) or ((z mod 365)=273) or ((z mod 365)=303) or ((z mod 365)=334) then begin tree:=round(tree-g*ttt);{съели за месяц} tree:=tree+round(tree*(tr/100));{прирост травы в месяц} x:=round(tree*ttt);{травоядные умирают от недоедания} if tree0 then begin dead;{хищники едят травоядных} hnew;{естественная смертность хищников} havka;{хищники умирают от недоедания} hrod;{рождение хищников} end; if ((z mod 365)=180)and(g>0)and(m>0) then begin if random(kata)0 then begin x:=random(4); if x=0 then begin x:=random(round(g/50))+5; moveto(320,240);setcolor(Lightred);str(x,s);
Outtext('Болезнь травоядных унесла ');
Outtext(s);Outtext(' жизней '); tmor; end; if x=1 then begin x:=random(round(m/40))+1; moveto(320,240);setcolor(Lightred);str(x,s);
Outtext('Болезнь хищников унесла ');
Outtext(s);Outtext(' жизней'); hmor; end; if x=2 then begin zasux; moveto(320,240);setcolor(Lightred); str(tree1,s);Outtext('Засуха! Потеряно ');
Outtext(s);Outtext(' тонн травы'); delay(q); end; if x=3 then begin x:=random(round(g/50))+5; moveto(0,240);setcolor(Lightred);str(x,s);
Outtext('Наводнение погубило ');Outtext(s);Outtext(' травоядных, '); tmor; x:=random(round(m/40))+1; str(x,s);Outtext(s);Outtext(' хищников, '); hmor; zasux; str(tree1,s);Outtext(s);Outtext(' тонн травы');
-22-
delay(q); end; delay(q); bar(0,240,640,260); end; end; if g>0 then trod;{рождение травоядных} if g>4000 then break; if keypressed then key:=true ; if (g>4000) or (g0)and(m>0)and(ttt>0)and(tp>0)and(tmin>0)and(tmax>0) and(ct>0)and(ht>0)and(hp>0)and(hmin>0)and(hmax>0)and
(Ch>0)and(tree>0)and (tr>0)and(kata>0)then begin start; gmenu; info; key1:=false; end; end; if (key2='o')or(key2='O') then begin
Omenu; komenu;
GMENU; info; key1:=false; end; if (key2='q') or (key2='Q')or(key2=#27) then begin key1:=true; quit; end; until key1=true; end; {***********************************************************} {Body program} begin g:=1200;{травоядные кол-во} v:=30;{возраст травоядного} m:=200;{хищники кол-во} w:=25;{возраст хищника} ct:=yellow;ch:=red; tmin:=2;tmax:=28; hmin:=3;hmax:=24; tp:=3;hp:=7;{детородность} kata:=9; ht:=3; ttt:=1; tree:=1300; tr:=15.1; hiddencursor; GKMENU; end.
-24-
Приложение 2.
Библиотека Fauna1
{Init object} unit fauna1; interface uses graph; Type TPosition=object x,y : integer; procedure Init(x0,y0 : integer); function getx : integer; function gety : integer; end; type Tosob=object(TPosition) color : word; vidno : boolean;
AGE : INTEGER; constructor Init(x0,y0,age0:integer;col:word); destructor Done ; virtual ; procedure Show ; virtual ; procedure Blind ; virtual ; function Daizwet : word; function VidnoLi : boolean;
FUNCTION DAIAGE : INTEGER; end; Posob=^Tosob; {metod Tposition} Implementation Procedure Tposition.Init(x0,y0:integer); Begin x:=x0; y:=y0; End; Function Tposition.Getx:integer; Begin GetX:=x End; Function Tposition.Gety:integer; Begin Gety:=y End; Constructor Tosob.Init(x0,y0,age0:integer;col:word); Begin
Tposition.Init(x0,y0);
AGE:=AGE0; color:=col; vidno:=false; End; Destructor Tosob.Done; Begin
Tosob.blind; End; procedure Tosob.Show; Begin putpixel(TPosition.GetX, TPosition.GetY,color); vidno:=True; End; procedure Tosob.Blind;
-25-
Begin putpixel(TPosition.GetX, TPosition.GetY,GetBKColor); vidno:=False; End; Function Tosob.Daizwet : word; Begin Daizwet:=color End; Function Tosob.VidnoLi : Boolean; Begin VidnoLi:=Vidno End; FUNCTION TOSOB.DAIAGE:INTEGER; BEGIN DAIAGE:=AGE END; End.
-26-
Приложение 3.
Библиотека Mycrt
unit Mycrt;
interface uses tpcrt,dos; procedure fon(x:byte); procedure txt(col:byte); procedure ramka(x1,y1,x2,y2:integer); procedure colorwind(v1,v2,v3,v4,fon,text:byte); FUNCTION COLWORD(COL:BYTE):STRING; function mes(z:longint):string; implementation {***********************************************************} function mes; var col:string; x:integer; begin x:=z mod 365; if (x>=0)and(x=31)and(x=59)and(x=90)and(x=120)and(x=151)and(x=181)and(x=212)and(x=242)and(x=273)and(x=304)and(x=336)and(x
Страницы: 1, 2
