ЖИВОТНЫХ
1. ВВЕДЕНИЕ.
Ради интереса было дано задание написать программу типа "Жизнь", но с некоторыми изменениями в начальных условиях.
Условия были таковы, что в эмуляции должны участвовать две популяции: хищники и травоядные, которые взаимодействовали бы друг с другом путем поедания травоядных хищниками.
В процессе разработки программы были введены дополнительные параметры:
- Возраст животных
- Минимальный и максимальный репродуктивный возраст животных
- Количество пищи нужный животным для поддержания жизни
- Количество травы
- Процент восстановления травы
- Вероятность природных катаклизмов влияющих напопуляции животных
2. ОСНОВНАЯ ЧАСТЬ.
2.1 Методика взаимодействия популяций.
Методика взаимодействий хищника и травоядного заключается в том,что и хищники, и травоядные представлены в виде точек, которые передвигаются по экрану с шагом в один пиксель. При этом заданноусловие, если в радиусе один пиксель от точки принадлежащей хищникупоявляется точка принадлежащая травоядному, то считается, что хищниксъел травоядного.
Способ передвижения точек на экране был организован по алгоритму случайного блуждания, т.е. передвижение по осям Х и Y с шагом в один пиксель выбирается случайным образом.
Умершие своей жизнью травоядные считаются, как съевшиеся хищниками.
При недоедании обеими популяциями, особи умирают в процессе уменьшения возраста, т.е. чем больше возраст животного, тем больше вероятность погибнуть от голода. Из-за больших промежуточных расчетов учет по недоеданию был выбран так, что хищники учитываются один раз в год, а травоядные двенадцать раз в год.
2.2 Описание программы.
Данная программа написана с использованием объектно-ориентированного языка Borland Pascal 7.1 и построена на обработке массивов типа tosob описанного в объектном модуле fauna1. Этот тип имеет следующие параметры:
x - расположение по координате Х экрана
y - расположение по координате Y экрана
age - возраст точки
col - цвет вывода на экран
Программа обеспечивает следующие операции:
- Задание параметров популяции травоядных
- Задание параметров популяции хищников
- Задание параметров окружающей среды
- Просмотр взаимодействия животных в графическом режиме
- Индикация результатов по выходу из режима просмотра взаимодействия животных
- Выход из программы
При помощи зарезервированного слова "uses" к программе подключается стандартные библиотечные модули TPCRT, GRAPH, DOS и библиотечные модули написанные программистом-разработчиком MYCRT и FAUNA1.
В разделе описания констант и переменных были объявленны следующие переменные:
- gd,gm типа integer для инициализации графики
- q,x,y,x1,y1,t,i,j,k,at,at1,ct1,ctp типа integer дляиспользования их в теле циклов
- g,m типа integer для задания начального количества животных
- v,w типа integer для задания максимального возраста животных
- ct,ch типа shortint для задания цвета отображаемых точек
- tmin,tmax,hmin,hmax,tp,hp типа integer для задания факторов влияющих на репродуктивность животных
- tt типа integer для учета умерших и съеденных травоядных
- kata типа integer для задания вероятности природных катаклизмов
- ht типа integer для задания количества травоядных нужных хищнику для пищи
- ttt типа real для задания количества травы нужных травоядному для пищи
- tr типа real для задания процента восстановления количества травы
- tree,tree1 типа longint для задания и модификации количества травы
- z типа longint для счетчика времени
- key типа boolean для отслеживания нажатия клавиш
- s,ss типа string размером в семнадцать символов для вывода на экран в графическом режиме
- pal типа FillPatternType стандартная переменная библиотеки
GRAPH для хранения типа и цвета заливки графических фигур объектов
- tg массив объемом 4400 точек типа tosob для хранения травоядных
- hr массив объемом 1350 точек типа tosob для хранения хищников
2.3 ОПИСАНИЕ БИБЛИОТЕКИ FAUNA1
В данной библиотеке описано два типа данных Tposition и Tosob. Тип Tposition имеет два параметра:
x - расположение по координате Х экрана
y - расположение по координате Y экрана
Задействованы функции:
getx - получение координаты Х
gety - получение координаты Y
А также процедура инициализации объекта init
Тип Tosob имеет четыре параметра:
x - расположение по координате Х экрана
y - расположение по координате Y экрана
age - возраст точки
col - цвет вывода на экран
Задействованы функции:
daizwet - получение цвета точки
daiage - получение параметра age
vidnoli - получение факта отображения на экране процедуры:
blind - гашение точки
show - отображение точки
init - создание объекта Tosob
done - уничтожение объекта Tosob
2.4 ОПИСАНИЕ БИБЛИОТЕКИ MYCRT
В данную библиотеку включены функции и процедуры предназначенные для работы в текстовом режиме.
Процедуры:
fon - задание цвета фона экрана
txt - задание цвета выводимых символов
ramka - вывод прямоугольника символами 186,187,188,200,201,205
colorwind - вывод окна с рамкой
Функции:
colword - преобразование чисел от одного до пятнадцати в
строку с наименованием цвета
mes - преобразование чисел от нуля до триста шестидесяти пяти в строку с названием месяца
2.4 ОПИСАНИЕ ОСНОВНОГО ТЕЛА ПРОГРАММЫ
В основном модуле программы включены процедуры:
ini - вывод на экран массивов hr и tr со стартовыми параметрами
tnew - движение точки принадлежащей массиву tr с проверкой возраста
hnew - движение точки принадлежащей массиву hr с проверкой возраста
trod - создание новых точек массива tr
hrod - создание новых точек массива hr
dead - процесс поглощения точки массива tr точкой массива hr
havka - процесс уничтожения точек массива tr в зависимости от значения переменной tt
tmor - процесс уничтожения случайного количества точек массива tr
hmor - процесс уничтожения случайного количества точек массива hr
zasux - подсчет переменной tree
quit - выход из программы
herb - организация ввода стартовых значений переменных для массива tr
beast - организация ввода стартовых значений переменных для массива hr
env - организация ввода значений переменных для задания переменных tree, tr, kata, q
info - организация информационного окна
gmenu - прорисовка основного меню
omenu - прорисовка меню Option
start - запуск графического режима и запуск основного цикла
komenu - организация меню Option
gkmenu - организация основного меню
3. ЗАКЛЮЧЕНИЕ
Данная программа представляет достаточно грубую модель жизнедеятельности и взаимодействия живых организмов. Однако, даже такое моделирование позволяет проследить основные моменты цикла жизни популяции. При возможном добавлении некоторых дополнительных факторов, моделирование может более приблизиться к реальной ситуации. Такими факторами могут являться:
- Сезонные изменения климата
- “Технология” охоты
- Окружающая флора и фауна
- Влияние жизнедеятельности человека
- Взаимодействие особей внутри популяции
Данная программа может служить в качестве учебного пособия по программированию на языке Pascal.
Приложение 1.
Основная программА
program fauna;
uses mycrt,dos,graph,fauna1,tpcrt;
var
q,x,y,x1,y1,gd,gm,t,i,j,k,AT,at1,ct1,ctp:integer;{общие}
g,v,m,w:integer;{}
ct,ch:shortint;{цвет}
tmin,tmax,hmin,hmax,tp,hp:integer;{детородность}
tt:integer;{трупы и съеденые травоядные за 1 год}
kata,ht:integer;
ttt,tr:real;
z,tree,TREE1:longint;
key:boolean;
s,ss:string[17];
tg:array[1..4400] of tosob; {green-травоядных}
hr:array[1..1350] of tosob; {red-хищников}
pal:FillPatternType;
{***********************************************************}
procedure ini;
begin
for i:=1 to g do
begin
at:=RANDOM(v)+1;
tg[i].init((random(630)+5),(random(462)+18),at,ct);
tg[i].show;
end;
for i:=1 to m do
begin
at:=random(w)+1;
HR[i].init((random(630)+5),(random(462)+18),at,ch);
hr[i].show;
end;
end;
{***********************************************************}
procedure tnew;
begin
I:=0;
REPEAT
I:=I+1;
begin
x:=tg[i].getx;
y:=tg[i].gety;
AT:=TG[I].DAIAGE;
CTP:=TG[I].DAIZWET;
if (z mod 365)=0 then
BEGIN
at:=at+1; {Happy New Year!}
TG[I].INIT(X,Y,AT,CTP);
END;
if at>v then {Old ?}
begin
tg[i].done;
tg[i].init(0,0,0,0);
tt:=tt+1;{умершее животное}
for j:=i+1 to g do
begin
x1:=tg[j].getx;
y1:=tg[j].gety;
at1:=tg[j].daiage;
ct1:=tg[j].daizwet;
tg[j].done;
tg[j-1].init(x1,y1,at1,ct1);
tg[j-1].show;
end;
TG[G].INIT(0,0,0,0);
G:=G-1;
I:=I-1;
CONTINUE;
end;
x:=tg[i].getx;
y:=tg[i].gety;
x:=x+(random(3)-1);
y:=y+(random(3)-1);
if x<5 then x:=6;if x>635 then x:=634;if y<17 then y:=18;
if y>480 then y:=479;
AT:=TG[I].DAIAGE;
CTP:=TG[I].DAIZWET;
tg[i].done;
IF CT<>0 THEN
BEGIN
tg[i].init(x,y,at,CTP);
tg[i].show;
END;
END;
UNTIL I>=G;
end;
{***********************************************************}
procedure trod;
begin
if (z mod 365)=0 then {Happy New Year!}
begin
t:=0;
for i:=1 to g do
begin
at:=tg[i].daiage;
if (tmin<=at) AND (AT<=tmax) then t:=t+1;
end;
t:=(t div 2);
x:=0;
if t>0 then
begin
FOR I:=1 TO T DO
begin
J:=RANDOM(TP);
x:=x+j;
end;
for y:=g+1 to g+1+x do
begin
tg[y].init((random(630)+5),(random(462)+18),0,ct);
tg[y].show;
if y>4100 then break;
end;
g:=g+1+x;
if g>4000 then
begin
key:=true;
end;
end
else
begin
end;
end;
end;
{***********************************************************}
procedure hnew;
begin
I:=0;
REPEAT
I:=I+1;
begin
x:=hr[i].getx;
y:=hr[i].gety;
At:=hr[I].DAIAGE;
CTp:=hr[I].DAIZWET;
if (z mod 365)=0 then
BEGIN
at:=at+1; {Happy New Year!}
hr[I].INIT(X,Y,At,CTp);
END;
if at>w then {Old ?}
begin
hr[i].done;
hr[i].init(0,0,0,0);
for j:=i+1 to m do
begin
x1:=hr[j].getx;
y1:=hr[j].gety;
at1:=hr[j].daiage;
ct1:=hr[j].daizwet;
hr[j].done;
hr[j-1].init(x1,y1,at1,ct1);
hr[j-1].show;
end;
hr[m].INIT(0,0,0,0);
m:=m-1;
I:=I-1;
CONTINUE;
end;
x:=hr[i].getx;
y:=hr[i].gety;
x:=x+(random(3)-1);
y:=y+(random(3)-1);
if x<5 then x:=6;if x>635 then x:=634;if y<17 then y:=18;
if y>480 then y:=479;
AT:=hr[I].DAIAGE;
CTp:=hr[I].DAIZWET;
hr[i].done;
IF CTp<>0 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 (hmin<=at) AND (AT<=hmax) then t:=t+1;
end;
t:=(t div 2);
if t>0 then
begin
x:=0;
FOR I:=1 TO T DO
begin
J:=RANDOM(hP);
x:=x+j;
end;
for y:=m+1 to m+1+x do
begin
hr[y].init((random(630)+5),(random(462)+18),0,ch);
hr[y].show;
end;
m:=m+1+x;
if (m>1000) or (m<=0) then
begin
key:=true;
end;
end;
end;
end;
{***********************************************************}
procedure dead;{хищники едят в радиусе 1 пиксель}
begin
for i:=1 to m do
begin
x:=hr[i].getx;
y:=hr[i].gety;
j:=0;
repeat
j:=j+1;
x1:=tg[j].getx;
y1:=tg[j].gety;
if ((x=x1)and(y=y1))or((x=x1)and(y=y1-1))or((x=x1)
and(y=y1+1))or((x=x1-1)and(y=y1))or((x=x1-1)and(y=y1-1))
or((x=x1-1)and(y=y1+1))or((x=x1+1)and(y=y1))or((x=x1+1)and
(y=y1-1))or((x=x1+1)and(y=y1+1))then
begin
tg[j].done;
tg[j].init(0,0,0,0);
tt:=tt+1;
k:=j;
repeat
k:=k+1;
x1:=tg[k].getx;
y1:=tg[k].gety;
at1:=tg[k].daiage;
ct1:=tg[k].daizwet;
tg[k].done;
tg[k-1].init(x1,y1,at1,ct1);
tg[k-1].show;
until k>=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 (x1<m) and (x1<>0) then
begin
repeat
j:=j+1;
if hr[j].daiage=y1 then
begin
hr[j].done;
hr[j].init(0,0,0,0);
for i:=j+1 to m do
begin
x:=hr[i].getx;
y:=hr[i].gety;
at1:=hr[i].daiage;
ct1:=hr[i].daizwet;
hr[i].done;
hr[i-1].init(x,y,at1,ct1);
HR[i-1].show;
end;
hr[m].init(0,0,0,0);
m:=m-1;
if m<=0 then
begin
key:=true;
break;
end;
end;
if j>=m then
begin
j:=0;
y1:=y1-1;
end;
if m<=0 then break;
until x1=m
end;
end;
end;
{***********************************************************}
procedure tmor;{мор травоядных}
begin
y:=g-x;
if x>0 then
begin
repeat
j:=random(g)+1;
tg[j].done;
tg[j].init(0,0,0,0);
tt:=tt+1;
for i:=j+1 to g do
begin
x1:=tg[i].getx;
y1:=tg[i].gety;
at1:=tg[i].daiage;
ct1:=tg[i].daizwet;
tg[i].done;
tg[i-1].init(x1,y1,at1,ct1);
tg[i-1].show;
end;
tg[g].done;
tg[g].init(0,0,0,0);
g:=g-1;
until y=g;
end;
end;
{***********************************************************}
procedure hmor;{мор хищников}
begin
y:=m-x;
if x>0 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);
end;
{***********************************************************}
procedure herb;{травоядные}
begin
colorwind(3,20,77,25,black,yellow);
gotoxy(32,1);
writeln('Правила ввода для травоядных');
gotoxy(2,2);write('Кол-во травоядных не более 3000.');
write(' Корм на месяц в килограммах. ');gotoxy(2,3);
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);
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 x<g then
begin
repeat
j:=random(g)+1;
tg[j].done;
tg[j].init(0,0,0,0);
tt:=tt+1;
for i:=j+1 to g do
begin
x1:=tg[i].getx;
y1:=tg[i].gety;
at1:=tg[i].daiage;
ct1:=tg[i].daizwet;
tg[i].done;
tg[i-1].init(x1,y1,at1,ct1);
tg[i-1].show;
end;
tg[g].done;
tg[g].init(0,0,0,0);
g:=g-1;
until x=g
end;
end;
end;
if g>0 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.
Библиотека 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;
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:='Июнь';
if (x>=181)and(x<=211) then col:='Июль';
if (x>=212)and(x<=241) then col:='Август';
if (x>=242)and(x<=272) then col:='Сентябрь';
if (x>=273)and(x<=303) then col:='Октябрь';
if (x>=304)and(x<=335) then col:='Ноябрь';
if (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:='ЖЕЛТЫЙ';
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.
Приложение 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 из
любого места программы.