IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Стаи рыб.. 1 хищная и 3 стаи мирные..
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 40
Пол: Мужской

Репутация: -  0  +


вконце всеравно все здохнут! Вот это показывает что каждый вид животных важен lol.gif

uses GraphABC;

const types = 3;
rmax = 4;
CanEat = rmax;
eps = 0.00001;
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, CanRazm, MaxKol, Kol, MaxLife, MinFood: integer;
Speed, See: real;
constructor create(ac, 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©;
TextOut(xmax + 20, y, ' ');
str(Kol, s);
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;
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®)
end;
procedure hide;
begin
SetPenColor(BkColor);
circle(round(x), round(y), round®)
end;
destructor 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 i, imin: integer;
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
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;
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;
trup.destroy;
end
end;

end;

var i: integer;
p, q, StartAkula, StartKilka, KonAkula, KonKilka, tek: fish;

begin
SetWindowSize(Width, Height);
SetWindowLeft(200);
SetWindowTop(50);
SetWindowCaption('Битва за жизнь');
SetFontSize(10);
SetFontName('Arial');
SetBrushColor(BkColor);
FillRect(0, 0, Width + 2000, Height + 1500);
SetFontColor(clWhite);
TextOut(10, ymax + 20*18,
'Программа моделирует поведение нескольких стай рыб. Справа - количества рыб в текущий');
TextOut(10, ymax + 20+1*18,
'момент времени. Изменяя параметры в коде программы, можно влиять на ход битвы.');
TextOut(10, ymax + 20+2*18,
'По умолчанию: красные - хищники, поедают любых рыб из других стай, не плодятся,');
TextOut(10, ymax + 20+3*18,
'пока не поели; синие - жертвы, самые медленные, но быстрее всех плодятся; зелёные - жертвы,');
TextOut(10, ymax + 20+4*18,
'быстрее синих, но плодятся медленнее; желтые - самые быстрые среди жертв, но желтых мало.');
SetFontSize(12);
StartAkula:= nil;
StartKilka:= nil;
KonAkula:= nil;
KonKilka:= nil;

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, 100);
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;
repeat
tek:= tek.next;
tek.step(tek, StartAkula, KonAkula, StartKilka, KonKilka);
until (tek = nil);
end.


М
Пожалуйста, следи за кодировкой, когда постишь.
На этот раз я исправил.
- Лопарь

 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Пионер
**

Группа: Пользователи
Сообщений: 69
Пол: Мужской

Репутация: -  3  +


А можно текст русский, пожалуйста?


Если не знаешь как, то вроде это делается так:
Блокнотом (или текстовым редактором) открываешь в mustDie свой source (*.pas) и выбираешь шрифтик с поддержкой языка (скажем Terminal).
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 25.10.2020 11:24
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name