1 2(********************************************************************) 3(* *) 4(* tetg.sd7 Tetris game with graphical output *) 5(* Copyright (C) 1993, 1994, 2004 Thomas Mertes *) 6(* *) 7(* This program is free software; you can redistribute it and/or *) 8(* modify it under the terms of the GNU General Public License as *) 9(* published by the Free Software Foundation; either version 2 of *) 10(* the License, or (at your option) any later version. *) 11(* *) 12(* This program is distributed in the hope that it will be useful, *) 13(* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 14(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 15(* GNU General Public License for more details. *) 16(* *) 17(* You should have received a copy of the GNU General Public *) 18(* License along with this program; if not, write to the *) 19(* Free Software Foundation, Inc., 51 Franklin Street, *) 20(* Fifth Floor, Boston, MA 02110-1301, USA. *) 21(* *) 22(********************************************************************) 23 24 25$ include "seed7_05.s7i"; 26 include "time.s7i"; 27 include "duration.s7i"; 28 include "float.s7i"; 29 include "draw.s7i"; 30 include "stdfont9.s7i"; 31 include "pixmap_file.s7i"; 32 include "keybd.s7i"; 33 34const integer: FIELD_HEIGHT is 20; 35const integer: FIELD_WIDTH is 10; 36const integer: FIELD_X_START is 8; 37const integer: FIELD_Y_START is 8; 38const integer: BLOCK_SIZE is 32; 39const integer: WINDOW_WIDTH is 660; 40const integer: WINDOW_HEIGHT is FIELD_HEIGHT * BLOCK_SIZE + 2 * FIELD_Y_START; 41const integer: AREA_WIDTH is FIELD_WIDTH * BLOCK_SIZE + 2 * FIELD_X_START; 42 43var text: info_sheet is STD_NULL; 44 45var boolean: quit_round is FALSE; 46var integer: score is 0; 47var integer: level is 1; 48var duration: delta is 50000 . MICRO_SECONDS; 49var integer: counter_start is 5; 50 51const type: bool_list is array boolean; 52var array bool_list: occupied is 0 times 0 times FALSE; 53 54const type: rot_position is new enum 55 ROT_1, ROT_2, ROT_3, ROT_4 56 end enum; 57 58const type: tetromino_type is new enum 59 SQUARE_BLOCK, I_BAR, S_ZIGZAG, Z_ZIGZAG, GAMMA_KNEE, L_KNEE, T_BRANCH 60 end enum; 61 62const func integer: score (ref tetromino_type: tetromino) is DYNAMIC; 63 64const integer: score (SQUARE_BLOCK) is 1; 65const integer: score (I_BAR) is 2; 66const integer: score (S_ZIGZAG) is 3; 67const integer: score (Z_ZIGZAG) is 4; 68const integer: score (GAMMA_KNEE) is 5; 69const integer: score (L_KNEE) is 6; 70const integer: score (T_BRANCH) is 7; 71 72const func color: color (ref tetromino_type: tetromino) is DYNAMIC; 73 74const color: color (SQUARE_BLOCK) is dark_blue; 75const color: color (I_BAR) is dark_red; 76const color: color (S_ZIGZAG) is light_green; 77const color: color (Z_ZIGZAG) is light_cyan; 78const color: color (GAMMA_KNEE) is light_gray; 79const color: color (L_KNEE) is dark_magenta; 80const color: color (T_BRANCH) is brown; 81 82var array tetromino_type: tetromino_list is [](SQUARE_BLOCK, I_BAR, S_ZIGZAG, Z_ZIGZAG, 83 GAMMA_KNEE, L_KNEE, T_BRANCH); 84 85const type: stri_list is array string; 86 87const func stri_list: PATTERN (ref tetromino_type: tetromino, ref rot_position: rot_pos) is DYNAMIC; 88 89const stri_list: PATTERN (SQUARE_BLOCK, ROT_1) is []( 90 "## ", 91 "## ", 92 " ", 93 " "); 94const stri_list: PATTERN (SQUARE_BLOCK, ROT_2) is PATTERN(SQUARE_BLOCK, ROT_1); 95const stri_list: PATTERN (SQUARE_BLOCK, ROT_3) is PATTERN(SQUARE_BLOCK, ROT_1); 96const stri_list: PATTERN (SQUARE_BLOCK, ROT_4) is PATTERN(SQUARE_BLOCK, ROT_1); 97 98const stri_list: PATTERN (I_BAR, ROT_1) is []( 99 " # ", 100 " # ", 101 " # ", 102 " # "); 103const stri_list: PATTERN (I_BAR, ROT_2) is []( 104 " ", 105 "####", 106 " ", 107 " "); 108const stri_list: PATTERN (I_BAR, ROT_3) is PATTERN(I_BAR, ROT_1); 109const stri_list: PATTERN (I_BAR, ROT_4) is PATTERN(I_BAR, ROT_2); 110 111const stri_list: PATTERN (S_ZIGZAG, ROT_1) is []( 112 " ## ", 113 "## ", 114 " ", 115 " "); 116const stri_list: PATTERN (S_ZIGZAG, ROT_2) is []( 117 "# ", 118 "## ", 119 " # ", 120 " "); 121const stri_list: PATTERN (S_ZIGZAG, ROT_3) is PATTERN(S_ZIGZAG, ROT_1); 122const stri_list: PATTERN (S_ZIGZAG, ROT_4) is PATTERN(S_ZIGZAG, ROT_2); 123 124const stri_list: PATTERN (Z_ZIGZAG, ROT_1) is []( 125 "## ", 126 " ## ", 127 " ", 128 " "); 129const stri_list: PATTERN (Z_ZIGZAG, ROT_2) is []( 130 " # ", 131 "## ", 132 "# ", 133 " "); 134const stri_list: PATTERN (Z_ZIGZAG, ROT_3) is PATTERN(Z_ZIGZAG, ROT_1); 135const stri_list: PATTERN (Z_ZIGZAG, ROT_4) is PATTERN(Z_ZIGZAG, ROT_2); 136 137const stri_list: PATTERN (GAMMA_KNEE, ROT_1) is []( 138 " # ", 139 " # ", 140 " ## ", 141 " "); 142const stri_list: PATTERN (GAMMA_KNEE, ROT_2) is []( 143 " ", 144 "### ", 145 " # ", 146 " "); 147const stri_list: PATTERN (GAMMA_KNEE, ROT_3) is []( 148 " ", 149 " ## ", 150 " # ", 151 " # "); 152const stri_list: PATTERN (GAMMA_KNEE, ROT_4) is []( 153 " ", 154 " # ", 155 " ###", 156 " "); 157 158const stri_list: PATTERN (L_KNEE, ROT_1) is []( 159 " # ", 160 " # ", 161 " ## ", 162 " "); 163const stri_list: PATTERN (L_KNEE, ROT_2) is []( 164 " ", 165 " # ", 166 "### ", 167 " "); 168const stri_list: PATTERN (L_KNEE, ROT_3) is []( 169 " ", 170 " ## ", 171 " # ", 172 " # "); 173const stri_list: PATTERN (L_KNEE, ROT_4) is []( 174 " ", 175 " ###", 176 " # ", 177 " "); 178 179const stri_list: PATTERN (T_BRANCH, ROT_1) is []( 180 " # ", 181 "### ", 182 " ", 183 " "); 184const stri_list: PATTERN (T_BRANCH, ROT_2) is []( 185 " # ", 186 "## ", 187 " # ", 188 " "); 189const stri_list: PATTERN (T_BRANCH, ROT_3) is []( 190 " ", 191 "### ", 192 " # ", 193 " "); 194const stri_list: PATTERN (T_BRANCH, ROT_4) is []( 195 " # ", 196 " ## ", 197 " # ", 198 " "); 199 200const type: piece is new struct 201 var tetromino_type: tetromino is SQUARE_BLOCK; 202 var integer: line_pos is 0; 203 var integer: column_pos is 0; 204 var rot_position: rot_pos is ROT_1; 205 var boolean: moving is TRUE; 206 end struct; 207 208 209const proc: next (inout rot_position: rot_pos) is func 210 begin 211 if rot_pos = ROT_4 then 212 rot_pos := ROT_1 213 else 214 rot_pos := succ(rot_pos); 215 end if; 216 end func; 217 218 219const proc: prev (inout rot_position: rot_pos) is func 220 begin 221 if rot_pos = ROT_1 then 222 rot_pos := ROT_4 223 else 224 rot_pos := pred(rot_pos); 225 end if; 226 end func; 227 228 229const proc: show (in piece: actual_piece) is func 230 local 231 var integer: line is 0; 232 var integer: column is 0; 233 begin 234 for line range 1 to 4 do 235 for column range 1 to 4 do 236 if PATTERN(actual_piece.tetromino, actual_piece.rot_pos)[line][column] <> ' ' then 237 rect(FIELD_X_START + ((actual_piece.column_pos + column - 2) * BLOCK_SIZE), 238 FIELD_Y_START + ((actual_piece.line_pos + line - 2) * BLOCK_SIZE), 239 BLOCK_SIZE, BLOCK_SIZE, color(actual_piece.tetromino)); 240 end if; 241 end for; 242 end for; 243 end func; 244 245 246const proc: hide (in piece: actual_piece) is func 247 local 248 var integer: line is 0; 249 var integer: column is 0; 250 begin 251 for line range 1 to 4 do 252 for column range 1 to 4 do 253 if PATTERN(actual_piece.tetromino, actual_piece.rot_pos)[line][column] <> ' ' then 254 rect(FIELD_X_START + ((actual_piece.column_pos + column - 2) * BLOCK_SIZE), 255 FIELD_Y_START + ((actual_piece.line_pos + line - 2) * BLOCK_SIZE), 256 BLOCK_SIZE, BLOCK_SIZE, black); 257 end if; 258 end for; 259 end for; 260 end func; 261 262 263const func boolean: is_occupied (in piece: actual_piece) is func 264 result 265 var boolean: is_occupied is FALSE; 266 local 267 var integer: line is 0; 268 var integer: column is 0; 269 begin 270 for line range 1 to 4 do 271 for column range 1 to 4 do 272 if PATTERN(actual_piece.tetromino, actual_piece.rot_pos)[line][column] <> ' ' and 273 occupied[pred(actual_piece.line_pos + line)] 274 [actual_piece.column_pos + column + 2] then 275 is_occupied := TRUE; 276 end if; 277 end for; 278 end for; 279 end func; 280 281 282const proc: do_occupie (in piece: actual_piece) is func 283 local 284 var integer: line is 0; 285 var integer: column is 0; 286 begin 287 for line range 1 to 4 do 288 for column range 1 to 4 do 289 if PATTERN(actual_piece.tetromino, actual_piece.rot_pos)[line][column] <> ' ' then 290 occupied[pred(actual_piece.line_pos + line)] 291 [actual_piece.column_pos + column + 2] := TRUE; 292 end if; 293 end for; 294 end for; 295 end func; 296 297 298const proc: left (inout piece: actual_piece) is func 299 begin 300 hide(actual_piece); 301 decr(actual_piece.column_pos); 302 if is_occupied(actual_piece) then 303 incr(actual_piece.column_pos); 304 end if; 305 show(actual_piece); 306 end func; 307 308 309const proc: right (inout piece: actual_piece) is func 310 begin 311 hide(actual_piece); 312 incr(actual_piece.column_pos); 313 if is_occupied(actual_piece) then 314 decr(actual_piece.column_pos); 315 end if; 316 show(actual_piece); 317 end func; 318 319 320const proc: rotate (inout piece: actual_piece) is func 321 begin 322 hide(actual_piece); 323 next(actual_piece.rot_pos); 324 if is_occupied(actual_piece) then 325 prev(actual_piece.rot_pos); 326 end if; 327 show(actual_piece); 328 end func; 329 330 331const proc: down (inout piece: actual_piece) is func 332 begin 333 hide(actual_piece); 334 incr(actual_piece.line_pos); 335 if is_occupied(actual_piece) then 336 decr(actual_piece.line_pos); 337 do_occupie(actual_piece); 338 actual_piece.moving := FALSE; 339 end if; 340 show(actual_piece); 341 end func; 342 343 344const proc: position (inout piece: actual_piece, in integer: line, in integer: column) is func 345 begin 346 actual_piece.line_pos := line; 347 actual_piece.column_pos := column; 348 actual_piece.rot_pos := ROT_1; 349 actual_piece.moving := TRUE; 350 show(actual_piece); 351 end func; 352 353 354const proc: drop (inout piece: actual_piece) is func 355 begin 356 hide(actual_piece); 357 score +:= (FIELD_HEIGHT - actual_piece.line_pos) div 4; 358 repeat 359 incr(actual_piece.line_pos); 360 until is_occupied(actual_piece); 361 decr(actual_piece.line_pos); 362 do_occupie(actual_piece); 363 actual_piece.moving := FALSE; 364 show(actual_piece); 365 end func; 366 367 368const proc: set_piece (in tetromino_type: tetromino) is func 369 local 370 var piece: actual_piece is piece.value; 371 var time: start_time is time.value; 372 var integer: counter is 0; 373 var char: command is ' '; 374 begin 375 actual_piece.tetromino := tetromino; 376 position(actual_piece, 1, 5); 377 flushGraphic; 378 if not is_occupied(actual_piece) then 379 counter := counter_start; 380 command := busy_getc(KEYBOARD); 381 while actual_piece.moving do 382 start_time := time(NOW); 383 if command = KEY_LEFT then 384 left(actual_piece); 385 elsif command = KEY_RIGHT then 386 right(actual_piece); 387 elsif command = KEY_UP then 388 rotate(actual_piece); 389 elsif command = KEY_DOWN or command = KEY_PAD_CENTER then 390 drop(actual_piece); 391 elsif command = 'q' or command = 'Q' or command = KEY_CLOSE then 392 actual_piece.moving := FALSE; 393 quit_round := TRUE; 394 end if; 395 if counter = 0 then 396 down(actual_piece); 397 counter := counter_start; 398 end if; 399 flushGraphic; 400 decr(counter); 401 await(start_time + delta); 402 command := busy_getc(KEYBOARD); 403 end while; 404 score +:= level + score(actual_piece.tetromino); 405 if score > 1000 * level then 406 incr(level); 407 setPos(info_sheet, 16, 1); 408 write(info_sheet, " Level: " <& level <& " "); 409 decr(counter_start); 410 end if; 411 setPos(info_sheet, 14, 1); 412 write(info_sheet, " Score: " <& score <& " "); 413 flush(info_sheet); 414 else 415 quit_round := TRUE; 416 end if; 417 end func; 418 419 420const proc: remove_full_lines is func 421 local 422 var integer: line is 0; 423 var integer: column is 0; 424 var boolean: full is TRUE; 425 var PRIMITIVE_WINDOW: buffer is PRIMITIVE_WINDOW.value; 426 begin 427 for line range 1 to FIELD_HEIGHT do 428 full := TRUE; 429 for column range 4 to pred(FIELD_WIDTH + 4) do 430 if not occupied[line][column] then 431 full := FALSE; 432 end if; 433 end for; 434 if full then 435 occupied := 1 times 436 (3 times TRUE & FIELD_WIDTH times FALSE & 3 times TRUE) & 437 occupied[ .. pred(line)] & occupied[succ(line) .. ]; 438 buffer := getPixmap(FIELD_X_START, FIELD_Y_START, 439 10 * BLOCK_SIZE, pred(line) * BLOCK_SIZE); 440 put(FIELD_X_START, FIELD_Y_START + BLOCK_SIZE, buffer); 441 end if; 442 end for; 443 end func; 444 445 446const proc: main is func 447 local 448 var char: ch is ' '; 449 begin 450 screen(WINDOW_WIDTH, WINDOW_HEIGHT); 451 selectInput(curr_win, KEY_CLOSE, TRUE); 452 clear(curr_win, white); 453 color(white, black); 454 KEYBOARD := GRAPH_KEYBOARD; 455 info_sheet := openPixmapFontFile(curr_win, 336, 7); 456 setFont(info_sheet, stdFont9); 457 color(info_sheet, black, white); 458 repeat 459 quit_round := FALSE; 460 score := 0; 461 level := 1; 462 counter_start := 6 - level; 463 color(info_sheet, black, white); 464 clear(info_sheet); 465 writeln(info_sheet, "T E T R I S"); 466 writeln(info_sheet); 467 writeln(info_sheet, "Copyright (C) 1993, 1994, 2004 Thomas Mertes"); 468 writeln(info_sheet); 469 writeln(info_sheet, "This program is free software under the"); 470 writeln(info_sheet, "terms of the GNU General Public License."); 471 writeln(info_sheet); 472 writeln(info_sheet, "Tetris is written in the Seed7"); 473 writeln(info_sheet, "programming language"); 474 writeln(info_sheet); 475 writeln(info_sheet, "Homepage: http://seed7.sourceforge.net"); 476 setPos(info_sheet, 14, 1); 477 write(info_sheet, " Score: " <& score <& " "); 478 setPos(info_sheet, 16, 1); 479 write(info_sheet, " Level: " <& level <& " "); 480 flush(info_sheet); 481 occupied := FIELD_HEIGHT times 482 (3 times TRUE & FIELD_WIDTH times FALSE & 3 times TRUE) & 483 3 times FIELD_WIDTH + 6 times TRUE; 484 flushGraphic; 485 rect(FIELD_X_START, FIELD_Y_START, 486 10 * BLOCK_SIZE, 20 * BLOCK_SIZE, black); 487 flushGraphic; 488 repeat 489 set_piece(tetromino_list[rand(1, length(tetromino_list))]); 490 remove_full_lines; 491 until quit_round; 492 setPos(info_sheet, 20, 2); 493 write(info_sheet, "Another round? "); 494 repeat 495 ch := upper(getc(KEYBOARD)); 496 until ch = 'Y' or ch = 'N' or ch = KEY_CLOSE; 497 setPos(info_sheet, 20, 2); 498 write(info_sheet, " "); 499 until ch = 'N' or ch = KEY_CLOSE; 500 end func; 501