[Delphi] Программа Life

loks-po

В программе 3 разновидности юнитов: растения, травоядные и хищники.
// Хищники поедают только травоядных, травоядные питаются только
// растениями.
// В каждый момент объект может находится в одном из 5 состояний:
// 0 - не определено
// 1 - поиск пищи/охотится
// 2 - поиск партнера для размножения
// 3 - смерть
// 4 - убегает от хищника (только травоядные)
// Для растений доступны состояния 0,3.
// Для травоядных - 0,1,2,3,4
// Для хищников - 0,1,2,3
// Съеденное травоядным растение погибает, а количество жизней
// травоядного увеличивается на количество жизней растения.
// Аналогичное правило действует и для хищника, съевшего травоядного.
// С течением времени здоровье растений постепенно увеличивается
// (растут и рождаются новые растения. Здоровье травоядных
// и хищников, наоборот, уменьшается, поэтому они постоянно
// питаются/охотятся. Если здоровье превысит некоторое пороговое
// значение, животное ищет аналогичного партнера для размножения.
// Если такового не имеется, то оно ждет.
// Скорость передвижения хощников и травоядных напрямую зависит от
// количества единиц здоровья.
// После встречи двух особей рождается только одна новая, и
// здоровье родительских особей распределяется между всеми тремя
// (пропорционально исходному количеству жизней родителей, без
// потерь и добавок).
// Выбор необходимого растения/травоядного/хищника осуществляется
// поиском минимального расстояния до искомого (это самое медленное
// место в программе ( .
//

procedure TForm1.ApplicationEvents1Idle(Sender: TObject;

  var Done: Boolean);

begin

  This:=GetTickCount;

  if (This-Last)>  20   then

  begin

    

    (итерация жизни - несколько вложенных процедур, устанавливающих параметры живности)



       Last:=GetTickCount;

   

  end;

  done:=false;

end;  

gopnik1994

viktor954

Dasar

loks-po

gopnik1994

Dasar

Dasar

loks-po

It is not called continuously unless the Done parameter is set to false

loks-po

Dasar

rosali

 

This-Last > 20  

gopnik1994

gopnik1994

gopnik1994

Dasar

bleyman

  This:=GetTickCount;

  if (This-Last)>  20   then

  begin

    Last:=GetTickCount; // Типа местами поменял

    

    (итерация жизни - несколько вложенных процедур, устанавливающих параметры живности)



  end;

gopnik1994

gopnik1994

 procedure TApplication.Run;

begin

...

      repeat

        try

          HandleMessage;

        except

          HandleException(Self);

        end;

      until Terminated;

...

end;



procedure TApplication.HandleMessage;

var

  Msg: TMsg;

begin

  if not ProcessMessage(Msg) then Idle(Msg);

end;



procedure TApplication.Idle(const Msg: TMsg);

begin

...

  try

    if Assigned(FOnIdle) then FOnIdle(Self, Done);

    if Done then DoActionIdle;

  except

    HandleException(Self);

  end;

  if (GetCurrentThreadID = MainThreadID) and CheckSynchronize then

    Done := False;

  if Done then WaitMessage;

end;

 

Dasar

gopnik1994

 

function TApplication.ProcessMessage(var Msg: TMsg): Boolean;

begin

  Result := False;

  if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then

  begin

    Result := True;

    ...

  end;

end;



function WaitMessage; external user32 name 'WaitMessage';

 

The WaitMessage function yields control to other threads when a thread has no other messages in its message queue. The WaitMessage function suspends the thread and does not return until a new message is placed in the thread's message queue.
BOOL WaitMessage(VOID)
Parameters
This function has no parameters.
Return Values
If the function succeeds, the return value is nonzero.
If the function fails, the return value is zero. To get extended error information, call GetLastError.

The PeekMessage function checks a thread message queue for a message and places the message (if any) in the specified structure.
BOOL PeekMessage(
LPMSG lpMsg, // pointer to structure for message
HWND hWnd, // handle to window
UINT wMsgFilterMin, // first message
UINT wMsgFilterMax, // last message
UINT wRemoveMsg // removal flags
);

...
Return Values
If a message is available, the return value is nonzero.
If no messages are available, the return value is zero.
Remarks
Unlike the GetMessage function, the PeekMessage function does not wait for a message to be placed in the queue before returning.
...

Dasar