unit project1;
{$mode objfpc}{$H+}
interface
uses
Windows, Messages, SysUtils,
Variants, Classes, Graphics,
Controls, Forms, Dialogs, ExtCtrls,
StdCtrls, Interfaces;
type
TPlayerCommand = (
cmdLeft,
cmdRight,
cmdRotateCW,
cmdRotateCCW,
cmdDrop,
cmdFastModeOn,
cmdFastModeOff,
cmdHold
);
TRotationsArray = array[1..4, 1..2] of integer;
TTetrisShape = record
Rotations: array[1..4] of TRotationsArray;
RotationsAmount: integer;
PosX, PosY: integer;
CurrentRotation: integer;
Index: integer;
end;
{ TMainForm }
TMainForm = class(TForm)
GameScreen: TImage;
HoldingScreen: TImage;
BufferingImage: TImage;
BlocksImage: TImage;
NextScreen: TImage;
Label1: TLabel;
Label2: TLabel;
GameTimer: TTimer;
function CreateRotation(xl, yl, x2, y2, x3, y3, x4, y4: integer): TRotationsArray;
procedure AddPossibleShape(pos_x, pos_y: integer);
procedure AddRotation(xl, yl, x2, y2, x3, y3, x4, y4: integer);
procedure PrepareGame();
procedure FormCreate(Sender: TObject);
procedure NewGame () ;
procedure ResetField();
procedure GenerateNextTetriminos();
procedure StartNewShape(index: integer);
procedure StartNewNextShape();
procedure Holding();
function IsShiftPossible(dx, dy: integer): boolean;
procedure GameTick () ;
procedure FixateActiveShape ();
procedure GameOver () ;
function CheckFieldOverflow(): boolean;
function InRange(x, y: integer): boolean;
procedure DeleteCompleteLines();
procedure RotateActiveShape(clockwise: boolean);
procedure ActiveShapeToField(color1: integer);
procedure SetFastMode(mode: boolean);
procedure RedrawField();
procedure RedrawHolding () ;
procedure RedrawNextShapes();
procedure PlayerInteract(cmd: TPlayerCommand);
procedure GameTimerTimer (Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
private
public
end;
var
MainForm: TMainForm;
Field: array[1..10, -5..20] of integer;
LowField, Low2Field, HighField, High2Field: integer;
NextTetriminos: array[1..4] of integer;
PossibleShapes: array[1..7] of TTetrisShape;
PossibleShapesAmount: integer;
ActiveShape: TTetrisShape;
CanSkipTick: boolean;
HoldingIndex: integer;
HoldingAvailable: boolean;
Score: integer;
FastMode: boolean;
const
SCORE_FOR_LINES: array[0..4] of integer = (0, 100, 300, 700, 1500);
SCORE_FOR_SHIFTDOWN: integer = 3;
GAME_DIFFICULTY: integer = 200;
CELL_SIZE: integer = 20;
SNAPSHOT_WIDTH: integer = 100;
SNAPSHOT_HEIGHT: integer = 70;
implementation
{$R *.lfm}
function TMainForm.CreateRotation(
xl, yl, x2, y2, x3, y3, x4, y4: integer): TRotationsArray;
begin
// вспомогательная функция, создавшая положение фигуры по 4и точкам
result[1][1] := xl;
result[1][2] := yl;
result[2][1] := x2;
result[2][2] := y2;
result[3][1] := x3;
result[3][2] := y3;
result[4][1] := x4;
result[4][2] := y4;
end;
procedure TMainForm.AddPossibleShape(pos_x, pos_y: integer);
var
shape_idx: integer;
begin
// фунция, которая добавляет в фигуру без возможных положении
// в конец списка возможных фигур
inc(PossibleShapesAmount);
shape_idx := PossibleShapesAmount;
PossibleShapes[shape_idx].Index := shape_idx;
PossibleShapes[shape_idx].PosX := pos_x;
PossibleShapes[shape_idx].PosY := pos_y;
PossibleShapes[shape_idx].CurrentRotation := 1;
PossibleShapes[shape_idx].RotationsAmount := 0;
end;
procedure TMainForm.AddRotation(xl, yl, x2, y2,
x3, y3, x4, y4: integer);
var
rotation_idx: integer;
begin
inc(PossibleShapes[PossibleShapesAmount].RotationsAmount);
rotation_idx := PossibleShapes[PossibleShapesAmount].RotationsAmount;
PossibleShapes[PossibleShapesAmount].Rotations[rotation_idx] := CreateRotation(xl, yl, x2, y2, x3, y3, x4, y4);
end;
procedure TMainForm.PrepareGame () ;
begin
// подготови±£ генератор случайных чисел
Randomize;
// настроим котороткие указатели на границы игрового поля
LowField := Low(Field);
HighField := High(Field);
Low2Field := Low(Field[Low(Field)]);
High2Field := High(Field[High(Field)]);
// загрузни изображения игровых блоков
BlocksImage.Picture.LoadFromFile ('graphics/Blocks.bmp') ;
// подготовии фигуры
PossibleShapesAmount := 0;
// фигура I [1]
AddPossibleShape(6, 0);
AddRotation(-2, 0, {} -1, 0, {} 0, 0, {} 1, 0) ;
AddRotation(0, -2, {} 0, -1, {} 0, 0, {} 0, 1) ;
// фигура Z [2]
AddPossibleShape(6, -1);
AddRotation(-1, 0, {} 0, 0, {} 0, 1, {} 1, 1);
AddRotation(1, -1, {} 1, 0, {} 0, 0, {} 0, 1);
// фигура S [3]
AddPossibleShape(6, -1);
AddRotation(1, 0, {} 0, 0, {} 0, 1, {} -1, 1);
AddRotation(-1, -1, {} -1, 0, {} 0, 0, {} 0, 1) ;
// фигура L [4]
AddPossibleShape(5, -1);
AddRotation(0, -1, {} 0, 0, {} 0, 1, {} 1, 1);
AddRotation(1, 0, {} 0, 0, {} -1, 0, {} -1, 1);
AddRotation(0, 1, {} 0, 0, {} 0, -1, {} -1, -1);
AddRotation(-1, 0, {} 0, 0, {} 1, 0, {} 1, -1);
// фигура J [5]
AddPossibleShape(6, -1);
AddRotation(0, -1, {} 0, 0, {} 0, 1, {} 1, 1);
AddRotation(1, 0, {} 0, 0, {} -1, 0, {} -1, -1);
AddRotation(0, 1, {} 0, 0, {} 0, -1, {} 1, -1);
AddRotation(-1, 0, {} 0, 0, {} 1, 0, {} 1, 1);
// фигура O [6]
AddPossibleShape(5, -1);
AddRotation(0, 0, {} 1, 0, {} 0, 1, {} 1, 1);
// фигура T [7]
AddPossibleShape(6, -1);
AddRotation(0, 0, {} 1, 0, {} 0, 1, {} 1, 0);
AddRotation(0, 0, {} 0, -1,{} 0, 1, {} -1, 0);
AddRotation(0, 0, {} 1, 0, {} 0, -1, {} -1, 0);
AddRotation(0, 0, {} 1, 0, {} 0, 1, {} 0, -1);
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
// подготовим игру
PrepareGame () ;
MainForm.Color := clWhite;
// стартовое сообщение
Application.MessageBox(
'Тетрис - игра б которой нужно составлять ' +
'горизонтальные линии из падающих фигурок передвигая ' +
' и вращая их в полете. Цель - продержаться как можно дольше ' +
'до полного заполнения игрового поля. Управление: ' +
'Q и Е - вращение фигуры, А и D - перемещение фигуры, W и S -' +
'падение фигуры, SPACE - удержание фигуры.',
'Тетрис'
);
// начнем новую игру
NewGame () ;
end;
procedure TMainForm. NewGame () ;
begin
ResetField();
GenerateNextTetriminos();
StartNewNextShape();
HoldingAvailable := true;
HoldingIndex := 0;
Score := 0;
SetFastMode (false) ;
RedrawField();
RedrawHolding();
RedrawNextShapes();
GameTimer.Tag := 0;
GameTimer.Enabled := true;
end;
procedure TMainForm.ResetField() ;
var
idx, idx2: longint;
begin
for idx := LowField to HighField do
for idx2 := Low2Field to High2Field do
Field[idx][idx2] := 0;
end;
procedure TMainForm.GenerateNextTetriminos() ;
var
idx: integer;
begin
for idx := Low(NextTetriminos) to High(NextTetriminos) do
NextTetriminos[idx] := 1 + Random(PossibleShapesAmount)
end;
procedure TMainForm.StartNewShape(index: integer);
begin
ActiveShape := PossibleShapes[index];
end;
procedure TMainForm.StartNewNextShape();
var
new_shape_index: integer;
idx: integer;
begin
// возьмем новый элемент из очереди
new_shape_index := NextTetriminos[Low(NextTetriminos)];
// сдвинем очередь на позиция вперед
for idx := Low(NextTetriminos) to High(NextTetriminos)-1 do
NextTetriminos[idx] := NextTetriminos [idx+1];
// сгенерируем новый элемент и добавим в конец очереди
NextTetriminos[High(NextTetriminos)] :=
1 + Random(PossibleShapesAmount);
// создадим фигуру с получении:* индексом на поле
StartNewShape(new_shape_index);
// перерисуем очередь следующих фигур на экране
RedrawNextShapes();
end;
procedure TMainForm.Holding();
var
tmp: integer;
begin
// отмени:* повторные использования
if not HoldingAvailable then exit;
HoldingAvailable := false;
// поменяем местами фигуру на поле и фигуру в буфере
// если буфер пуст, то возьмем фигуру из очереди следузжих
tmp := ActiveShape.Index;
if HoldingIndex = 0
then StartNewNextShape()
else StartNewShape(HoldingIndex);
HoldingIndex := tmp;
// перерисуем буфер удерживания на экране
RedrawHolding();
end;
function TMainForm.IsShiftPossible(dx, dy: integer): boolean;
var
idx, x, y: integer;
cur_rotation: TRotationsArray;
begin
// проверяем возможно ли сдвинуть фигуру на dx по х и на dy по у
result := true;
cur_rotation := ActiveShape.Rotations[ActiveShape.CurrentRotation];
for idx := Low(cur_rotation) to High(cur_rotation) do
begin
// для каждой точки в текущем положении фигуры проверим,
// если ее сместить указанным образом не столкнется ли
// она с другими клетками и выйдет ли за пределы поля
x := ActiveShape.PosX + cur_rotation[idx][1];
y := ActiveShape.PosY + cur_rotation[idx][2];
if not InRange(x+dx, y+dy) then
result := false
else if Field[x+dx][y+dy] > 0 then
result := false;
end;
end;
procedure TMainForm.GameTick();
begin
// увеличим счетчик тиков
GameTimer.Tag := GameTimer.Tag + 1 ;
// если можно сместить фигуру вниз, то сделаем это
if IsShiftPossible(0, 1) then
inc(ActiveShape.PosY)
else // иначе, если можно пропустить один тик, то сделаем это
if CanSkipTick
then CanSkipTick := false
else FixateActiveShape(); // если нельзя, то фиксируем фигуру на поле
// перерисуем игровое поле
RedrawField();
// начислим очки за быстрый режим
if FastMode then Score := Score + SCORE_FOR_SHIFTDOWN;
// обновим счет на экране
MainForm.Caption := 'Тетрис - Счет: ' + IntToStr(Score);
end;
procedure TMainForm.FixateActiveShape();
begin
// отпечаег Есе клетки фигуры ее цветом на игровом поле
ActiveShapeToField(ActiveShape.Index);
// проверим наличие заполненных горизонтальных линии
DeleteCompleteLines();
// проверим переполнение игрового поля
if CheckFieldOverflow() then
begin // заканчиваем игру и выходии
GameOver();
exit;
end;
// поставим на поел следующую фигуру
StartNewNextShape();
// разблокируем функция удержания
HoldingAvailable := true;
end;
procedure TMainForm.GameOver () ;
var
msg: string;
begin
// остановим игру
GameTimer.Enabled := false;
// покажем сообщение
msg := 'Game over! Ваш счет - ' + IntToStr(Score);
Application.MessageBox(PChar(msg), 'Game over!');
// начнем заново
NewGame();
end;
function TMainForm.CheckFieldOverflow(): boolean;
var
idx: integer;
begin
// проверим наличие статичных элементов в невидимой верхней части поля
result := false;
for idx := LowField to HighField do
if Field[idx][-1] > 0 then
result := true;
end;
function TMainForm.InRange(x, y: integer): boolean;
begin
// точка e границах поля
result := (LowField <= x) and (x <= HighField)
and (Low2Field <= y) and (y <= High2Field)
end;
procedure TMainForm.ActiveShapeToField(color1: integer);
var
idx, x, y: integer;
cur_rotation: TRotationsArray;
begin
// огпеэагае;/ все точки фигуры на поле заданны:/ ц е з т о м
cur_rotation := ActiveShape.Rotations[ActiveShape.CurrentRotation];
for idx := Low(cur_rotation) to High(cur_rotation) do
begin
x := ActiveShape.PosX + cur_rotation[idx][1];
y := ActiveShape.PosY + cur_rotation[idx] [2];
Field[x][y] := color;
end;
end;
procedure TMainForm.DeleteCompleteLines();
var
line, idx, prevline: integer;
is_complete: boolean;
lines_deleted: integer;
begin
// проверяем Есе горизонтальные линии поля начиная сверху
lines_deleted := 0;
for line := Low2Field to High2Field do
begin
is_complete := true;
for idx := LowField to HighField do
if Field[idx][line] = 0 then is_complete := false;
// если нашли заполненную, то удали:/ ее и сдвинем
// е сю верхнюю часть поля е н и з на 1
if is_complete then
begin
inc (lines_deleted); // увеличиваем счетчик уничтоженных линий
for prevline := line downto LowField+1 do
for idx := LowField to HighField do
Field[idx][prevline] := Field[idx][prevline-1];
end;
end;
// начисляем очки за уничтоженные линии
Score := Score + SCORE_FOR_LINES[lines_deleted];
end;
procedure TMainForm.RotateActiveShape(clockwise: boolean);
var
outstep: integer;
idx, x, y: integer;
new_rotation_idx: integer;
new_rotation: TRotationsArray;
is_possible: boolean;
const
// Возможные смешения центра фигуры:
// 1 - это начальный центр - точка (0, 0)
outstep_x: array[1..9] of integer = (0, 0, 1, -1, 1, -1, 2, -2, 0);
outstep_y: array[1..9] of integer = (0, -1, 0, 0, -1, -1, 0, 0, -2);
begin
new_rotation_idx := ActiveShape.CurrentRotation;
if clockwise then
begin // по часовой
inc(new_rotation_idx);
if new_rotation_idx > ActiveShape.RotationsAmount then
new_rotation_idx := 1;
end
else
begin // против часовой
dec(new_rotation_idx);
if new_rotation_idx < 1 then
new_rotation_idx := ActiveShape.RotationsAmount;
end;
// новое положение фигуры
new_rotation := ActiveShape.Rotations[new_rotation_idx];
// будем перебирать cue здания центра фигуры
// пока не надйдем не конфликтугшее с полем,
// и если найдем такое, го закрепим его е фигуре
for outstep := Low(outstep_x) to High(outstep_x) do
begin
is_possible := true;
for idx := Low(new_rotation) to High(new_rotation) do
begin
// для каждой клетки проверяем конфликты
// с границами и статичными элементами
x := ActiveShape.PosX + outstep_x[outstep] + new_rotation[idx][1];
y := ActiveShape.PosY + outstep_y[outstep] + new_rotation[idx][2];
if not InRange(x, y) then is_possible := false
else if Field[x] [y] > 0 then is_possible := false;
end;
if is_possible then
begin // если нет конфликтов, то закрепляем его и еыходрсл
ActiveShape.PosX := ActiveShape.PosX + outstep_x[outstep];
ActiveShape.PosY := ActiveShape.PosY + outstep_y[outstep];
Activeshape.CurrentRotation := new_rotation_idx;
exit;
end;
end;
end;
procedure TMainForm.SetFastMode(mode: boolean);
begin
// ус тана влив а ем быстрый режи!£ и меняем скорость игры
if mode
then GameTimer . Interval := GAME_DIFFICULTY div 10
else GameTimer. Interval := GAME_DIFFICULTY;
FastMode := mode;
end;
procedure TMainForm.RedrawField();
var
idx, line: integer;
dest, src: TRect;
begin
// отпечатаем фигуру на поле
ActiveShapeToField(ActiveShape.Index);
// для к аж ой клетки поля нарисеум ее содержимое
for line := Low2Field to High2Field do
for idx := LowField to HighField do
begin
dest := Bounds(
(idx-1)*CELL_SIZE, (line-1)*CELL_SIZE,
CELL_SIZE, CELL_SIZE
);
src := Bounds(
Field[idx][line]*CELL_SIZE, 0,
CELL_SIZE, CELL_SIZE
);
GameScreen.Canvas.CopyRect(dest, BlocksImage.Canvas, src);
end;
// уберег/ активную фигуру со статичного поля
ActiveShapeToField(0);
end;
procedure TMainForm. RedrawHolding () ;
begin
// загрузиг/ нужное изображние
HoldingScreen.Picture.LoadFromFile(
'graphics/Shape ' + IntToStr(HoldingIndex) + ' . bmp');
end;
procedure TMainForm. RedrawNextShapes () ;
var
dest, src: TRect;
idx: integer;
outstep_y: integer;
begin
outstep_y := 0;
for idx := Low(NextTetriminos) to High(NextTetriminos) do
begin
// для каждого элемента в очереди загрузим нужное иэображние
// в буфер и отобразим его в нужном положении экрана
BufferingImage.Picture.LoadFromFile (
'graphics/Shape_' + IntToStr(NextTetriminos[idx]) + '.bmp');
src := Bounds(0, 0, SNAPSHOT_WIDTH, SNAPSHOT_HEIGHT);
dest := Bounds(0, outstep_y, SNAPSHOT_WIDTH, SNAPSHOT_HEIGHT);
NextScreen.Canvas.CopyRect(dest, BufferingImage.Canvas, src);
outstep_y := outstep_y + SNAPSHOT_HEIGHT;
end;
end;
procedure TMainForm.PlayerInteract (cmd: TPlayerCommand) ;
begin
// обработаем взаимодействия игрока игрока
case cmd of
cmdLeft: // если возможно, сдвинем влево
if IsShiftPossible(-1, 0) then
dec(ActiveShape.PosX);
cmdRight: // если возможно, сдвинем вправо
if IsShiftPossible(1, 0) then
inc(ActiveShape.PosX);
cmdRotateCW: // если возможно, повернем на 90' по часовой стрелке
RotateActiveShape(true);
cmdRotateCCW: // если возможно, повернем на 90' против часовой стрелки
RotateActiveShape(false);
cmdDrop: // опустим фигуру вниз до предела и начислим очки
while IsShiftPossible(0, 1) do
begin
inc(ActiveShape.PosY);
Score := Score + SCORE_FOR_SHIFTDOWN;
CanSkipTick := false;
end;
cmdFastModeOn: // установим быстрый режим
SetFastMode (true);
cmdFastModeOff: // снимем быстрый режима
SetFastMode(false);
cmdHold: // если возможно, поместим фигуру в буфер удержания
Holding();
end;
CanSkipTick := true;
RedrawField();
end;
procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
// переведем нажатия кнопок во взаимодействия игрока
if Char(Key) = 'D' then PlayerInteract (cmdRight)
else if Char(Key) = 'A' then PlayerInteract(cmdLeft)
else if Char(Key) = 'E' then PlayerInteract(cmdRotateCW)
else if Char(Key) = 'Q' then PlayerInteract (cmdRotateCCW)
else if Char(Key) = 'w' then PlayerInteract (cmdDrop)
else if Char(Key) = 'S' then PlayerInteract (cmdFastModeOn)
else if Char(Key) = ' ' then PlayerInteract(cmdHold);
end;
procedure TMainForm.FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
// переведем нажатия кнопок во взаимодействия игрока
if Char(Key) = 'S' then PlayerInteract(cmdFastModeOff);
end;
procedure TMainForm.GameTimerTimer(Sender: TObject);
begin
GameTick();
end;
end.