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(c);
             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(r))
         end;
       procedure hide;
         begin
         SetPenColor(BkColor);
         circle(round(x), round(y), round(r))
         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

 



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