430 lines
11 KiB
ObjectPascal
430 lines
11 KiB
ObjectPascal
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.
|
|
|