Главная » Каталог    
рефераты Разделы рефераты
рефераты
рефератыГлавная

рефератыБиология

рефератыБухгалтерский учет и аудит

рефератыВоенная кафедра

рефератыГеография

рефератыГеология

рефератыГрафология

рефератыДеньги и кредит

рефератыЕстествознание

рефератыЗоология

рефератыИнвестиции

рефератыИностранные языки

рефератыИскусство

рефератыИстория

рефератыКартография

рефератыКомпьютерные сети

рефератыКомпьютеры ЭВМ

рефератыКосметология

рефератыКультурология

рефератыЛитература

рефератыМаркетинг

рефератыМатематика

рефератыМашиностроение

рефератыМедицина

рефератыМенеджмент

рефератыМузыка

рефератыНаука и техника

рефератыПедагогика

рефератыПраво

рефератыПромышленность производство

рефератыРадиоэлектроника

рефератыРеклама

рефератыРефераты по геологии

рефератыМедицинские наукам

рефератыУправление

рефератыФизика

рефератыФилософия

рефератыФинансы

рефератыФотография

рефератыХимия

рефератыЭкономика

рефераты
рефераты Информация рефераты
рефераты
рефераты

Программа эмуляции развития популяций животных


               Институт Переподготовки Кадров
    
Уральского Государственного Технического Университета
             Кафедра микропроцессорной техники
                                Оценка работы
                               Члены комиссии
       
ПРОГРАММА ЭМУЛЯЦИИ РАЗВИТИЯ 
            ПОПУЛЯЦИЙ ЖИВОТНЫХ
                       Курсовая работа
                    Пояснительная записка
         Руководитель
         Доцент                            С.С.Соколов
         Слушатель
         Группа СП-913                     А.А.Соколов
                        ЕКАТЕРИНБУРГ
                            1997
                       СОДЕРЖАНИЕ
           ПОСТАНОВКА
ЗАДАЧИ..............................-
           ВВЕДЕНИЕ.......................................3
           1. ОСНОВНАЯ
ЧАСТЬ..............................4
1.1. Методика взаимодействия популяций.........4
1.2. Описание программы........................5
1.3. Описание библиотеки Fauna1 ...............6
1.4. Описание библиотеки Mycrt ................7
1.5. Описание основного тела программы.........8
           2.
ЗАКЛЮЧЕНИЕ..................................9
           Приложение 1.
Основная программа...............10
           Приложение 2.
Библиотека Fauna1................24
           Приложение 3. Библиотека Mycrt.................26       
           Приложение 4.
Инструкция пользователя..........28
                           -3-
                     1. ВВЕДЕНИЕ.
     Ради интереса было дано задание написать
программу типа 
"Жизнь",
но с некоторыми изменениями в начальных условиях.
     Условия были таковы, что в эмуляции
должны участвовать
две
популяции: хищники и травоядные, которые взаимодействовали
бы друг с
другом путем поедания травоядных хищниками.
     В процессе разработки программы были
введены дополнительные
параметры:
     - Возраст животных
     - Минимальный и максимальный
репродуктивный возраст  
       животных
     - Количество пищи нужный животным для
поддержания жизни
     - Количество травы
     - Процент восстановления травы
- Вероятность природных катаклизмов
влияющих на 
  популяции
животных
                           -4-
                2. ОСНОВНАЯ  ЧАСТЬ.
        2.1 Методика
взаимодействия популяций.
                  
     Методика взаимодействий хищника и
травоядного заключается в том, что и
хищники, и травоядные представлены в виде точек, которые передвигаются по
экрану с шагом в один пиксель. При этом заданно условие,
если в радиусе один пиксель от точки принадлежащей хищнику появляется точка принадлежащая
травоядному, то считается, что хищник съел
травоядного.
     Способ передвижения точек на экране был
организован по алгоритму случайного блуждания, т.е. передвижение по осям Х и Y с шагом в один пиксель выбирается
случайным образом.
     Умершие своей жизнью травоядные
считаются, как съевшиеся хищниками.
     При недоедании обеими популяциями, особи
умирают в процессе уменьшения возраста, т.е. чем больше возраст животного, тем
больше вероятность погибнуть от голода. Из-за больших промежуточных расчетов
учет по недоеданию был выбран
так, что
хищники учитываются один раз в год, а травоядные двенадцать раз в год.
                           -5-
                 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 для хранения 
  хищников
                           -6-
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
                           -7-
              2.4  ОПИСАНИЕ БИБЛИОТЕКИ MYCRT
     В данную библиотеку включены функции и
