
(********************************************************************)
(*                                                                  *)
(*  tetg.sd7      Tetris game with graphical output                 *)
(*  Copyright (C) 1993, 1994, 2004  Thomas Mertes                   *)
(*                                                                  *)
(*  This program is free software; you can redistribute it and/or   *)
(*  modify it under the terms of the GNU General Public License as  *)
(*  published by the Free Software Foundation; either version 2 of  *)
(*  the License, or (at your option) any later version.             *)
(*                                                                  *)
(*  This program is distributed in the hope that it will be useful, *)
(*  but WITHOUT ANY WARRANTY; without even the implied warranty of  *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the   *)
(*  GNU General Public License for more details.                    *)
(*                                                                  *)
(*  You should have received a copy of the GNU General Public       *)
(*  License along with this program; if not, write to the           *)
(*  Free Software Foundation, Inc., 51 Franklin Street,             *)
(*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
(*                                                                  *)
(********************************************************************)


$ 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);
    DRAW_FLUSH;
    if not is_occupied(actual_piece) then
      counter := counter_start;
      command := busy_getc(KEYBOARD);
      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;
        DRAW_FLUSH;
        decr(counter);
        await(start_time + delta);
        command := busy_getc(KEYBOARD);
      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, PSET);
      end if;
    end for;
  end func;


const proc: main is func
  local
    var char: ch is ' ';
  begin
    screen(WINDOW_WIDTH, WINDOW_HEIGHT);
    setCloseAction(curr_win, RETURN_KEY);
    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;
      DRAW_FLUSH;
      rect(FIELD_X_START, FIELD_Y_START,
          10 * BLOCK_SIZE, 20 * BLOCK_SIZE, black);
      DRAW_FLUSH;
      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;
