path: root/Занимательное программирование/7/6_tetris/Unit1.pas

unit Unit1;

{$MODE objfpc}{$H+}

interface

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

type

  { TForm1 }

  TForm1 = class(TForm)
    Label2: TLabel;
    ScoreLabel: TLabel;
    Screen: TImage;
    ImageList: TImageList;
    BackBuffer: TImage;
    Label1: TLabel;
    LinesLabel: TLabel;
    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
    { Private declarations }
  public
    { Public declarations }
  end;

  TGameHandler = class(TInterfacedObject, IGameHandler)
  private
    Finished: Boolean;
  public
    CurX, CurY: Integer; { координаты текущей фигуры }
    CurPiece: Integer; { ее идентификатор }
    CurColour: Integer; { и цвет }
    v: Integer; { счетчик кадров }

    constructor Create;

    procedure DoIteration;
    procedure Reset;
    procedure Finish;
    function IsFinished: Boolean;
  end;

var
  Form1: TForm1;
  ActionThread: TActionThread;
  Lines, Score: Integer; { количество собранных линий }
  Level: Integer;

implementation

{$R *.lfm}

{ поворот фигуры на 90 градусов }
procedure Rotate90(piece : Integer);
var
  i, j: Integer;
  temp: array[0..3, 0..3] of Integer; { "временная" фигура }
begin
  for i := 0 to 3 do { поворот на 90 градусов по часовой стрелке }
    for j := 0 to 3 do
      temp[3 - j, i] := Pieces[piece, i, j];

  for i := 0 to 3 do { копируем измененную фигуру в исходный массив }
    for j := 0 to 3 do
      Pieces[piece, i, j] := temp[i, j]
end;

{ сдвиг фигуры в угол }
procedure ToCorner(piece : Integer);
var
  i, j: Integer;
label exit1, exit2;
begin
  { цикл вертикального сдвига }
  while true do
  begin
    for i := 0 to 3 do  { если больше не надо двигать вверх }
      if Pieces[piece, i, 0] = 1 then
        { переходим к горизонтальному сдвигу }
        goto exit1;
        { иначе сдвигаем на клетку вверх }
      for i := 0 to 3 do
        for j := 0 to 2 do
          Pieces[piece, i, j] := Pieces[piece, i, j + 1];

      for i := 0 to 3 do
        Pieces[piece, i, 3] := 0; { нижний ряд заполняем нулями }
  end;

exit1: { аналогично: }
  while true do { цикл горизонтального сдвига }
  begin
    for j := 0 to 3 do { если больше не надо двигать влево }
      if Pieces[piece, 0, j] = 1 then
        goto exit2; { выход }

    for j := 0 to 3 do { иначе сдвигаем на клетку влево }
      for i := 0 to 2 do
        Pieces[piece, i, j] := Pieces[piece, i + 1, j];

    for j := 0 to 3 do
      Pieces[piece, 3, j] := 0; { правый ряд заполняем нулями }
  end;

exit2: { конец работы }
end;

{ загрузить "строительные блоки" }
procedure LoadBitmaps;
var
  i: Integer;
begin
  for i := 0 to 4 do
  begin
    Bitmaps[i] := TBitmap.Create;
    Form1.ImageList.GetBitmap(i, Bitmaps[i])
  end
end;

{ освободить память }
procedure FreeBitmaps;
var
  i: Integer;
begin
  for i := 0 to 4 do
    Bitmaps[i].Free
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.Draw(22*i, 22*j, Bitmaps[0])
    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;

procedure InitLevel(ALevel: Integer);
begin
  InitField; { очистка игрового поля }
  { Пока не собрано ни одной линии. }
  Lines := 0;
  Level := ALevel
end;

{ Рисование фигуры. }
procedure DrawPiece(x, y, piece, colour : Integer);
var
  i, j: Integer;
begin
  for i := 0 to 3 do
    for j := 0 to 3 do
      if Pieces[piece, i, j] = 1 then
      begin
        { рисуем очередной "строительный блок" }
        Form1.BackBuffer.Canvas.Draw(22*(x + i), 22*(y + j), Bitmaps[colour]);
        Field[x + i, y + j] := colour { вносим изменения в игровое поле }
      end
end;

{-------------------------------------------------------------}
{ Можно ли поместить фигуру в (x, y)? }
function CanPlace(x, y, piece : Integer) : Boolean;
var
  i, j: Integer;
begin
  for i := 0 to 3 do
    for j := 0 to 3 do
      if (Pieces[piece, i, j] = 1) and (Field[x + i, y + j] <> 0) then
      begin
        CanPlace := false; { участок фигуры накладывается на }
        Exit { занятую клетку поля; запрещаем действие }
      end;
  CanPlace := true { пересечений не обнаружено }
end;

{ Сдвиг поля (уничтожение линий). }
procedure ShiftField;
var
  i, j: Integer;
  fullrow: Boolean;
  curline: Integer;
  LinesAtOnce: Integer;