процедуры предназначенные для работы в текстовом режиме.
Процедуры:
  fon      
- задание цвета фона экрана
  txt       - задание цвета выводимых символов
  ramka     - вывод прямоугольника символами 
              186,187,188,200,201,205
  colorwind
- вывод окна с рамкой
Функции:
  colword
- преобразование чисел от одного до пятнадцати в 
            строку с наименованием цвета
  mes     - преобразование чисел от нуля до триста
шестидесяти 
            пяти в строку с названием месяца
                           -8-
              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
- организация основного меню
    
                           -9-
                    3. ЗАКЛЮЧЕНИЕ
     Данная программа представляет достаточно
грубую модель жизнедеятельности и взаимодействия живых организмов. Однако, даже
такое моделирование позволяет проследить основные моменты цикла жизни
популяции. При возможном добавлении некоторых дополнительных факторов,
моделирование может более приблизиться к реальной ситуации. Такими факторами
могут являться:
 - Сезонные изменения климата
 - «Технология» охоты
 - Окружающая флора и фауна
 - Влияние жизнедеятельности человека
 - Взаимодействие особей внутри популяции
Данная
программа может служить в качестве учебного пособия по программированию на
языке Pascal.
                           -10-
                       
Приложение 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;
                           -11-
   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
                           -12-
   
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;
                           -13-
  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;
                           -14-
   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
                           -15-
     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;
{***********************************************************}
                           -16-
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);
 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 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;
                           -21-
      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(' тонн
травы');
                           -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 (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);
                           -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<=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:='ЖЕЛТЫЙ';
                           -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
из
любого места
программы.
program
fauna;
uses
mycrt,crt,dos,graph,fauna1;
 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;     {dvinuli samca}
   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;     {dvinuli samca}
  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;     {dvinuli samca}
   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;     {dvinuli samca}
  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;     {dvinuli samca}
    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
 tree1:=random(round(tree/50));
 tree:=tree-tree1;
end;
{***********************************************************************}
procedure
quit;
begin
  window(1,1,80,25);
  fon(black);
  clrscr;
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('Помет:          ');{рождаемость}
  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('Прирост
травы на каждые 0,2 года ',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
 cursor(false);
 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');
 cursor(true);
END;
{*************************************************************************}
PROCEDURE
Omenu;
begin
 colorwind(45,3,62,8,black,darkgray);
 cursor(false);
 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');
 cursor(true);
end;
{*************************************************************************}
procedure
start;
begin
 randomize;
 gD := Detect;
 InitGraph(gD,gM,'d:\bp\bgi');
 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
   tree1:=tree;
   tree:=round((tree-g*ttt)+(tree*(tr/100)));{прирост
травы в месяц}
   x:=round(tree1*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') then
  begin
   key1:=true;
   quit;
  end;
 until key1=true;
end;
{*************************************************************************}
{Body
program}
begin
GKMENU;
end.
{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;
{}
{Crea
Object}
{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.
unit
Mycrt;
interface
uses
crt,dos;
procedure
fon(x:byte);
procedure
txt(col:byte);
procedure
cursor(flag:boolean);
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<=364) 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
cursor;{убрать,показать курсор}
const
  sizecursor: word=0;
var
 r:registers;
 begin
  with r do
   begin
    if flag then cx:=sizecursor else
     begin
      bh:=0;{страница}
      ah:=03;
      intr($10,r);
      sizecursor:=cx;
      ch:=20;{hidecursor}
     end;
    ah:=01;{function set sizecursor}
    intr($10,r);
   end;
 end;
{*************************************************************************}
procedure
ramka;  {вывести рамку}
 const
  {Л}
  a=#186;b=#187;c=#188;d=#200;e=#201;f=#205;
  {В}
{  a=#179;b=#191;c=#217;d=#192;e=#218;f=#196;}
 var i,j:integer;
 begin
  cursor(false);
  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);
  cursor(true);
 end;
{*************************************************************************}
procedure
colorwind;   {сделать окно с рамкой}
 begin
  window(v1,v2,v3,v4);
  textbackground(fon);
  clrscr;
  textcolor(text);
  ramka(1,1,v3-v1,v4-v2);
 end;
{*************************************************************************}
begin
end.
рефераты Рекомендуем рефератырефераты

     
Рефераты @2011