diff options
Diffstat (limited to 'Занимательное программирование/7/6_tetris/Unit1.pas')
| -rw-r--r-- | Занимательное программирование/7/6_tetris/Unit1.pas | 438 |
1 files changed, 438 insertions, 0 deletions
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.
|