begin
  curline := FieldHeight - 1; { текущая линия (начинаем с нижней) }
  LinesAtOnce := 0;
  { Идем до самого верха. }
  while curline >= 0 do
  begin
    { Определяем, собрана линия целиком или нет. }
    fullrow := true;
    for i := 0 to FieldWidth - 1 do
      { Если поле в текущей строке содержит }
      { хотя бы один нуль, линия не собрана }
      if Field[i, curline] = 0 then
      begin
        fullrow := false;
        Break
      end;

    { если линия собрана }
    if fullrow then
    begin
      { Увеличиваем кол-во собранных линий. }
      Inc(LinesAtOnce);

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

      { сдвигаем вниз также изображение на экране }
      Form1.BackBuffer.Canvas.CopyRect(Rect(0, 22, 220, 22*(curline+1)),
                Form1.BackBuffer.Canvas, Rect(0, 0, 220, 22*(curline)));

      { Самая верхняя строка поля теперь пуста. }
      for i := 0 to FieldWidth - 1 do
      begin
        Field[i, 0] := 0; { заполняем ее нулями }
        { на экране нулям соответствует фоновый цвет }
        Form1.BackBuffer.Canvas.Draw(22*i, 0, Bitmaps[0])
      end;
    end
    else
      { Если линия не собрана, переходим к следующей. }
      curline := curline - 1
  end;
  Inc(Lines, LinesAtOnce);
  if LinesAtOnce = 1 then
    Inc(Score, 1)
  else if LinesAtOnce = 2 then
    Inc(Score, 3)
  else if LinesAtOnce = 3 then
    Inc(Score, 5)
  else if LinesAtOnce >= 4 then
    Inc(Score, 7)
end;

{-------------------------------------------------------------}

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  case Key of
    VK_SPACE:
      Key_Space := true;
    VK_LEFT:
      Key_Left := true;
    VK_RIGHT:
      Key_Right := true;
    VK_DOWN:
      Key_Down := true
  end
end;

{-------------------------------------------------------------}
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  case Key of
    VK_SPACE:
      Key_Space := false;
    VK_LEFT:
      Key_Left := false;
    VK_RIGHT:
      Key_Right := false;
    VK_DOWN:
      Key_Down := false
  end
end;

{-------------------------------------------------------------}
procedure TForm1.FormCreate(Sender: TObject);
var
  GameHandler: TGameHandler;
begin
  Randomize;
  LoadBitmaps; { загрузка "строительных блоков" }

  GameHandler := TGameHandler.Create;

  Key_Space := false; { считаем, что клавиши изначально не нажаты }
  Key_Left := false;
  Key_Right := false;
  Key_Down := false;

  ActionThread := TActionThread.Create(GameHandler);
  Score := 0;
  InitLevel(1)
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ActionThread.GameHandler.Finish;
  ActionThread.WaitFor;
  FreeAndNil(ActionThread);

  FreeBitmaps { освобождение памяти }
end;

constructor TGameHandler.Create;
begin
  Finished := false;
  Reset
end;

procedure TGameHandler.DoIteration;
begin
  if Lines > LinesPerLevel then
  begin
    SuspendThread(ActionThread.ThreadID);
    ShowMessage('Переход на уровень ' + IntToStr(Level + 1));
    InitLevel(Level + 1);
    Reset;
    ResumeThread(ActionThread.ThreadID);
    Exit
  end;
  if CurY = -1 then { если на экране нет движущихся фигур }
  begin
    CurY := 0; { создаем новую фигуру }
    CurX := FieldWidth div 2; { в верхней части экрана }
    CurPiece := 1 + Random(7); { ее тип и цвет выбираются }
    CurColour := 1 + Random(4); { случайным образом }

    { если ее нельзя разместить, конец игры }
    if not CanPlace(CurX, CurY, CurPiece) then
    begin
      Finish;
      Exit
    end
  end;

  DrawPiece(CurX, CurY, CurPiece, 0); { стираем фигуру с экрана }

  { если нажата клавиша "вниз", увеличиваем скорость игры }
  if Key_Down then
    MSecsPerFrame := 20
  else
    MSecsPerFrame := 100;

  if Key_Left and CanPlace(CurX - 1, CurY, CurPiece) then
    CurX := CurX - 1; { сдвиг фигуры влево }
  if Key_Right and CanPlace(CurX + 1, CurY, CurPiece) then
    CurX := CurX + 1; { сдвиг фигуры вправо }

  if Key_Space then { поворот фигуры }
  begin
    Rotate90(CurPiece); { поворачиваем на 90 градусов }
    ToCorner(CurPiece);
    { Если фигуру нельзя разместить возвращаем ее }
    { в первоначальное положение (повернуть еще три раза). }
    if not CanPlace(CurX, CurY, CurPiece) then
    begin
      Rotate90(CurPiece);
      Rotate90(CurPiece);
      Rotate90(CurPiece);
      ToCorner(CurPiece)
    end
  end;

  v := v + 1; { увеличиваем счетчик кадров }

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

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

  { Обновляем индикатор количества собранных линий. }
  Form1.LinesLabel.Caption := IntToStr(Lines);
  Form1.ScoreLabel.Caption := IntToStr(Score)
end;

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

  v := 0;
  CurPiece := 0;
  CurX := 0;
  CurColour := 0
end;

procedure TGameHandler.Finish;
begin
  Finished := true
end;

function TGameHandler.IsFinished: Boolean;
begin
  Result := Finished
end;

end.