This repository has been archived on 2024-12-25. You can view files and clone it, but cannot push or open issues or pull requests.
2024-03-10 20:32:51 +03:00

319 lines
14 KiB
ObjectPascal
Raw Permalink Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

uses GraphABC;
const types = 3; //число типов рыб минус 1
rmax = 4; //радиус всех рыб
CanEat = rmax; //максимальное расстояние при поедании
eps = 0.00001; //необходимо при операциях с данными real
epsustupi = 0.1; //насколько значима иерархия среди хищников
strahkraj = 3; //во сколько раз жертвы боятся края меньше, чем хищников
ustupi = CanEat*10; //насколько значима иерархия среди хищников
BkColor = clBlack; //Фон
Height = 600; //Высота графического окна
Width = 780; //Ширина графического окна
xmin = 10; //
ymin = 10; //Минимальные и максимальные значения координат,
xmax = Width - 100; //которые могут принимать рыбы
ymax = Height - 140; //
Type
fishtype = class //Описание одной стаи
c : color;
public
CanRazm, MaxKol, Kol, MaxLife, MinFood: integer;
//цвет, размножение, макс. кол-во, текущее кол-во, макс. жизнь,
//сколько хищнику нужно есть для размножения
Speed, See: real; //Нормальная скорость и зрение в пикселях
constructor create(ac:color; aCanRazm, aMaxKol, aMaxLife, aMinFood:integer; aSpeed, aSee: real);
begin
c:= ac; CanRazm:= aCanRazm; MaxKol:= aMaxKol; Kol:= 1;
MaxLife:= aMaxLife; MinFood:= aMinFood; Speed:= aSpeed; See:= aSee
end;
procedure ShowKol(y: integer); //отобразить текущее кол-во
var s: string;
begin
SetFontColor(c);
TextOut(xmax + 20, y, ' ');
s := IntToStr(kol);
TextOut(xmax + 20, y, s);
end;
end;
var opisanie: array[0..types] of fishtype; //данные для всех стай
Type
fish = class
x, y, r, dx0, dy0: real; //текущие координаты, радиус и предыдущий шаг
tip, life, razm, status, food: integer;
//razm - время с момента последнего размножения,
//status - состояние - спокойное или возбуждённое
next, prev: fish; //двусвязный циклический список
constructor Create(ax, ay, ar: real; atip: integer; aprev, anext: fish);
begin
x:= ax; y:= ay; r:= ar; tip:= atip; prev:= aprev; next:= anext;
life:= 0; razm:= 0; dx0:= random; dy0:= random; status:= 1; food:= 0;
end;
procedure show;
begin
SetPenColor(opisanie[tip].c);
circle(round(x), round(y), round(r))
end;
procedure hide;
begin
SetPenColor(BkColor);
circle(round(x), round(y), round(r))
end;
procedure Destroy;
begin
hide;
opisanie[tip].kol:= opisanie[tip].kol - 1;
opisanie[tip].ShowKol(tip*40 + 20);
end;
procedure moveto(dx, dy: real);
begin
hide;
x:= x + dx; y:= y + dy;
if x > xmax then x:= xmax;
if x < xmin then x:= xmin;
if y > ymax then y:= ymax;
if y < ymin then y:= ymin;
show
end;
procedure MakeDeti(var mama, StartAkula, KonAkula, StartKilka, KonKilka : fish);
//произвести потомство
var d: fish;
begin
razm:= 0;
food:= 0;
d:= fish.create(x, y, r, tip, mama, next);
next.prev:= d;
next:= d;
if mama = KonAkula then KonAkula:= d;
if mama = KonKilka then KonKilka:= d;
opisanie[tip].kol:= opisanie[tip].kol + 1;
opisanie[tip].ShowKol(tip*40 + 20);
end;
procedure step(var ribka, StartAkula, KonAkula, StartKilka, KonKilka : fish);
//Здесь алгоритмы для рыб
var
dx, dy, d, dx2, dy2, dmin: real;
t, trup, found: fish;
FoundOhot: boolean;
begin
status:= 1; //Нормальное состояние
dx:= 0; dy:= 0;
if tip > 0 then
begin //Начало алгоритма для жертв
t:= StartAkula;
if t<>nil then
repeat //Ищем всех хищников в поле видимости
d:= sqrt((x - t.x)*(x - t.x) + (y - t.y)*(y - t.y));
if d < opisanie[tip].See then
begin
if d < eps then d:= eps;
dx2:= (x - t.x)/(d*d);
dy2:= (y - t.y)/(d*d);
dx:= dx + dx2;
dy:= dy + dy2;
status:= 2; //Возбуждённое состояние
end;
t:= t.next
until t = KonAkula.next;
//И обратим внимание на края:
if x - xmin < opisanie[tip].See then dx:= dx + 1/((x - xmin + eps)*strahkraj);
if xmax - x < opisanie[tip].See then dx:= dx + 1/((x - xmax - eps)*strahkraj);
if y - ymin < opisanie[tip].See then dy:= dy + 1/((y - ymin + eps)*strahkraj);
if ymax - y < opisanie[tip].See then dy:= dy + 1/((y - ymax - eps)*strahkraj);
d:= sqrt(dx*dx + dy*dy);
if d < eps then
begin
dx:= 2*status*random()*opisanie[tip].Speed - status*opisanie[tip].Speed;
dy:= 2*status*random()*opisanie[tip].Speed - status*opisanie[tip].Speed
end
else
begin
dx:= status*opisanie[tip].Speed*dx/d;
dy:= status*opisanie[tip].Speed*dy/d
end
end
else {tip = 0}
begin //Начало алгоритма для хищников
dmin:= 11000;
t:= StartAkula;
while t<>ribka do //Проверяем всех выше по иерархии
begin
d:= sqrt((x - t.x)*(x - t.x) + (y - t.y)*(y - t.y));
if (d < dmin) and (abs(dx0 - t.dx0) < epsustupi) and
(abs(dy0 - t.dy0) < epsustupi) then dmin:= d;
t:= t.next
end;
FoundOhot:= dmin < ustupi;
dmin:= 11000;
found:= nil;
t:= StartKilka;
if (t<>nil) and (life > 100) and not FoundOhot then
repeat
d:= sqrt((x - t.x)*(x - t.x) + (y - t.y)*(y - t.y));
if d < dmin then
begin
dmin:= d;
found:= t //found - ближайшая жертва
end;
t:= t.next
until t = KonKilka.next;
if (found <> nil) and (dmin < opisanie[tip].See) then
begin
status:= 2; //Возбуждённое состояние
dx:= found.x - x;
dy:= found.y - y;
if dmin < CanEat + status*opisanie[tip].Speed then
begin //Поедание
found.next.prev:= found.prev;
found.prev.next:= found.next;
if (found = StartKilka) and (found = KonKilka) then
begin
//StartKilka:= nil;
//KonKilka:= nil
end;
if found = StartKilka then
StartKilka:= StartKilka.next;
if found = KonKilka then
KonKilka:= KonKilka.prev;
found.destroy;
found := nil;
food:= food + 1
end
end
else
if (x <= xmin) or (x >= xmax) or (y <= ymin) or (y >= ymax) then
begin
dx:= 2*status*random()*opisanie[tip].Speed - status*opisanie[tip].Speed;
dy:= 2*status*random()*opisanie[tip].Speed - status*opisanie[tip].Speed
end
else
begin
dx:= dx0; dy:= dy0 //Повтор предыдущего шага - патрулирование
end;
d:= sqrt(dx*dx + dy*dy);
if d > eps then
begin
dx:= status*opisanie[tip].Speed*dx/d;
dy:= status*opisanie[tip].Speed*dy/d;
end
end;
//Начало алгоритма для всех рыб
moveto(dx, dy);
dx0:= dx; dy0:= dy;
life:= life + 1; razm:= razm + 1;
if opisanie[tip].Kol >= opisanie[tip].MaxKol then Razm:= 0;
if (razm > opisanie[tip].CanRazm) and (food >= opisanie[tip].minfood) then
MakeDeti(ribka, StartAkula, KonAkula, StartKilka, KonKilka);
if life > opisanie[tip].MaxLife then //Смерть от старости
begin
trup:= ribka; ribka:= ribka.prev;
trup.next.prev:= trup.prev;
trup.prev.next:= trup.next;
if trup = StartKilka then
StartKilka:= StartKilka.next;
if trup = KonKilka then
KonKilka:= KonKilka.prev;
if trup = StartAkula then
StartAkula:= StartAkula.next;
if trup = KonAkula then
KonAkula:= KonAkula.prev;
if trup = trup.next then ribka:= nil;
if trup <> nil then
trup.destroy;
trup := nil;
end
end;
end;
function getAllCount:integer;
var i,c:integer;
begin
c:=0;
for i:=0 to types do
c:=c+opisanie[i].Kol;
getAllCount:=c;
end;
var i: integer;
p, q, StartAkula, StartKilka, KonAkula, KonKilka, tek: fish;
begin
SetSmoothing(False);
SetWindowSize(Width, Height);
SetWindowLeft(200);
SetWindowTop(50);
SetWindowCaption('Битва за жизнь');
SetFontSize(7);
SetFontName('Arial');
SetBrushColor(BkColor);
FillRectangle(0, 0, Width, Height);
SetFontColor(clWhite);
TextOut(10, ymax + 20, 'Автор программы - Иванов С.О. e-mail: ssyy@yandex.ru');
TextOut(10, ymax + 20+1*18, 'Программа моделирует поведение нескольких стай рыб. Справа - количества рыб в текущий');
TextOut(10, ymax + 20+2*18, 'момент времени. Изменяя параметры в коде программы, можно влиять на ход битвы.');
TextOut(10, ymax + 20+3*18, 'По умолчанию: красные - хищники, поедают любых рыб из других стай, не плодятся,');
TextOut(10, ymax + 20+4*18, 'пока не поели; синие - жертвы, самые медленные, но быстрее всех плодятся; зелёные - жертвы,');
TextOut(10, ymax + 20+5*18, 'быстрее синих, но плодятся медленнее; желтые - самые быстрые среди жертв, но желтых мало.');
SetFontSize(12);
StartAkula:= nil;
StartKilka:= nil;
KonAkula:= nil;
KonKilka:= nil;
//c - цвет.
//CanRazm - минимальное количество ходов отдельно взятой рыбы между двумя
// её последовательными размножениями.
//MaxKol - максимально допустимое количество рыб данного вида.
//Kol - количество рыб данного вида в текущий момент времени.
//MaxLife - максимальная продолжительность жизни.
// После того, как рыба сделает больше шагов, чем это число, она умирает.
//MinFood - минимальное количество съеденных жертв, необходимое для размножения
// (только для хищников; для жертв это количество принято за -1).
//Speed - нормальная скорость. Максимальная скорость рыбы в 2 раза больше этого числа.
//See - радиус обзора - как далеко видит рыба.
//c, CanRazm, MaxKol, MaxLife, MinFood, Speed, See
opisanie[3]:= fishtype.create(clYellow, 300, 15, 1500, -1, 0.99, 50);
opisanie[2]:= fishtype.create(clGreen, 150, 50, 1500, -1, 0.9, 50);
opisanie[1]:= fishtype.create(clBlue, 30, 50, 500, -1, 0.7, 35);
opisanie[0]:= fishtype.create(clRed, 1000, 40, 5000, 1, 1, 500);
SetPenColor(clWhite);
rectangle(round(xmin - rmax - 1), round(ymin - rmax - 1),
round(xmax + rmax + 1), round(ymax + rmax + 1));
//Теперь нужно построить первоначальный список
q:= fish.create(xmin + 10, ymax - 10, rmax, 0, nil, nil);
p:= fish.create(xmin + 10, ymin + 10, rmax, 1, q, q);
q.next:= p; q.prev:= p;
StartAkula:= q; KonAkula:= q;
StartKilka:= p; KonKilka:= p;
p:= fish.create(xmax - 10, ymin + 10, rmax, 2, KonKilka, StartAkula);
StartAkula.prev:= p;
KonKilka.next:= p; KonKilka:= p;
p:= fish.create(xmax - 10, ymax - 10, rmax, 3, KonKilka, StartAkula);
StartAkula.prev:= p;
KonKilka.next:= p; KonKilka:= p;
for i:= 0 to types do opisanie[i].ShowKol(i*40 + 20);
//И все ходят по очереди, пока хоть кто-то жив.
tek:= StartKilka;
//i:=0;c:=getallcount;LockDrawing;
repeat
tek:= tek.next;
tek.step(tek, StartAkula, KonAkula, StartKilka, KonKilka);
{i:=i+1;
if i>=c then begin
i:=0;c:=getallcount;
Redraw;
end;}
until (tek = nil);
end.