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 из

любого места программы.

Страницы: 1, 2, 3