Base for Tetris Elektronika 60

WarPie90

May 17th, 2025

1,019

Never

Add comment

Not a member of Pastebin yet? Sign Up, it unlocks many cool features!

Delphi 5.51 KB | None | 0 0

raw download clone embed print report

program new;
(*
only thing implemented is `z` to rotate
*)
const
DEFAULT_START = 5;
TETRIS_ROWS = 15;
var
board: array of Char;
tetroLocation: Int32 = DEFAULT_START;
thisTetro: Int32 = 0;
thisRotation: Int32 = 0;
const
ui_row_width = 43;
ui_board_start = 19;
starting_ui = "
FULL LINES: 1 <! . . . . . . . . . .!>
LEVEL: 1 <! . . . . . . . . . .!>
SCORE: 1 <! . . . . . . . . . .!>
TIME: 00:00 <! . . . . . . . . . .!>
<! . . . . . . . . . .!>
<! . . . . . . . . . .!>
XXYYZZ <! . . . . . . . . . .!>
LL <! . . . . . . . . . .!>
PP <! . . . . . . . . . .!>
TT <! . . . . . . . . . .!>
<! . . . . . . . . . .!>
<! . . . . . . . . . .!>
<! . . . . . . . . . .!>
<! . . . . . . . . . .!>
<! . . . . . . . . . .!>
<! . . . . . . . . . .!>
<! . . . . . . . . . .!>
<! . . . . . . . . . .!>
<! . . . . . . . . . .!>
<! . . . . . . . . . .!>
<!********************!>
\/\/\/\/\/\/\/\/\/\/\/
PADDING
123456789
";
const
tetros: array of array of TByteArray = [
{|}
[[ 1, 11, 21, 31], [ 0, 1, 2, 3], [ 1, 11, 21, 31], [ 0, 1, 2, 3]],
{L shapes}
[[ 2, 10, 11, 12], [ 1, 11, 21, 22], [20, 10, 11, 12], [ 0, 01, 11, 21]],
[[ 0, 10, 11, 12], [ 2, 1, 11, 21], [10, 11, 12, 22], [30, 11, 21, 31]],
{T}
[[ 1, 10, 11, 12], [ 1, 12, 11, 21], [ 11, 0, 1, 2], [ 10, 1, 11, 21]],
{cube}
[[ 1, 2, 11, 12], [ 1, 2, 11, 12], [ 1, 2, 11, 12], [ 1, 2, 11, 12]],
{z}
[[ 0, 1, 11, 12], [11, 21, 20, 30], [ 0, 1, 11, 12], [11, 21, 20, 30]],
[[ 1, 2, 10, 11], [10, 20, 21, 31], [ 1, 2, 10, 11], [10, 20, 21, 31]]
];
function ToString(constref x:array of Char): string; override;
var i: Int32;
begin
for i:=0 to High(x) do
begin
if (i mod ui_row_width = 0) and (i > 0) then Result += LINE_SEP;
Result += x[i];
end;
end;
procedure SetRandomTetro();
begin
thisTetro := Random(Length(tetros));
end;
procedure RotateTetro();
begin
thisRotation := (thisRotation + 1) mod 4;
end;
function TBL(idx: Int32): Int32;
var x,y: Byte;
begin
x := idx mod 10;
y := idx div 10;
Result := y*ui_row_width+(x*2 + ui_board_start);
end;
function TBO(idx: Int32): Int32;
var x,y: Byte;
begin
x := idx mod 10;
y := idx div 10;
Result := y*ui_row_width+(x*2);
end;
function VerifyFreeSapce(): Boolean;
var lc := TBL(tetroLocation);
var curr := tetros[thisTetro][thisRotation];
begin
Result := (board[lc+TBO(curr[0])] in [' ', '.']) and
(board[lc+TBO(curr[1])] in [' ', '.']) and
(board[lc+TBO(curr[2])] in [' ', '.']) and
(board[lc+TBO(curr[3])] in [' ', '.']);
end;
procedure DrawTetroBox();
var lc := TBL(tetroLocation);
var curr := tetros[thisTetro][thisRotation];
begin
board[lc+TBO(curr[0])+0] := '[';
board[lc+TBO(curr[0])+1] := ']';
board[lc+TBO(curr[1])+0] := '[';
board[lc+TBO(curr[1])+1] := ']';
board[lc+TBO(curr[2])+0] := '[';
board[lc+TBO(curr[2])+1] := ']';
board[lc+TBO(curr[3])+0] := '[';
board[lc+TBO(curr[3])+1] := ']';
end;
procedure ClearTetroBox();
var lc := TBL(tetroLocation);
var curr := tetros[thisTetro][thisRotation];
begin
board[lc+TBO(curr[0])+0] := ' ';
board[lc+TBO(curr[0])+1] := '.';
board[lc+TBO(curr[1])+0] := ' ';
board[lc+TBO(curr[1])+1] := '.';
board[lc+TBO(curr[2])+0] := ' ';
board[lc+TBO(curr[2])+1] := '.';
board[lc+TBO(curr[3])+0] := ' ';
board[lc+TBO(curr[3])+1] := '.';
end;
procedure DropTetro();
begin
Inc(tetroLocation, 10);
end;
procedure UndropTetro();
begin
Dec(tetroLocation, 10);
end;
var
i:int32;
TetrisFrame: TImage;
ticker: TCountDown;
begin
SetLength(board, Length(starting_ui));
Move(starting_ui[1], board[0], Length(starting_ui));
TetrisFrame := TImage.Create(500,1000); //this could be a form
TetrisFrame.FontName := 'Consolas';
tetrisFrame.FontSize := 15;
TetrisFrame.FontAntialiasing := False; {!!!}
TetrisFrame.FontBold := False;
TetrisFrame.Show();
SetRandomTetro();
while true do
begin
TetrisFrame.DrawColor := 0;
TetrisFrame.DrawText(ToString(board), [50,50]);
ClearTetroBox();
DropTetro();
if not VerifyFreeSapce() then
begin
UnDropTetro();
DrawTetroBox();
TetrisFrame.DrawColor := $0077FF;
TetrisFrame.DrawText(ToString(board), [50,50]);
TetrisFrame.Show(False);
SetRandomTetro();
tetroLocation := Random(2,8);// DEFAULT_START;
thisRotation := 0;
// still not free!?¤!"¤"!#%"#%
//if not VerifyFreeSapce() then
// TerminateScript('Game over');
end else
begin
DrawTetroBox();
TetrisFrame.DrawColor := $0077FF;
TetrisFrame.DrawText(ToString(board), [50,50]);
TetrisFrame.Show(False);
end;
ticker.Start(300);
while not ticker.IsFinished do
begin
if Target.KeyPressed(EKeyCode.Z) then
begin
ClearTetroBox();
TetrisFrame.DrawColor := $0077FF;
TetrisFrame.Clear();
RotateTetro();
DrawTetroBox();
while Target.KeyPressed(EKeyCode.Z) and (not ticker.IsFinished) do sleep(1);
end;
end;
end;
end.

Add Comment

Please, Sign In to add comment