Add book "Занимательное программирование"

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

@@ -0,0 +1,158 @@
+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 Boolean;
+
+  TPoint = record
+    x: Integer;
+    y: Integer;
+  end;
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    Screen: TPaintBox;
+    StartStopBtn: TButton;
+    procedure ScreenPaint(Sender: TObject);
+    procedure StartStopBtnClick(Sender: TObject);
+  private
+    procedure UpdateSurface(field: TField; point: TPoint; neighbours: Integer);
+    var Rx, Ry: Integer; { Ширина, высота клекти }
+      BlueField, GreenField: TField;
+      s, v: Integer;
+      bluePoint, greenPoint: TPoint;
+  public
+
+  end;
+
+var
+  Form1: TForm1;
+  IsRunning: Boolean;
+
+implementation
+
+{$R *.lfm}
+
+function CountNeighbours(Field: TField; x: Integer; y: Integer): Integer;
+  var i, j: Integer;
+begin
+  Result := 0;
+
+  for i := -1 to 1 do
+    for j := -1 to 1 do
+      Result := Result + Ord(Field[x + i][y + j]);
+  Result := Result - Ord(Field[x][y]);
+end;
+
+{ Выбираем случайную клекту }
+function ChoosePoint(): TPoint;
+begin
+  Result.x := RandomRange(1, FieldWidth);
+  Result.y := RandomRange(1, FieldHeight);
+end;
+
+{ TForm1 }
+
+procedure TForm1.StartStopBtnClick(Sender: TObject);
+  var i, j: 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
+    begin
+      BlueField[i, j] := false;
+      GreenField[i, j] := false;
+    end;
+
+  while IsRunning do { Основной цикл }
+  begin
+    bluePoint := ChoosePoint();
+    greenPoint := ChoosePoint();
+
+    s := CountNeighbours(BlueField, bluePoint.x, bluePoint.y);
+    v := CountNeighbours(GreenField, greenPoint.x, greenPoint.y);
+
+    Screen.Invalidate;
+
+    Sleep(250);
+    Application.ProcessMessages;
+    if Application.Terminated then Exit;
+  end
+end;
+
+procedure TForm1.UpdateSurface(field: TField; point: TPoint; neighbours: Integer);
+begin
+  if (field[point.x, point.y] = false) and (neighbours > 2) then { Создаем новую инфузорию }
+  begin
+    Screen.Canvas.Pen.Color := clBlue;
+    Screen.Canvas.Ellipse((2 * point.x - 1) * Rx - Rx, (2 * point.y - 1) * Ry - Ry,
+      (2 * point.x - 1) * Rx + Rx, (2 * point.y -1) * Ry + Ry);
+    field[point.x, point.y] := true;
+  end
+  else if (field[point.x, point.y] = true) and ((neighbours < 3) or (neighbours > 4)) then { Удаляем }
+  begin
+    Screen.Canvas.Pen.Color := clBtnFace;
+    Screen.Canvas.Ellipse((2 * point.x - 1) * Rx - Rx, (2 * bluePoint.y - 1) * Ry - Ry,
+      (2 * point.x - 1) * Rx + Rx, (2 * point.y -1) * Ry + Ry);
+    field[point.x, point.y] := false;
+  end;
+end;
+
+procedure TForm1.ScreenPaint(Sender: TObject);
+  var i, j: Integer;
+begin
+  Screen.Canvas.Pen.Color := clBlue;
+
+  for i := 1 to FieldWidth do { Создаем начальную конфигурацию }
+    for j := 1 to FieldHeight do
+      if Random(4) = 0 then { В среднем будет одна инфузория }
+      begin { на четыре клетки }
+        BlueField[i, j] := true;
+        Screen.Canvas.Ellipse((2 * i - 1) * Rx - Rx, (2 * j - 1) * Ry - Ry,
+          (2 * i - 1) * Rx + Rx, (2 * j - 1) * Ry + Ry);
+      end;
+
+  UpdateSurface(blueField, bluePoint, s);
+
+  Screen.Canvas.Pen.Color := clGreen;
+
+  for i := 1 to FieldWidth do { Создаем начальную конфигурацию }
+    for j := 1 to FieldHeight do
+      if Random(4) = 0 then { В среднем будет одна инфузория }
+      begin { на четыре клетки }
+        GreenField[i, j] := true;
+        Screen.Canvas.Ellipse((2 * i - 1) * Rx - Rx, (2 * j - 1) * Ry - Ry,
+          (2 * i - 1) * Rx + Rx, (2 * j - 1) * Ry + Ry);
+      end;
+
+  UpdateSurface(greenField, greenPoint, v);
+end;
+
+end.
+