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 @@
+
+
+
+
+
+
+
+
+
+
+
+ -
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ -
+
+
+ -
+
+
+ -
+
+
+
+
+
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 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
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
Binary files /dev/null and b/Занимательное программирование/7/6_tetris/pics.bmp differ
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.
+