Закончил тетрис из 7-й главы, шестого упражнения
This commit is contained in:
@@ -0,0 +1,82 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="12"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<Title Value="Tetris"/>
|
||||
<UseAppBundle Value="False"/>
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<BuildModes>
|
||||
<Item Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<UseFileFilters Value="True"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
</RunParams>
|
||||
<RequiredPackages>
|
||||
<Item>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item>
|
||||
</RequiredPackages>
|
||||
<Units>
|
||||
<Unit>
|
||||
<Filename Value="Tetris.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="Unit1.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="Form1"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="unit2.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="Unit2"/>
|
||||
</Unit>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<SearchPaths>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<UseAnsiStrings Value="False"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<DebugInfoType Value="dsDwarf3"/>
|
||||
</Debugging>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CustomOptions Value="-dBorland -dVer150 -dDelphi7 -dCompiler6_Up -dPUREPASCAL"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions>
|
||||
<Item>
|
||||
<Name Value="EAbort"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
@@ -0,0 +1,15 @@
|
||||
program Tetris;
|
||||
|
||||
{$MODE objfpc}{$H+}
|
||||
|
||||
uses
|
||||
Forms, Interfaces,
|
||||
Unit1 in 'Unit1.pas', Unit2 {Form1};
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Run
|
||||
end.
|
||||
@@ -0,0 +1,179 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectSession>
|
||||
<Version Value="12"/>
|
||||
<BuildModes Active="Default"/>
|
||||
<Units>
|
||||
<Unit>
|
||||
<Filename Value="Tetris.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<CursorPos X="16" Y="13"/>
|
||||
<UsageCount Value="34"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="Unit1.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="Form1"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<EditorIndex Value="1"/>
|
||||
<TopLine Value="337"/>
|
||||
<CursorPos X="41" Y="343"/>
|
||||
<UsageCount Value="34"/>
|
||||
<Loaded Value="True"/>
|
||||
<LoadedDesigner Value="True"/>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="unit2.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="Unit2"/>
|
||||
<IsVisibleTab Value="True"/>
|
||||
<EditorIndex Value="2"/>
|
||||
<TopLine Value="16"/>
|
||||
<CursorPos X="21" Y="30"/>
|
||||
<UsageCount Value="28"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="../../../../opt/lazarus/fpc/3.2.2/source/rtl/objpas/classes/classes.inc"/>
|
||||
<EditorIndex Value="-1"/>
|
||||
<TopLine Value="211"/>
|
||||
<CursorPos X="22" Y="226"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="../../../../opt/lazarus/lcl/include/canvas.inc"/>
|
||||
<EditorIndex Value="-1"/>
|
||||
<CursorPos Y="25"/>
|
||||
<UsageCount Value="13"/>
|
||||
</Unit>
|
||||
</Units>
|
||||
<JumpHistory HistoryIndex="29">
|
||||
<Position>
|
||||
<Filename Value="Unit1.pas"/>
|
||||
<Caret Line="302" Column="12" TopLine="278"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="Unit1.pas"/>
|
||||
<Caret Line="151" Column="20" TopLine="132"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="Unit1.pas"/>
|
||||
<Caret Line="92" Column="40" TopLine="64"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="Unit1.pas"/>
|
||||
<Caret Line="95" Column="15" TopLine="83"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="Unit1.pas"/>
|
||||
<Caret Line="379" Column="16" TopLine="362"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="Unit1.pas"/>
|
||||
<Caret Line="381" Column="21" TopLine="362"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="Unit1.pas"/>
|
||||
<Caret Line="379" Column="11" TopLine="362"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="Unit1.pas"/>
|
||||
<Caret Line="87" Column="21" TopLine="73"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="Unit1.pas"/>
|
||||
<Caret Line="170" Column="18" TopLine="147"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="Unit1.pas"/>
|
||||
<Caret Line="317" Column="35" TopLine="293"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="Unit1.pas"/>
|
||||
<Caret Line="342" Column="14" TopLine="318"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="Unit1.pas"/>
|
||||
<Caret Line="419" Column="31" TopLine="395"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="Unit1.pas"/>
|
||||
<Caret Line="47" Column="22" TopLine="32"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="Unit1.pas"/>
|
||||
<Caret Line="317" Column="35" TopLine="293"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="Unit1.pas"/>
|
||||
<Caret Line="168" Column="14" TopLine="68"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="Unit1.pas"/>
|
||||
<Caret Line="347" Column="19" TopLine="377"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="Unit1.pas"/>
|
||||
<Caret Line="231" Column="10" TopLine="217"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="Unit1.pas"/>
|
||||
<Caret Line="264" Column="77" TopLine="245"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="Unit1.pas"/>
|
||||
<Caret Line="9" Column="22"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="Unit1.pas"/>
|
||||
<Caret Line="25" Column="19" TopLine="7"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="Unit1.pas"/>
|
||||
<Caret Line="337" Column="9" TopLine="321"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="Unit1.pas"/>
|
||||
<Caret Line="334" Column="31" TopLine="325"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit2.pas"/>
|
||||
<Caret Line="66" Column="62" TopLine="47"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit2.pas"/>
|
||||
<Caret Line="61" Column="55" TopLine="47"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit2.pas"/>
|
||||
<Caret Line="66" Column="62" TopLine="47"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="Unit1.pas"/>
|
||||
<Caret Line="318" Column="9" TopLine="314"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit2.pas"/>
|
||||
<Caret Line="53" Column="17" TopLine="47"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit2.pas"/>
|
||||
<Caret Line="59" Column="10" TopLine="47"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit2.pas"/>
|
||||
<Caret Line="63" Column="12" TopLine="47"/>
|
||||
</Position>
|
||||
<Position>
|
||||
<Filename Value="unit2.pas"/>
|
||||
<Caret Line="67" Column="68" TopLine="47"/>
|
||||
</Position>
|
||||
</JumpHistory>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
<Modes ActiveMode=""/>
|
||||
</RunParams>
|
||||
</ProjectSession>
|
||||
</CONFIG>
|
||||
@@ -0,0 +1,89 @@
|
||||
object Form1: TForm1
|
||||
Left = 458
|
||||
Height = 603
|
||||
Top = 240
|
||||
Width = 275
|
||||
BorderIcons = [biSystemMenu, biMinimize]
|
||||
BorderStyle = bsSingle
|
||||
Caption = 'Тетрис'
|
||||
ClientHeight = 603
|
||||
ClientWidth = 275
|
||||
Color = clBtnFace
|
||||
DesignTimePPI = 120
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -14
|
||||
Font.Name = 'MS Sans Serif'
|
||||
LCLVersion = '4.6.0.0'
|
||||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
OnKeyDown = FormKeyDown
|
||||
OnKeyUp = FormKeyUp
|
||||
object Screen: TImage
|
||||
Left = 0
|
||||
Height = 550
|
||||
Top = 0
|
||||
Width = 275
|
||||
end
|
||||
object BackBuffer: TImage
|
||||
Left = 0
|
||||
Height = 550
|
||||
Top = 20
|
||||
Width = 275
|
||||
Visible = False
|
||||
end
|
||||
object Label1: TLabel
|
||||
Left = 7
|
||||
Height = 25
|
||||
Top = 560
|
||||
Width = 65
|
||||
Caption = 'Линий:'
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -20
|
||||
Font.Name = 'MS Sans Serif'
|
||||
ParentFont = False
|
||||
end
|
||||
object LinesLabel: TLabel
|
||||
Left = 80
|
||||
Height = 25
|
||||
Top = 560
|
||||
Width = 11
|
||||
Caption = '0'
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -20
|
||||
Font.Name = 'MS Sans Serif'
|
||||
ParentFont = False
|
||||
end
|
||||
object Label2: TLabel
|
||||
Left = 127
|
||||
Height = 25
|
||||
Top = 560
|
||||
Width = 53
|
||||
Caption = 'Очки:'
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -20
|
||||
Font.Name = 'MS Sans Serif'
|
||||
ParentFont = False
|
||||
end
|
||||
object ScoreLabel: TLabel
|
||||
Left = 193
|
||||
Height = 25
|
||||
Top = 560
|
||||
Width = 11
|
||||
Caption = '0'
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -20
|
||||
Font.Name = 'MS Sans Serif'
|
||||
ParentFont = False
|
||||
end
|
||||
object ImageList: TImageList
|
||||
Height = 22
|
||||
Width = 22
|
||||
Left = 50
|
||||
Top = 40
|
||||
Bitmap = {
|
||||
4C7A0500000016000000160000002F0000000000000078DAEDD8310100300C02
|
||||
30A4571ACE36193C3962226D5F0180A9E401006B170060EC7200C098200080BD
|
||||
0F140E46F1
|
||||
}
|
||||
end
|
||||
end
|
||||
@@ -0,0 +1,438 @@
|
||||
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.
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 1.3 KiB |
@@ -0,0 +1,78 @@
|
||||
unit Unit2;
|
||||
|
||||
{$mode ObjFPC}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Graphics;
|
||||
|
||||
type
|
||||
IGameHandler = interface
|
||||
procedure DoIteration;
|
||||
procedure Reset;
|
||||
procedure Finish;
|
||||
function IsFinished: Boolean;
|
||||
end;
|
||||
|
||||
TActionThread = class(TThread)
|
||||
public
|
||||
GameHandler: IGameHandler;
|
||||
|
||||
constructor Create(AGameHandler: IGameHandler);
|
||||
procedure Execute; override;
|
||||
end;
|
||||
|
||||
const
|
||||
FieldHeight = 20;
|
||||
FieldWidth = 10; { высота и ширина игрового поля }
|
||||
Delay = 6; { Задержка падения фигуры (в кадрах). }
|
||||
LinesPerLevel = 10;
|
||||
|
||||
var
|
||||
ActionThread: TActionThread;
|
||||
MSecsPerFrame: Integer; { миллисекунд на кадр }
|
||||
|
||||
Key_Space, Key_Left, Key_Right, Key_Down: Boolean; { состояния клавиш }
|
||||
Bitmaps: array[0..4] of TBitmap; { "строительные блоки" }
|
||||
Field: array[-1..FieldWidth, 0..FieldHeight] of Integer; { игровое поле }
|
||||
Pieces: array[1..7, 0..3, 0..3] of Integer = (
|
||||
((1,1,1,1), (0,0,0,0), (0,0,0,0), (0,0,0,0)),
|
||||
((1,1,0,0), (0,1,1,0), (0,0,0,0), (0,0,0,0)),
|
||||
((1,1,1,0), (0,0,1,0), (0,0,0,0), (0,0,0,0)),
|
||||
((1,1,0,0), (1,1,0,0), (0,0,0,0), (0,0,0,0)),
|
||||
((1,0,0,0), (1,1,0,0), (1,0,0,0), (0,0,0,0)),
|
||||
((0,0,1,0), (1,1,1,0), (0,0,0,0), (0,0,0,0)),
|
||||
((0,1,1,0), (1,1,0,0), (0,0,0,0), (0,0,0,0))
|
||||
);
|
||||
|
||||
implementation
|
||||
|
||||
constructor TActionThread.Create(AGameHandler: IGameHandler);
|
||||
begin
|
||||
inherited Create(false);
|
||||
GameHandler := AGameHandler
|
||||
end;
|
||||
|
||||
procedure TActionThread.Execute;
|
||||
var
|
||||
OldTime: TDateTime;
|
||||
ToWait: Integer;
|
||||
begin
|
||||
while not GameHandler.IsFinished do
|
||||
begin
|
||||
OldTime := Now;
|
||||
Synchronize(@GameHandler.DoIteration);
|
||||
{ Синхронизация с таймером. }
|
||||
ToWait := Round(MSecsPerFrame - (Now - OldTime) * MSecsPerDay);
|
||||
if ToWait > 0 then
|
||||
Sleep(ToWait)
|
||||
end;
|
||||
end;
|
||||
|
||||
exports
|
||||
MSecsPerFrame, Bitmaps, Field, Pieces,
|
||||
Key_Space, Key_Left, Key_Right, Key_Down;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user