Программа эмуляции развития популяций животных
трофы: 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);
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);
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 tree<=0 then
begin
key:=true;
g:=0;
m:=0;
end
else
begin
if x0 then tnew;{естественная смертность травоядных}
if m>0 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(' тонн травы');
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 (g<=0) or (m<=0) or (m>1000) then
key:=true;
setcolor(white);
bar(0,0,640,17);
moveto(0,0);
outtext('Травоядные Хищники Съедено
Трава Год');
setcolor(ct);moveto(0,10);str(g,s);outtext(s);
setcolor(ch);moveto(175,10);str(m,s);outtext(s);
setcolor(red);moveto(300,10);str(tt,s);outtext(s);
setcolor(green);moveto(400,10);str((tree),s);outtext(s);
setcolor(magenta);moveto(510,10);str((z div 365),s);
outtext(mes(z));outtext(' ');outtext(s);outtext(' года');
if (z mod 365)=0 then tt:=0;
until key=true;
closegraph;
end;
{***********************************************************}
procedure komenu;
var key:char;
begin
repeat
key:=readkey;
if (key='h') or (key='H') then
begin
herb;
window(40,10,80,25);
fon(black);
clrscr;
info;
omenu;
end;
if (key='B') or (key='b') then
begin
beast;
window(40,10,80,25);
fon(black);
clrscr;
info;
omenu;
end;
if (key='E') or (key='e') then
begin
env;
window(40,10,80,25);
fon(black);
clrscr;
info;
omenu;
end;
until key=#27;
quit;
CLRSCR;
end;
{***********************************************************}
PROCEDURE GKMENU;
var key2:char;
key1:boolean;
begin
gmenu;
info;
repeat
key2:=readkey;
if (key2='s') or (key2='S') then
begin
if(g>0)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.
Приложение 2.
Библиотека Fauna 1
{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;
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.
Приложение 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<=30) then col:='Январь';
if (x>=31)and(x<=58) then col:='Февраль';
if (x>=59)and(x<=89) then col:='Март';
if (x>=90)and(x<=119) then col:='Апрель';
if (x>=120)and(x<=150) then col:='Май';
if (x>=151)and(x<=180) then col:='
| |  скачать работу |
Программа эмуляции развития популяций животных |
