Программа эмуляции развития популяций животных
-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 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(' тонн травы');
-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 (g1000) 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);
-23-
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.
-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<=365) then col:='Декабрь';
mes:=col;
end;
{***********************************************************}
FUNCTION COLWORD;
VAR COLO:STRING;
BEGIN
IF COL=0 THEN COLO:='ЧЕРНЫЙ';
IF COL=1 THEN COLO:='СИНИЙ';
IF COL=2 THEN COLO:='ЗЕЛЕНЫЙ';
IF COL=3 THEN COLO:='ГОЛУБОЙ';
IF COL=4 THEN COLO:='КРАСНЫЙ';
IF COL=5 THEN COLO:='ФИОЛЕТОВЫЙ';
IF COL=6 THEN COLO:='КОРИЧНЕВЫЙ';
IF COL=7 THEN COLO:='СВЕТЛО-СЕРЫЙ';
IF COL=8 THEN COLO:='ТЕМНО-СЕРЫЙ';
IF COL=9 THEN COLO:='СВЕТЛО-СИНИЙ';
IF COL=10 THEN COLO:='СВЕТЛО-ЗЕЛЕНЫЙ';
IF COL=11 THEN COLO:='СВЕТЛО-ГОЛУБОЙ';
IF COL=12 THEN COLO:='СВЕТЛО-КРАСНЫЙ';
IF COL=13 THEN COLO:='СВЕТЛО-ФИОЛЕТОВЫЙ';
IF COL=14 THEN COLO:='ЖЕЛТЫЙ';
-27-
IF COL=15 THEN COLO:='БЕЛЫЙ';
COLWORD:=COLO;
END;
{***********************************************************}
procedure fon;
begin
textbackground(x);
end;
{***********************************************************}
procedure txt;
begin
textcolor(col);
end;
{***********************************************************}
procedure ramka; {вывести рамку}
const
a=#186;b=#187;c=#188;d=#200;e=#201;f=#205;
{T}
var i,j:integer;
begin
hiddencursor;
gotoxy(x1,y1);
write(e);
for i:=(x1+1) to (x2-1) do write(f);
write(b);
for i:=(y1+1) to (y2-1) do
begin
gotoxy(x1,i);
write(a);
gotoxy(x2,i);
write(a);
end;
gotoxy(x1,y2);
write(d);
for i:=(x1+1) to (x2-1) do write(f);
write(c);
hiddencursor;
end;
{***********************************************************}
procedure colorwind; {сделать окно с рамкой}
begin
window(v1,v2,v3,v4);
textbackground(fon);
clrscr;
textcolor(text);
ramka(1,1,v3-v1,v4-v2);
end;
{***********************************************************}
begin
end.
-28-
Приложение 4.
Инструкция пользователя.
Запустить на исполнение файл 'fauna.exe', который
должен находится в одном каталоге с файлом 'egavga.bgi'.
На экране появиться основное горизонтальное меню, с тремя пунктами:
'Start', 'Option', 'Quit'.
Активизация графического режима и запуск отображения на экран
произойдет при нажатии клавиш 's' или 'S'.
Выход из программы можно осуществить клавишами 'q' или 'Q'.
Активизация меню 'Option' произойдет при нажатии клавиш 'O' или 'o'.
В этом меню появиться три пункта - 'Herbivorous', 'Beast of prey',
'Environment'. При нажатии 'H' или 'h' будут задаваться параметры
травоядных. При нажатии 'B' или 'b' будут задаваться параметры хищников.
При нажатии 'E' или 'e' будут задаваться параметры окружающей среды. При
вводе параметров хищников, травоядных и окружающей среды надо следовать
подсказкам появляющимся внизу экрана.
При нажатии клавиши 'Esc' произойдёт выход в DOS из
любого места программы.
Страницы: 1, 2
|