Закончил тетрис из 7-й главы, шестого упражнения

7 files changed, 881 insertions, 0 deletions

diff --git a/Занимательное программирование/7/6_tetris/Tetris.lpi b/Занимательное программирование/7/6_tetris/Tetris.lpi
new file mode 100644
index 0000000..4f7b8f8
--- /dev/null
+++ b/Занимательное программирование/7/6_tetris/Tetris.lpi
@@ -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>
diff --git a/Занимательное программирование/7/6_tetris/Tetris.lpr b/Занимательное программирование/7/6_tetris/Tetris.lpr
new file mode 100644
index 0000000..31a2f97
--- /dev/null
+++ b/Занимательное программирование/7/6_tetris/Tetris.lpr
@@ -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.

diff --git a/Занимательное программирование/7/6_tetris/Tetris.lps b/Занимательное программирование/7/6_tetris/Tetris.lps
new file mode 100644
index 0000000..d4a0d31
--- /dev/null
+++ b/Занимательное программирование/7/6_tetris/Tetris.lps
@@ -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>

diff --git a/Занимательное программирование/7/6_tetris/Unit1.lfm b/Занимательное программирование/7/6_tetris/Unit1.lfm
new file mode 100644
index 0000000..c11d25a
--- /dev/null
+++ b/Занимательное программирование/7/6_tetris/Unit1.lfm
@@ -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

diff --git a/Занимательное программирование/7/6_tetris/Unit1.pas b/Занимательное программирование/7/6_tetris/Unit1.pas
new file mode 100644
index 0000000..91fd894
--- /dev/null
+++ b/Занимательное программирование/7/6_tetris/Unit1.pas
@@ -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.

diff --git a/Занимательное программирование/7/6_tetris/pics.bmp b/Занимательное программирование/7/6_tetris/pics.bmp
new file mode 100644
index 0000000..35500fd
--- /dev/null
+++ b/Занимательное программирование/7/6_tetris/pics.bmp
diff --git a/Занимательное программирование/7/6_tetris/unit2.pas b/Занимательное программирование/7/6_tetris/unit2.pas
new file mode 100644
index 0000000..2ac9fea
--- /dev/null
+++ b/Занимательное программирование/7/6_tetris/unit2.pas
@@ -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.

+