$ include "seed7_05.s7i";
include "time.s7i";
include "duration.s7i";
include "float.s7i";
include "draw.s7i";
include "stdfont9.s7i";
include "pixmap_file.s7i";
include "keybd.s7i";
const integer: FIELD_HEIGHT is 20;
const integer: FIELD_WIDTH is 10;
const integer: FIELD_X_START is 8;
const integer: FIELD_Y_START is 8;
const integer: BLOCK_SIZE is 32;
const integer: WINDOW_WIDTH is 660;
const integer: WINDOW_HEIGHT is FIELD_HEIGHT * BLOCK_SIZE + 2 * FIELD_Y_START;
const integer: AREA_WIDTH is FIELD_WIDTH * BLOCK_SIZE + 2 * FIELD_X_START;
var text: info_sheet is STD_NULL;
var boolean: quit_round is FALSE;
var integer: score is 0;
var integer: level is 1;
var duration: delta is 50000 . MICRO_SECONDS;
var integer: counter_start is 5;
const type: bool_list is array boolean;
var array bool_list: occupied is 0 times 0 times FALSE;
const type: rot_position is new enum
ROT_1, ROT_2, ROT_3, ROT_4
end enum;
const type: tetromino_type is new enum
SQUARE_BLOCK, I_BAR, S_ZIGZAG, Z_ZIGZAG, GAMMA_KNEE, L_KNEE, T_BRANCH
end enum;
const func integer: score (ref tetromino_type: tetromino) is DYNAMIC;
const integer: score (SQUARE_BLOCK) is 1;
const integer: score (I_BAR) is 2;
const integer: score (S_ZIGZAG) is 3;
const integer: score (Z_ZIGZAG) is 4;
const integer: score (GAMMA_KNEE) is 5;
const integer: score (L_KNEE) is 6;
const integer: score (T_BRANCH) is 7;
const func color: color (ref tetromino_type: tetromino) is DYNAMIC;
const color: color (SQUARE_BLOCK) is dark_blue;
const color: color (I_BAR) is dark_red;
const color: color (S_ZIGZAG) is light_green;
const color: color (Z_ZIGZAG) is light_cyan;
const color: color (GAMMA_KNEE) is light_gray;
const color: color (L_KNEE) is dark_magenta;
const color: color (T_BRANCH) is brown;
var array tetromino_type: tetromino_list is [](SQUARE_BLOCK, I_BAR, S_ZIGZAG, Z_ZIGZAG,
GAMMA_KNEE, L_KNEE, T_BRANCH);
const type: stri_list is array string;
const func stri_list: PATTERN (ref tetromino_type: tetromino, ref rot_position: rot_pos) is DYNAMIC;
const stri_list: PATTERN (SQUARE_BLOCK, ROT_1) is [](
"## ",
"## ",
" ",
" ");
const stri_list: PATTERN (SQUARE_BLOCK, ROT_2) is PATTERN(SQUARE_BLOCK, ROT_1);
const stri_list: PATTERN (SQUARE_BLOCK, ROT_3) is PATTERN(SQUARE_BLOCK, ROT_1);
const stri_list: PATTERN (SQUARE_BLOCK, ROT_4) is PATTERN(SQUARE_BLOCK, ROT_1);
const stri_list: PATTERN (I_BAR, ROT_1) is [](
" # ",
" # ",
" # ",
" # ");
const stri_list: PATTERN (I_BAR, ROT_2) is [](
" ",
"####",
" ",
" ");
const stri_list: PATTERN (I_BAR, ROT_3) is PATTERN(I_BAR, ROT_1);
const stri_list: PATTERN (I_BAR, ROT_4) is PATTERN(I_BAR, ROT_2);
const stri_list: PATTERN (S_ZIGZAG, ROT_1) is [](
" ## ",
"## ",
" ",
" ");
const stri_list: PATTERN (S_ZIGZAG, ROT_2) is [](
"# ",
"## ",
" # ",
" ");
const stri_list: PATTERN (S_ZIGZAG, ROT_3) is PATTERN(S_ZIGZAG, ROT_1);
const stri_list: PATTERN (S_ZIGZAG, ROT_4) is PATTERN(S_ZIGZAG, ROT_2);
const stri_list: PATTERN (Z_ZIGZAG, ROT_1) is [](
"## ",
" ## ",
" ",
" ");
const stri_list: PATTERN (Z_ZIGZAG, ROT_2) is [](
" # ",
"## ",
"# ",
" ");
const stri_list: PATTERN (Z_ZIGZAG, ROT_3) is PATTERN(Z_ZIGZAG, ROT_1);
const stri_list: PATTERN (Z_ZIGZAG, ROT_4) is PATTERN(Z_ZIGZAG, ROT_2);
const stri_list: PATTERN (GAMMA_KNEE, ROT_1) is [](
" # ",
" # ",
" ## ",
" ");
const stri_list: PATTERN (GAMMA_KNEE, ROT_2) is [](
" ",
"### ",
" # ",
" ");
const stri_list: PATTERN (GAMMA_KNEE, ROT_3) is [](
" ",
" ## ",
" # ",
" # ");
const stri_list: PATTERN (GAMMA_KNEE, ROT_4) is [](
" ",
" # ",
" ###",
" ");
const stri_list: PATTERN (L_KNEE, ROT_1) is [](
" # ",
" # ",
" ## ",
" ");
const stri_list: PATTERN (L_KNEE, ROT_2) is [](
" ",
" # ",
"### ",
" ");
const stri_list: PATTERN (L_KNEE, ROT_3) is [](
" ",
" ## ",
" # ",
" # ");
const stri_list: PATTERN (L_KNEE, ROT_4) is [](
" ",
" ###",
" # ",
" ");
const stri_list: PATTERN (T_BRANCH, ROT_1) is [](
" # ",
"### ",
" ",
" ");
const stri_list: PATTERN (T_BRANCH, ROT_2) is [](
" # ",
"## ",
" # ",
" ");
const stri_list: PATTERN (T_BRANCH, ROT_3) is [](
" ",
"### ",
" # ",
" ");
const stri_list: PATTERN (T_BRANCH, ROT_4) is [](
" # ",
" ## ",
" # ",
" ");
const type: piece is new struct
var tetromino_type: tetromino is SQUARE_BLOCK;
var integer: line_pos is 0;
var integer: column_pos is 0;
var rot_position: rot_pos is ROT_1;
var boolean: moving is TRUE;
end struct;
const proc: next (inout rot_position: rot_pos) is func
begin
if rot_pos = ROT_4 then
rot_pos := ROT_1
else
rot_pos := succ(rot_pos);
end if;
end func;
const proc: prev (inout rot_position: rot_pos) is func
begin
if rot_pos = ROT_1 then
rot_pos := ROT_4
else
rot_pos := pred(rot_pos);
end if;
end func;
const proc: show (in piece: actual_piece) is func
local
var integer: line is 0;
var integer: column is 0;
begin
for line range 1 to 4 do
for column range 1 to 4 do
if PATTERN(actual_piece.tetromino, actual_piece.rot_pos)[line][column] <> ' ' then
rect(FIELD_X_START + ((actual_piece.column_pos + column - 2) * BLOCK_SIZE),
FIELD_Y_START + ((actual_piece.line_pos + line - 2) * BLOCK_SIZE),
BLOCK_SIZE, BLOCK_SIZE, color(actual_piece.tetromino));
end if;
end for;
end for;
end func;
const proc: hide (in piece: actual_piece) is func
local
var integer: line is 0;
var integer: column is 0;
begin
for line range 1 to 4 do
for column range 1 to 4 do
if PATTERN(actual_piece.tetromino, actual_piece.rot_pos)[line][column] <> ' ' then
rect(FIELD_X_START + ((actual_piece.column_pos + column - 2) * BLOCK_SIZE),
FIELD_Y_START + ((actual_piece.line_pos + line - 2) * BLOCK_SIZE),
BLOCK_SIZE, BLOCK_SIZE, black);
end if;
end for;
end for;
end func;
const func boolean: is_occupied (in piece: actual_piece) is func
result
var boolean: is_occupied is FALSE;
local
var integer: line is 0;
var integer: column is 0;
begin
for line range 1 to 4 do
for column range 1 to 4 do
if PATTERN(actual_piece.tetromino, actual_piece.rot_pos)[line][column] <> ' ' and
occupied[pred(actual_piece.line_pos + line)]
[actual_piece.column_pos + column + 2] then
is_occupied := TRUE;
end if;
end for;
end for;
end func;
const proc: do_occupie (in piece: actual_piece) is func
local
var integer: line is 0;
var integer: column is 0;
begin
for line range 1 to 4 do
for column range 1 to 4 do
if PATTERN(actual_piece.tetromino, actual_piece.rot_pos)[line][column] <> ' ' then
occupied[pred(actual_piece.line_pos + line)]
[actual_piece.column_pos + column + 2] := TRUE;
end if;
end for;
end for;
end func;
const proc: left (inout piece: actual_piece) is func
begin
hide(actual_piece);
decr(actual_piece.column_pos);
if is_occupied(actual_piece) then
incr(actual_piece.column_pos);
end if;
show(actual_piece);
end func;
const proc: right (inout piece: actual_piece) is func
begin
hide(actual_piece);
incr(actual_piece.column_pos);
if is_occupied(actual_piece) then
decr(actual_piece.column_pos);
end if;
show(actual_piece);
end func;
const proc: rotate (inout piece: actual_piece) is func
begin
hide(actual_piece);
next(actual_piece.rot_pos);
if is_occupied(actual_piece) then
prev(actual_piece.rot_pos);
end if;
show(actual_piece);
end func;
const proc: down (inout piece: actual_piece) is func
begin
hide(actual_piece);
incr(actual_piece.line_pos);
if is_occupied(actual_piece) then
decr(actual_piece.line_pos);
do_occupie(actual_piece);
actual_piece.moving := FALSE;
end if;
show(actual_piece);
end func;
const proc: position (inout piece: actual_piece, in integer: line, in integer: column) is func
begin
actual_piece.line_pos := line;
actual_piece.column_pos := column;
actual_piece.rot_pos := ROT_1;
actual_piece.moving := TRUE;
show(actual_piece);
end func;
const proc: drop (inout piece: actual_piece) is func
begin
hide(actual_piece);
score +:= (FIELD_HEIGHT - actual_piece.line_pos) div 4;
repeat
incr(actual_piece.line_pos);
until is_occupied(actual_piece);
decr(actual_piece.line_pos);
do_occupie(actual_piece);
actual_piece.moving := FALSE;
show(actual_piece);
end func;
const proc: set_piece (in tetromino_type: tetromino) is func
local
var piece: actual_piece is piece.value;
var time: start_time is time.value;
var integer: counter is 0;
var char: command is ' ';
begin
actual_piece.tetromino := tetromino;
position(actual_piece, 1, 5);
flushGraphic;
if not is_occupied(actual_piece) then
counter := counter_start;
command := getc(KEYBOARD, NO_WAIT);
while actual_piece.moving do
start_time := time(NOW);
if command = KEY_LEFT then
left(actual_piece);
elsif command = KEY_RIGHT then
right(actual_piece);
elsif command = KEY_UP then
rotate(actual_piece);
elsif command = KEY_DOWN or command = KEY_PAD_CENTER then
drop(actual_piece);
elsif command = 'q' or command = 'Q' or command = KEY_CLOSE then
actual_piece.moving := FALSE;
quit_round := TRUE;
end if;
if counter = 0 then
down(actual_piece);
counter := counter_start;
end if;
flushGraphic;
decr(counter);
await(start_time + delta);
command := getc(KEYBOARD, NO_WAIT);
end while;
score +:= level + score(actual_piece.tetromino);
if score > 1000 * level then
incr(level);
setPos(info_sheet, 16, 1);
write(info_sheet, " Level: " <& level <& " ");
decr(counter_start);
end if;
setPos(info_sheet, 14, 1);
write(info_sheet, " Score: " <& score <& " ");
flush(info_sheet);
else
quit_round := TRUE;
end if;
end func;
const proc: remove_full_lines is func
local
var integer: line is 0;
var integer: column is 0;
var boolean: full is TRUE;
var PRIMITIVE_WINDOW: buffer is PRIMITIVE_WINDOW.value;
begin
for line range 1 to FIELD_HEIGHT do
full := TRUE;
for column range 4 to pred(FIELD_WIDTH + 4) do
if not occupied[line][column] then
full := FALSE;
end if;
end for;
if full then
occupied := 1 times
(3 times TRUE & FIELD_WIDTH times FALSE & 3 times TRUE) &
occupied[ .. pred(line)] & occupied[succ(line) .. ];
buffer := getPixmap(FIELD_X_START, FIELD_Y_START,
10 * BLOCK_SIZE, pred(line) * BLOCK_SIZE);
put(FIELD_X_START, FIELD_Y_START + BLOCK_SIZE, buffer);
end if;
end for;
end func;
const proc: main is func
local
var char: ch is ' ';
begin
screen(WINDOW_WIDTH, WINDOW_HEIGHT);
selectInput(curr_win, KEY_CLOSE, TRUE);
clear(curr_win, white);
color(white, black);
KEYBOARD := GRAPH_KEYBOARD;
info_sheet := openPixmapFontFile(curr_win, 336, 7);
setFont(info_sheet, stdFont9);
color(info_sheet, black, white);
repeat
quit_round := FALSE;
score := 0;
level := 1;
counter_start := 6 - level;
color(info_sheet, black, white);
clear(info_sheet);
writeln(info_sheet, "T E T R I S");
writeln(info_sheet);
writeln(info_sheet, "Copyright (C) 1993, 1994, 2004 Thomas Mertes");
writeln(info_sheet);
writeln(info_sheet, "This program is free software under the");
writeln(info_sheet, "terms of the GNU General Public License.");
writeln(info_sheet);
writeln(info_sheet, "Tetris is written in the Seed7");
writeln(info_sheet, "programming language");
writeln(info_sheet);
writeln(info_sheet, "Homepage: http://seed7.sourceforge.net");
setPos(info_sheet, 14, 1);
write(info_sheet, " Score: " <& score <& " ");
setPos(info_sheet, 16, 1);
write(info_sheet, " Level: " <& level <& " ");
flush(info_sheet);
occupied := FIELD_HEIGHT times
(3 times TRUE & FIELD_WIDTH times FALSE & 3 times TRUE) &
3 times FIELD_WIDTH + 6 times TRUE;
flushGraphic;
rect(FIELD_X_START, FIELD_Y_START,
10 * BLOCK_SIZE, 20 * BLOCK_SIZE, black);
flushGraphic;
repeat
set_piece(tetromino_list[rand(1, length(tetromino_list))]);
remove_full_lines;
until quit_round;
setPos(info_sheet, 20, 2);
write(info_sheet, "Another round? ");
repeat
ch := upper(getc(KEYBOARD));
until ch = 'Y' or ch = 'N' or ch = KEY_CLOSE;
setPos(info_sheet, 20, 2);
write(info_sheet, " ");
until ch = 'N' or ch = KEY_CLOSE;
end func;