439 lines
13 KiB
ObjectPascal
439 lines
13 KiB
ObjectPascal
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.
|