book-exercises/Занимательное программирование/1/8_5_life/unit1.pas

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.