unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
  Unit2, LCLType;

const
  { Ширина и высота игрового поля. }
  FieldWidth = 10;
  FieldHeight = 20;
  CellSize = 30;
  Delay = 3; { Задержка падения фигуры в кадрах. }

type

  { TForm1 }

  TForm1 = class(TForm)
    ScoreLabel1: TLabel;
    ScoreLabel: TLabel;
    Screen: TImage;
    BackBuffer: TImage;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
  private

  public

  end;

  TGameHandler = class Sealed(IGameHandler)
  private
    v: Integer; { Счетчик кадров. }
  public
    procedure DoIteration; override;
  end;

var
  Form1: TForm1;
  ActionThread: TActionThread;
  Field: array[-1..FieldWidth, 0..FieldHeight] of Integer; { Игровое поле. }
  { Состояния клавиш. }
  PressedSpace, PressedLeft, PressedRight, PressedDown: Boolean;
  CurrentColor: array[1..3] of Integer;
  CurrentX, CurrentY, Score: Integer;

implementation

{$R *.lfm}

{ Изменение размера поля в зависимости от количества и величины клеток. }
procedure ResizeField;
begin
  Form1.Screen.Width := CellSize * FieldWidth;
  Form1.Screen.Height := CellSize * FieldHeight;
  Form1.BackBuffer.Width := Form1.Screen.Width;
  Form1.BackBuffer.Height := Form1.Screen.Height
end;

{ Инициализация игрового поля. }
procedure InitField;
var
  i, j: Integer;
begin
  { Заполняем собственно поле нулями }
  { (соответствующими свободному пространству). }
  for i := 0 to FieldWidth - 1 do
    for j := 0 to FieldHeight - 1 do
    begin
      Field[i, j] := 0;
      { Очистка экрана. }
      Form1.BackBuffer.Canvas.Clear
    end;

  { Помечаем участки, находящиеся под "стаканом", как занятые. }
  for i := 0 to FieldWidth - 1 do
    Field[i, FieldHeight] := 1;

  { Таким же образом помечаем участки слева и справа от поля. }
  for j := 0 to FieldHeight do
  begin
    Field[-1, j] := 1;
    Field[FieldWidth, j] := 1
  end
end;

{ Можно ли поместить фигуру в (x, y)? }
function CanPlace(x, y: Integer): Boolean;
var
  i: Integer;
begin
  for i := 0 to 2 do
    if Field[x, y + i] <> 0 then
    begin
      Result := false;
      Exit
    end;
  Result := true
end;

procedure DrawPiece(x, y: Integer; Color: array of Integer);
var
  i: Integer;
  BrushColor: TColor;
begin
  for i := 0 to 2 do
  begin
    case Color[i] of
      0:
        BrushColor := clWhite;
      1:
        BrushColor := clGreen;
      2:
        BrushColor := clBlue;
      3:
        BrushColor := clYellow;
      4:
        BrushColor := clRed
    end;

    Form1.BackBuffer.Canvas.Brush.Color := BrushColor;
    Form1.BackBuffer.Canvas.FillRect(x * CellSize, (y + i) * CellSize,
        (x + 1) * CellSize - 1, (y + i + 1) * CellSize - 1);
    Field[x, y + i] := Color[i]
  end
end;

procedure DrawPiece(x, y: Integer);
var
  ClearColor: array[1..3] of Integer;
  i: Integer;
begin
  for i := 1 to High(ClearColor) do
    ClearColor[i] := 0;
  DrawPiece(x, y, ClearColor)
end;

{ Цвет фигуры выбирается случайным образом. }
procedure RandomizeColor;
var
  i: Integer;
begin
  for i := 1 to High(CurrentColor) do
    CurrentColor[i] := Random(4) + 1
end;

procedure MoveColors;
var
  TemporaryColor: Integer;
begin
  TemporaryColor := CurrentColor[1];
  CurrentColor[1] := CurrentColor[3];
  CurrentColor[3] := CurrentColor[2];
  CurrentColor[2] := TemporaryColor
end;

