unit Unit1; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, Math; const FieldWidth = 30; { Ширина и } FieldHeight = 25; { высота поля } type TField = array [0..FieldWidth + 1, 0..FieldHeight + 1] of Integer; { TForm1 } TForm1 = class(TForm) Screen: TPaintBox; StartStopBtn: TButton; procedure ScreenPaint(Sender: TObject); procedure StartStopBtnClick(Sender: TObject); private var Rx, Ry: Integer; { Ширина, высота клекти } Field: TField; x, y: Integer; public end; var Form1: TForm1; IsRunning: Boolean; implementation {$R *.lfm} { TForm1 } procedure TForm1.StartStopBtnClick(Sender: TObject); var i, j: Integer; protoplasmCount, infusoria: Integer; direction, positionX, positionY, energy: Integer; begin if IsRunning then begin IsRunning := false; StartStopBtn.Caption := 'Пуск'; Exit; end; StartStopBtn.Caption := 'Стоп'; IsRunning := true; Rx := (Screen.Width div FieldWidth) div 2; { Определяем размеры клетки } Ry := (Screen.Height div FieldHeight) div 2; Randomize; for i := 0 to FieldWidth + 1 do { Очистка поля } for j := 0 to FieldHeight + 1 do Field[i, j] := 0; while IsRunning do { Основной цикл } begin x := RandomRange(1, FieldWidth); { Выбираем случайную клекту } y := RandomRange(1, FieldHeight); { Подсчитываем соседей } infusoria := 0; protoplasmCount := 0; for i := -1 to 1 do for j := -1 to 1 do begin if Field[x + i][y + j] = -2 then begin Inc(protoplasmCount); end else if Field[x + i][y + j] = -1 then begin Inc(infusoria); end; end; if Field[x][y] = -1 then Dec(infusoria); if (Field[x, y] = 0) and (infusoria > 2) then { Создаем новую инфузорию } begin Field[x, y] := -1; end { Удаляем инфузорию } else if (Field[x, y] = -1) and ((infusoria < 3) or (infusoria > 4)) then begin Field[x, y] := 0; end { Создаем инфузория, если достаточно протоплазмы } else if ((Field[x, y] = 0) or (Field[x, y] = -2)) and (protoplasmCount > 6) then begin for i := -1 to 1 do for j := -1 to 1 do if Field[x + i, y + j] = -2 then Field[x + i, y + j] := 0; Field[x, y] := -1; end { Создаем протоплазму, если клетка пустая } else if Field[x, y] = 0 then begin Field[x, y] := -2; end { Животное двигается } else if Field[x, y] > 0 then begin direction := Random(4); energy := Field[x, y]; case direction of 0: begin positionX := x - 1; positionY := y; end; 1: begin positionX := x + 1; positionY := y; end; 2: begin positionX := x; positionY := y - 1; end; 3: begin positionX := x; positionY := y + 1; end; end; if Field[positionX, positionY] = 0 then Dec(energy) else if Field[positionX, positionY] = -1 then Inc(energy) else if Field[positionX, positionY] > 0 then energy := energy + Field[positionX, positionY]; Field[x, y] := 0; if energy > 0 then Field[positionX, positionY] := energy end; { Создаем животных } for i := 1 to FieldWidth do begin for j := 1 to FieldHeight do begin if (Field[i - 1, j] = -1) and (Field[i, j] = -1) and (Field[i + 1, j] = -1) then begin Field[i - 1, j] := 0; Field[i, j] := 5; Field[i + 1, j] := 0; end else if (Field[i, j - 1] = -1) and (Field[i, j] = -1) and (Field[i, j + 1] = -1) then begin Field[i, j - 1] := 0; Field[i, j] := 5; Field[i, j + 1] := 0; end; end; end; Screen.Invalidate; Sleep(5); Application.ProcessMessages; if Application.Terminated then Exit; end end; procedure TForm1.ScreenPaint(Sender: TObject); var i, j: Integer; begin Screen.Canvas.Pen.Color := clBlue; for i := 1 to FieldWidth do begin for j := 1 to FieldHeight do begin if Field[i][j] = -1 then begin Screen.Canvas.Pen.Color := clBlue; Screen.Canvas.Ellipse((2 * i - 1) * Rx - Rx, (2 * j - 1) * Ry - Ry, (2 * i - 1) * Rx + Rx, (2 * j -1) * Ry + Ry); end else if Field[i][j] = -2 then begin Screen.Canvas.Pen.Color := clGreen; Screen.Canvas.Ellipse((2 * i - 1) * Rx - Rx, (2 * j - 1) * Ry - Ry, (2 * i - 1) * Rx + Rx, (2 * j -1) * Ry + Ry); end else if Field[i][j] > 0 then begin Screen.Canvas.Pen.Color := clYellow; Screen.Canvas.Ellipse((2 * i - 1) * Rx - Rx, (2 * j - 1) * Ry - Ry, (2 * i - 1) * Rx + Rx, (2 * j -1) * Ry + Ry); end; end; end; end; end.