{ Сдвиг поля (уничтожение линий). }
function ShiftFieldHorizontally: Integer;
var
  CurrentLine, CurrentColumn: Integer;
  i, j: Integer;
  OfSameColor: Cardinal;
  LastColor: Integer;
begin
  { Начинаем в левом нижнем углу. }
  CurrentLine := FieldHeight - 1;
  CurrentColumn := 0;
  OfSameColor := 0;
  LastColor := 0;
  Result := 0;

  while CurrentLine >= 0 do
  begin
    while CurrentColumn < FieldWidth do
    begin
      if (Field[CurrentColumn, CurrentLine] = LastColor) and (LastColor <> 0) then
        Inc(OfSameColor)
      else
      begin
        LastColor := Field[CurrentColumn, CurrentLine];

        if OfSameColor >= 3 then
        begin
          Inc(Result);

          { Сдвигаем верхнюю часть поля вниз. }
          for i := CurrentColumn - OfSameColor to CurrentColumn - 1 do
            for j := CurrentLine downto 1 do
              Field[i, j] := Field[i, j - 1];

          { Сдвигаем вниз также изображение на экране. }
          i := (CurrentColumn - OfSameColor) * CellSize;
          j := CurrentColumn * CellSize - 1;
          Form1.BackBuffer.Canvas.CopyRect(
              Rect(i, CellSize, j, (CurrentLine + 1) * CellSize - 1),
              Form1.BackBuffer.Canvas,
              Rect(i, 0, j, CurrentLine * CellSize - 1)
          );

          { Самая верхняя строка поля теперь пуста. Заполняем ее нулями. }
          Form1.BackBuffer.Canvas.Brush.Color := clWhite;
          for i := CurrentColumn - OfSameColor to CurrentColumn - 1 do
          begin
            Field[i, 0] := 0;
            Form1.BackBuffer.Canvas.FillRect(i * CellSize, 0,
                (i + 1) * CellSize - 1, CellSize - 1)
          end;
          CurrentColumn := -1    
        end;

        if LastColor = 0 then
          OfSameColor := 0
        else
          OfSameColor := 1
      end;
      Inc(CurrentColumn)
    end;
    CurrentColumn := 0;
    Dec(CurrentLine)
  end
end;

function ShiftFieldVertically: Integer;
var
  CurrentColumn, CurrentLine: Integer;
  LastColor: Integer;
  OfSameColor: Cardinal;
  i, j: Integer;
begin
  Result := 0;
  CurrentColumn := 0;
  CurrentLine := FieldHeight - 1;
  LastColor := 0;
  OfSameColor := 0;

  while CurrentColumn < FieldWidth do
  begin
    while CurrentLine >= 0 do
    begin
      if (Field[CurrentColumn, CurrentLine] = LastColor) and (LastColor <> 0) then
        Inc(OfSameColor)
      else
      begin
        LastColor := Field[CurrentColumn, CurrentLine];

        if OfSameColor >= 3 then
        begin
          Inc(Result);

          { Сдвигаем верхнюю часть поля вниз. }
          for i := CurrentLine downto 0 do
            Field[CurrentColumn, i + OfSameColor] := Field[CurrentColumn, i];

          { Сдвигаем вниз также изображение на экране. }
          i := (CurrentLine + OfSameColor + 1) * CellSize -  1;
          j := (CurrentColumn + 1) * CellSize - 1;
          Form1.BackBuffer.Canvas.CopyRect(
            Rect(CurrentColumn * CellSize, OfSameColor * CellSize, j, i),
            Form1.BackBuffer.Canvas,
            Rect(CurrentColumn * CellSize, 0, j, (CurrentLine + 1) * CellSize -  1)
          );

          { Верхние строки поля теперь пустые. Заполняем ее нулями. }
          Form1.BackBuffer.Canvas.Brush.Color := clWhite;
          for i := 0 to OfSameColor - 1 do
          begin
            Field[CurrentColumn, i] := 0;
            Form1.BackBuffer.Canvas.FillRect(CurrentColumn * CellSize, i * CellSize,
                (CurrentColumn + 1) * CellSize - 1, (i + 1) * CellSize - 1)
          end;
          CurrentLine := FieldHeight
        end;

        if LastColor = 0 then
          OfSameColor := 0
        else
          OfSameColor := 1
      end;
      Dec(CurrentLine)
    end;
    CurrentLine := FieldHeight - 1;
    Inc(CurrentColumn)
  end
end;

procedure ShiftField;
var
  RoundScore: Integer;
begin
  repeat
    RoundScore := ShiftFieldHorizontally;
    RoundScore := RoundScore + ShiftFieldVertically;
    Score := Score + RoundScore
  until RoundScore = 0;

  Form1.ScoreLabel.Caption := IntToStr(Score)
end;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
var
  GameHandler: TGameHandler;
begin
  Score := 0;
  Randomize;

  ResizeField;
  InitField;

  { Текущее значение Y-координаты, равное -1 служит индикатором }
  { отсутствия движущихся фигур инициализация переменных. }
  CurrentX := -1;
  CurrentY := -1;

  GameHandler := TGameHandler.Create;
  ActionThread := TActionThread.Create(GameHandler)
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ActionThread.GameHandler.Finished := true;
  ActionThread.WaitFor;
  FreeAndNil(ActionThread)
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
  );
begin
  case Key of
    VK_SPACE:
      PressedSpace := true;
    VK_LEFT:
      PressedLeft := true;
    VK_RIGHT:
      PressedRight := true;
    VK_DOWN:
      PressedDown := true
  end
end;

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  case Key of
    VK_SPACE:
      PressedSpace := false;
    VK_LEFT:
      PressedLeft := false;
    VK_RIGHT:
      PressedRight := false;
    VK_DOWN:
      PressedDown := false
  end
end;

procedure TGameHandler.DoIteration;
begin
  { Если на экране нет движущихся фигур. }
  if CurrentY = -1 then
  begin
    { Создаем новую фигуру в верхней части экрана. }
    CurrentY := 0;
    CurrentX := FieldWidth div 2;
    RandomizeColor;

    { если ее нельзя разместить, конец игры }
    if not CanPlace(CurrentX, CurrentY) then
    begin
      Finished := true;
      Exit
    end;
  end;

  DrawPiece(CurrentX, CurrentY); { Стираем фигуру с экрана. }

  { Если нажата клавиша "вниз", увеличиваем скорость игры. }
  if PressedDown then
    SlowDown
  else
    SpeedUp;

  if PressedLeft and CanPlace(CurrentX - 1, CurrentY) then
    Dec(CurrentX); { сдвиг фигуры влево }
  if PressedRight and CanPlace(CurrentX + 1, CurrentY) then
    Inc(CurrentX); { сдвиг фигуры вправо }

  { Прокручивание цветов. }
  if PressedSpace then
    MoveColors;

  Inc(v); { Увеличиваем счетчик кадров. }

  { Если на текущей итерации нет вертикального сдвига. }
  if v < Delay then
    DrawPiece(CurrentX, CurrentY, CurrentColor)
  else
  { Рисуем фигуру иначе. }
  begin
    if CanPlace(CurrentX, CurrentY + 1) then
    begin
      v := 0;
      { Если фигуру можно разместить, размещаем. }
      Inc(CurrentY);
      DrawPiece(CurrentX, CurrentY, CurrentColor)
    end
    else
    begin
      { Иначе оставляем на прежнем месте. }
      DrawPiece(CurrentX, CurrentY, CurrentColor);
      ShiftField; { Уничтожаем собранные линии. }
      CurrentY := -1 { На экране больше нет движущихся фигур. }
    end
  end;

  { Обновляем содержимое экрана (копируем буфер на экран). }
  Form1.Screen.Canvas.CopyRect(
      Rect(0, 0, Form1.Screen.Width, Form1.Screen.Height),
      Form1.BackBuffer.Canvas,
      Rect(0, 0, Form1.Screen.Width, Form1.Screen.Height))
end;

end.