| 1 | ;;; tetris.el --- implementation of Tetris for Emacs |
| 2 | |
| 3 | ;; Copyright (C) 1997 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: Glynn Clements <glynn@sensei.co.uk> |
| 6 | ;; Version: 2.01 |
| 7 | ;; Created: 1997-08-13 |
| 8 | ;; Keywords: games |
| 9 | |
| 10 | ;; This file is part of GNU Emacs. |
| 11 | |
| 12 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 13 | ;; it under the terms of the GNU General Public License as published by |
| 14 | ;; the Free Software Foundation; either version 2, or (at your option) |
| 15 | ;; any later version. |
| 16 | |
| 17 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 20 | ;; GNU General Public License for more details. |
| 21 | |
| 22 | ;; You should have received a copy of the GNU General Public License |
| 23 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
| 24 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
| 25 | ;; Boston, MA 02111-1307, USA. |
| 26 | |
| 27 | ;;; Commentary: |
| 28 | |
| 29 | ;;; Code: |
| 30 | |
| 31 | (eval-when-compile |
| 32 | (require 'cl)) |
| 33 | |
| 34 | (require 'gamegrid) |
| 35 | |
| 36 | ;; ;;;;;;;;;;;;; customization variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 37 | |
| 38 | (defgroup tetris nil |
| 39 | "Play a game of tetris." |
| 40 | :prefix "tetris-" |
| 41 | :group 'games) |
| 42 | |
| 43 | (defcustom tetris-use-glyphs t |
| 44 | "*Non-nil means use glyphs when available." |
| 45 | :group 'tetris |
| 46 | :type 'boolean) |
| 47 | |
| 48 | (defcustom tetris-use-color t |
| 49 | "*Non-nil means use color when available." |
| 50 | :group 'tetris |
| 51 | :type 'boolean) |
| 52 | |
| 53 | (defcustom tetris-draw-border-with-glyphs t |
| 54 | "*Non-nil means draw a border even when using glyphs." |
| 55 | :group 'tetris |
| 56 | :type 'boolean) |
| 57 | |
| 58 | (defcustom tetris-default-tick-period 0.3 |
| 59 | "*The default time taken for a shape to drop one row." |
| 60 | :group 'tetris |
| 61 | :type 'number) |
| 62 | |
| 63 | (defcustom tetris-update-speed-function |
| 64 | 'tetris-default-update-speed-function |
| 65 | "Function run whenever the Tetris score changes |
| 66 | Called with two arguments: (SHAPES ROWS) |
| 67 | SHAPES is the number of shapes which have been dropped |
| 68 | ROWS is the number of rows which have been completed |
| 69 | |
| 70 | If the return value is a number, it is used as the timer period." |
| 71 | :group 'tetris |
| 72 | :type 'function) |
| 73 | |
| 74 | (defcustom tetris-mode-hook nil |
| 75 | "Hook run upon starting Tetris." |
| 76 | :group 'tetris |
| 77 | :type 'hook) |
| 78 | |
| 79 | (defcustom tetris-tty-colors |
| 80 | [nil "blue" "white" "yellow" "magenta" "cyan" "green" "red"] |
| 81 | "Vector of colors of the various shapes in text mode |
| 82 | Element 0 is ignored." |
| 83 | :group 'tetris |
| 84 | :type (let ((names `("Shape 1" "Shape 2" "Shape 3" |
| 85 | "Shape 4" "Shape 5" "Shape 6" "Shape 7")) |
| 86 | (result `(vector (const nil)))) |
| 87 | (while names |
| 88 | (add-to-list 'result |
| 89 | (cons 'choice |
| 90 | (cons :tag |
| 91 | (cons (car names) |
| 92 | (mapcar (lambda (color) |
| 93 | (list 'const color)) |
| 94 | (defined-colors))))) |
| 95 | t) |
| 96 | (setq names (cdr names))) |
| 97 | result)) |
| 98 | |
| 99 | (defcustom tetris-x-colors |
| 100 | [nil [0 0 1] [0.7 0 1] [1 1 0] [1 0 1] [0 1 1] [0 1 0] [1 0 0]] |
| 101 | "Vector of colors of the various shapes |
| 102 | Element 0 is ignored." |
| 103 | :group 'tetris |
| 104 | :type 'sexp) |
| 105 | |
| 106 | (defcustom tetris-buffer-name "*Tetris*" |
| 107 | "Name used for Tetris buffer." |
| 108 | :group 'tetris |
| 109 | :type 'string) |
| 110 | |
| 111 | (defcustom tetris-buffer-width 30 |
| 112 | "Width of used portion of buffer." |
| 113 | :group 'tetris |
| 114 | :type 'number) |
| 115 | |
| 116 | (defcustom tetris-buffer-height 22 |
| 117 | "Height of used portion of buffer." |
| 118 | :group 'tetris |
| 119 | :type 'number) |
| 120 | |
| 121 | (defcustom tetris-width 10 |
| 122 | "Width of playing area." |
| 123 | :group 'tetris |
| 124 | :type 'number) |
| 125 | |
| 126 | (defcustom tetris-height 20 |
| 127 | "Height of playing area." |
| 128 | :group 'tetris |
| 129 | :type 'number) |
| 130 | |
| 131 | (defcustom tetris-top-left-x 3 |
| 132 | "X position of top left of playing area." |
| 133 | :group 'tetris |
| 134 | :type 'number) |
| 135 | |
| 136 | (defcustom tetris-top-left-y 1 |
| 137 | "Y position of top left of playing area." |
| 138 | :group 'tetris |
| 139 | :type 'number) |
| 140 | |
| 141 | (defvar tetris-next-x (+ (* 2 tetris-top-left-x) tetris-width) |
| 142 | "X position of next shape.") |
| 143 | |
| 144 | (defvar tetris-next-y tetris-top-left-y |
| 145 | "Y position of next shape.") |
| 146 | |
| 147 | (defvar tetris-score-x tetris-next-x |
| 148 | "X position of score.") |
| 149 | |
| 150 | (defvar tetris-score-y (+ tetris-next-y 6) |
| 151 | "Y position of score.") |
| 152 | |
| 153 | ;; It is not safe to put this in /tmp. |
| 154 | ;; Someone could make a symlink in /tmp |
| 155 | ;; pointing to a file you don't want to clobber. |
| 156 | (defvar tetris-score-file "tetris-scores" |
| 157 | ;; anybody with a well-connected server want to host this? |
| 158 | ;(defvar tetris-score-file "/anonymous@ftp.pgt.com:/pub/cgw/tetris-scores" |
| 159 | "File for holding high scores.") |
| 160 | |
| 161 | ;; ;;;;;;;;;;;;; display options ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 162 | |
| 163 | (defvar tetris-blank-options |
| 164 | '(((glyph colorize) |
| 165 | (t ?\040)) |
| 166 | ((color-x color-x) |
| 167 | (mono-x grid-x) |
| 168 | (color-tty color-tty)) |
| 169 | (((glyph color-x) [0 0 0]) |
| 170 | (color-tty "black")))) |
| 171 | |
| 172 | (defvar tetris-cell-options |
| 173 | '(((glyph colorize) |
| 174 | (emacs-tty ?O) |
| 175 | (t ?\040)) |
| 176 | ((color-x color-x) |
| 177 | (mono-x mono-x) |
| 178 | (color-tty color-tty) |
| 179 | (mono-tty mono-tty)) |
| 180 | ;; color information is taken from tetris-x-colors and tetris-tty-colors |
| 181 | )) |
| 182 | |
| 183 | (defvar tetris-border-options |
| 184 | '(((glyph colorize) |
| 185 | (t ?\+)) |
| 186 | ((color-x color-x) |
| 187 | (mono-x grid-x) |
| 188 | (color-tty color-tty)) |
| 189 | (((glyph color-x) [0.5 0.5 0.5]) |
| 190 | (color-tty "white")))) |
| 191 | |
| 192 | (defvar tetris-space-options |
| 193 | '(((t ?\040)) |
| 194 | nil |
| 195 | nil)) |
| 196 | |
| 197 | ;; ;;;;;;;;;;;;; constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 198 | |
| 199 | (defconst tetris-shapes |
| 200 | [[[[1 1 0 0] [1 1 0 0] [1 1 0 0] [1 1 0 0]] |
| 201 | [[1 1 0 0] [1 1 0 0] [1 1 0 0] [1 1 0 0]] |
| 202 | [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]] |
| 203 | [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]] |
| 204 | |
| 205 | [[[2 2 2 0] [0 2 0 0] [2 0 0 0] [2 2 0 0]] |
| 206 | [[0 0 2 0] [0 2 0 0] [2 2 2 0] [2 0 0 0]] |
| 207 | [[0 0 0 0] [2 2 0 0] [0 0 0 0] [2 0 0 0]] |
| 208 | [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]] |
| 209 | |
| 210 | [[[3 3 3 0] [3 3 0 0] [0 0 3 0] [3 0 0 0]] |
| 211 | [[3 0 0 0] [0 3 0 0] [3 3 3 0] [3 0 0 0]] |
| 212 | [[0 0 0 0] [0 3 0 0] [0 0 0 0] [3 3 0 0]] |
| 213 | [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]] |
| 214 | |
| 215 | [[[4 4 0 0] [0 4 0 0] [4 4 0 0] [0 4 0 0]] |
| 216 | [[0 4 4 0] [4 4 0 0] [0 4 4 0] [4 4 0 0]] |
| 217 | [[0 0 0 0] [4 0 0 0] [0 0 0 0] [4 0 0 0]] |
| 218 | [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]] |
| 219 | |
| 220 | [[[0 5 5 0] [5 0 0 0] [0 5 5 0] [5 0 0 0]] |
| 221 | [[5 5 0 0] [5 5 0 0] [5 5 0 0] [5 5 0 0]] |
| 222 | [[0 0 0 0] [0 5 0 0] [0 0 0 0] [0 5 0 0]] |
| 223 | [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]] |
| 224 | |
| 225 | [[[0 6 0 0] [6 0 0 0] [6 6 6 0] [0 6 0 0]] |
| 226 | [[6 6 6 0] [6 6 0 0] [0 6 0 0] [6 6 0 0]] |
| 227 | [[0 0 0 0] [6 0 0 0] [0 0 0 0] [0 6 0 0]] |
| 228 | [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]] |
| 229 | |
| 230 | [[[7 7 7 7] [7 0 0 0] [7 7 7 7] [7 0 0 0]] |
| 231 | [[0 0 0 0] [7 0 0 0] [0 0 0 0] [7 0 0 0]] |
| 232 | [[0 0 0 0] [7 0 0 0] [0 0 0 0] [7 0 0 0]] |
| 233 | [[0 0 0 0] [7 0 0 0] [0 0 0 0] [7 0 0 0]]]]) |
| 234 | |
| 235 | ;;the scoring rules were taken from "xtetris". Blocks score differently |
| 236 | ;;depending on their rotation |
| 237 | |
| 238 | (defconst tetris-shape-scores |
| 239 | [ [6 6 6 6] [6 7 6 7] [6 7 6 7] [6 7 6 7] [6 7 6 7] [5 5 6 5] [5 8 5 8]] ) |
| 240 | |
| 241 | (defconst tetris-shape-dimensions |
| 242 | [[2 2] [3 2] [3 2] [3 2] [3 2] [3 2] [4 1]]) |
| 243 | |
| 244 | (defconst tetris-blank 0) |
| 245 | |
| 246 | (defconst tetris-border 8) |
| 247 | |
| 248 | (defconst tetris-space 9) |
| 249 | |
| 250 | (defun tetris-default-update-speed-function (shapes rows) |
| 251 | (/ 20.0 (+ 50.0 rows))) |
| 252 | |
| 253 | ;; ;;;;;;;;;;;;; variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 254 | |
| 255 | (defvar tetris-shape 0) |
| 256 | (defvar tetris-rot 0) |
| 257 | (defvar tetris-next-shape 0) |
| 258 | (defvar tetris-n-shapes 0) |
| 259 | (defvar tetris-n-rows 0) |
| 260 | (defvar tetris-score 0) |
| 261 | (defvar tetris-pos-x 0) |
| 262 | (defvar tetris-pos-y 0) |
| 263 | (defvar tetris-paused nil) |
| 264 | |
| 265 | (make-variable-buffer-local 'tetris-shape) |
| 266 | (make-variable-buffer-local 'tetris-rot) |
| 267 | (make-variable-buffer-local 'tetris-next-shape) |
| 268 | (make-variable-buffer-local 'tetris-n-shapes) |
| 269 | (make-variable-buffer-local 'tetris-n-rows) |
| 270 | (make-variable-buffer-local 'tetris-score) |
| 271 | (make-variable-buffer-local 'tetris-pos-x) |
| 272 | (make-variable-buffer-local 'tetris-pos-y) |
| 273 | (make-variable-buffer-local 'tetris-paused) |
| 274 | |
| 275 | ;; ;;;;;;;;;;;;; keymaps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 276 | |
| 277 | (defvar tetris-mode-map |
| 278 | (make-sparse-keymap 'tetris-mode-map)) |
| 279 | |
| 280 | (define-key tetris-mode-map "n" 'tetris-start-game) |
| 281 | (define-key tetris-mode-map "q" 'tetris-end-game) |
| 282 | (define-key tetris-mode-map "p" 'tetris-pause-game) |
| 283 | |
| 284 | (define-key tetris-mode-map " " 'tetris-move-bottom) |
| 285 | (define-key tetris-mode-map [left] 'tetris-move-left) |
| 286 | (define-key tetris-mode-map [right] 'tetris-move-right) |
| 287 | (define-key tetris-mode-map [up] 'tetris-rotate-prev) |
| 288 | (define-key tetris-mode-map [down] 'tetris-rotate-next) |
| 289 | |
| 290 | (defvar tetris-null-map |
| 291 | (make-sparse-keymap 'tetris-null-map)) |
| 292 | |
| 293 | (define-key tetris-null-map "n" 'tetris-start-game) |
| 294 | |
| 295 | ;; ;;;;;;;;;;;;;;;; game functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 296 | |
| 297 | (defun tetris-display-options () |
| 298 | (let ((options (make-vector 256 nil))) |
| 299 | (loop for c from 0 to 255 do |
| 300 | (aset options c |
| 301 | (cond ((= c tetris-blank) |
| 302 | tetris-blank-options) |
| 303 | ((and (>= c 1) (<= c 7)) |
| 304 | (append |
| 305 | tetris-cell-options |
| 306 | `((((glyph color-x) ,(aref tetris-x-colors c)) |
| 307 | (color-tty ,(aref tetris-tty-colors c)) |
| 308 | (t nil))))) |
| 309 | ((= c tetris-border) |
| 310 | tetris-border-options) |
| 311 | ((= c tetris-space) |
| 312 | tetris-space-options) |
| 313 | (t |
| 314 | '(nil nil nil))))) |
| 315 | options)) |
| 316 | |
| 317 | (defun tetris-get-tick-period () |
| 318 | (if (boundp 'tetris-update-speed-function) |
| 319 | (let ((period (apply tetris-update-speed-function |
| 320 | tetris-n-shapes |
| 321 | tetris-n-rows nil))) |
| 322 | (and (numberp period) period)))) |
| 323 | |
| 324 | (defun tetris-get-shape-cell (x y) |
| 325 | (aref (aref (aref (aref tetris-shapes |
| 326 | tetris-shape) |
| 327 | y) |
| 328 | tetris-rot) |
| 329 | x)) |
| 330 | |
| 331 | (defun tetris-shape-width () |
| 332 | (aref (aref tetris-shape-dimensions tetris-shape) |
| 333 | (% tetris-rot 2))) |
| 334 | |
| 335 | (defun tetris-shape-height () |
| 336 | (aref (aref tetris-shape-dimensions tetris-shape) |
| 337 | (- 1 (% tetris-rot 2)))) |
| 338 | |
| 339 | (defun tetris-draw-score () |
| 340 | (let ((strings (vector (format "Shapes: %05d" tetris-n-shapes) |
| 341 | (format "Rows: %05d" tetris-n-rows) |
| 342 | (format "Score: %05d" tetris-score)))) |
| 343 | (loop for y from 0 to 2 do |
| 344 | (let* ((string (aref strings y)) |
| 345 | (len (length string))) |
| 346 | (loop for x from 0 to (1- len) do |
| 347 | (gamegrid-set-cell (+ tetris-score-x x) |
| 348 | (+ tetris-score-y y) |
| 349 | (aref string x))))))) |
| 350 | |
| 351 | (defun tetris-update-score () |
| 352 | (tetris-draw-score) |
| 353 | (let ((period (tetris-get-tick-period))) |
| 354 | (if period (gamegrid-set-timer period)))) |
| 355 | |
| 356 | (defun tetris-new-shape () |
| 357 | (setq tetris-shape tetris-next-shape) |
| 358 | (setq tetris-rot 0) |
| 359 | (setq tetris-next-shape (random 7)) |
| 360 | (setq tetris-pos-x (/ (- tetris-width (tetris-shape-width)) 2)) |
| 361 | (setq tetris-pos-y 0) |
| 362 | (if (tetris-test-shape) |
| 363 | (tetris-end-game) |
| 364 | (tetris-draw-shape)) |
| 365 | (tetris-draw-next-shape) |
| 366 | (tetris-update-score)) |
| 367 | |
| 368 | (defun tetris-draw-next-shape () |
| 369 | (loop for y from 0 to 3 do |
| 370 | (loop for x from 0 to 3 do |
| 371 | (gamegrid-set-cell (+ tetris-next-x x) |
| 372 | (+ tetris-next-y y) |
| 373 | (let ((tetris-shape tetris-next-shape) |
| 374 | (tetris-rot 0)) |
| 375 | (tetris-get-shape-cell x y)))))) |
| 376 | |
| 377 | (defun tetris-draw-shape () |
| 378 | (loop for y from 0 to (1- (tetris-shape-height)) do |
| 379 | (loop for x from 0 to (1- (tetris-shape-width)) do |
| 380 | (let ((c (tetris-get-shape-cell x y))) |
| 381 | (if (/= c tetris-blank) |
| 382 | (gamegrid-set-cell (+ tetris-top-left-x |
| 383 | tetris-pos-x |
| 384 | x) |
| 385 | (+ tetris-top-left-y |
| 386 | tetris-pos-y |
| 387 | y) |
| 388 | c)))))) |
| 389 | |
| 390 | (defun tetris-erase-shape () |
| 391 | (loop for y from 0 to (1- (tetris-shape-height)) do |
| 392 | (loop for x from 0 to (1- (tetris-shape-width)) do |
| 393 | (let ((c (tetris-get-shape-cell x y)) |
| 394 | (px (+ tetris-top-left-x tetris-pos-x x)) |
| 395 | (py (+ tetris-top-left-y tetris-pos-y y))) |
| 396 | (if (/= c tetris-blank) |
| 397 | (gamegrid-set-cell px py tetris-blank)))))) |
| 398 | |
| 399 | (defun tetris-test-shape () |
| 400 | (let ((hit nil)) |
| 401 | (loop for y from 0 to (1- (tetris-shape-height)) do |
| 402 | (loop for x from 0 to (1- (tetris-shape-width)) do |
| 403 | (unless hit |
| 404 | (setq hit |
| 405 | (let* ((c (tetris-get-shape-cell x y)) |
| 406 | (xx (+ tetris-pos-x x)) |
| 407 | (yy (+ tetris-pos-y y)) |
| 408 | (px (+ tetris-top-left-x xx)) |
| 409 | (py (+ tetris-top-left-y yy))) |
| 410 | (and (/= c tetris-blank) |
| 411 | (or (>= xx tetris-width) |
| 412 | (>= yy tetris-height) |
| 413 | (/= (gamegrid-get-cell px py) |
| 414 | tetris-blank)))))))) |
| 415 | hit)) |
| 416 | |
| 417 | (defun tetris-full-row (y) |
| 418 | (let ((full t)) |
| 419 | (loop for x from 0 to (1- tetris-width) do |
| 420 | (if (= (gamegrid-get-cell (+ tetris-top-left-x x) |
| 421 | (+ tetris-top-left-y y)) |
| 422 | tetris-blank) |
| 423 | (setq full nil))) |
| 424 | full)) |
| 425 | |
| 426 | (defun tetris-shift-row (y) |
| 427 | (if (= y 0) |
| 428 | (loop for x from 0 to (1- tetris-width) do |
| 429 | (gamegrid-set-cell (+ tetris-top-left-x x) |
| 430 | (+ tetris-top-left-y y) |
| 431 | tetris-blank)) |
| 432 | (loop for x from 0 to (1- tetris-width) do |
| 433 | (let ((c (gamegrid-get-cell (+ tetris-top-left-x x) |
| 434 | (+ tetris-top-left-y y -1)))) |
| 435 | (gamegrid-set-cell (+ tetris-top-left-x x) |
| 436 | (+ tetris-top-left-y y) |
| 437 | c))))) |
| 438 | |
| 439 | (defun tetris-shift-down () |
| 440 | (loop for y0 from 0 to (1- tetris-height) do |
| 441 | (if (tetris-full-row y0) |
| 442 | (progn (setq tetris-n-rows (1+ tetris-n-rows)) |
| 443 | (loop for y from y0 downto 0 do |
| 444 | (tetris-shift-row y)))))) |
| 445 | |
| 446 | (defun tetris-draw-border-p () |
| 447 | (or (not (eq gamegrid-display-mode 'glyph)) |
| 448 | tetris-draw-border-with-glyphs)) |
| 449 | |
| 450 | (defun tetris-init-buffer () |
| 451 | (gamegrid-init-buffer tetris-buffer-width |
| 452 | tetris-buffer-height |
| 453 | tetris-space) |
| 454 | (let ((buffer-read-only nil)) |
| 455 | (if (tetris-draw-border-p) |
| 456 | (loop for y from -1 to tetris-height do |
| 457 | (loop for x from -1 to tetris-width do |
| 458 | (gamegrid-set-cell (+ tetris-top-left-x x) |
| 459 | (+ tetris-top-left-y y) |
| 460 | tetris-border)))) |
| 461 | (loop for y from 0 to (1- tetris-height) do |
| 462 | (loop for x from 0 to (1- tetris-width) do |
| 463 | (gamegrid-set-cell (+ tetris-top-left-x x) |
| 464 | (+ tetris-top-left-y y) |
| 465 | tetris-blank))) |
| 466 | (if (tetris-draw-border-p) |
| 467 | (loop for y from -1 to 4 do |
| 468 | (loop for x from -1 to 4 do |
| 469 | (gamegrid-set-cell (+ tetris-next-x x) |
| 470 | (+ tetris-next-y y) |
| 471 | tetris-border)))))) |
| 472 | |
| 473 | (defun tetris-reset-game () |
| 474 | (gamegrid-kill-timer) |
| 475 | (tetris-init-buffer) |
| 476 | (setq tetris-next-shape (random 7)) |
| 477 | (setq tetris-shape 0 |
| 478 | tetris-rot 0 |
| 479 | tetris-pos-x 0 |
| 480 | tetris-pos-y 0 |
| 481 | tetris-n-shapes 0 |
| 482 | tetris-n-rows 0 |
| 483 | tetris-score 0 |
| 484 | tetris-paused nil) |
| 485 | (tetris-new-shape)) |
| 486 | |
| 487 | (defun tetris-shape-done () |
| 488 | (tetris-shift-down) |
| 489 | (setq tetris-n-shapes (1+ tetris-n-shapes)) |
| 490 | (setq tetris-score |
| 491 | (+ tetris-score |
| 492 | (aref (aref tetris-shape-scores tetris-shape) tetris-rot))) |
| 493 | (tetris-update-score) |
| 494 | (tetris-new-shape)) |
| 495 | |
| 496 | (defun tetris-update-game (tetris-buffer) |
| 497 | "Called on each clock tick. |
| 498 | Drops the shape one square, testing for collision." |
| 499 | (if (and (not tetris-paused) |
| 500 | (eq (current-buffer) tetris-buffer)) |
| 501 | (let (hit) |
| 502 | (tetris-erase-shape) |
| 503 | (setq tetris-pos-y (1+ tetris-pos-y)) |
| 504 | (setq hit (tetris-test-shape)) |
| 505 | (if hit |
| 506 | (setq tetris-pos-y (1- tetris-pos-y))) |
| 507 | (tetris-draw-shape) |
| 508 | (if hit |
| 509 | (tetris-shape-done))))) |
| 510 | |
| 511 | (defun tetris-move-bottom () |
| 512 | "Drops the shape to the bottom of the playing area" |
| 513 | (interactive) |
| 514 | (let ((hit nil)) |
| 515 | (tetris-erase-shape) |
| 516 | (while (not hit) |
| 517 | (setq tetris-pos-y (1+ tetris-pos-y)) |
| 518 | (setq hit (tetris-test-shape))) |
| 519 | (setq tetris-pos-y (1- tetris-pos-y)) |
| 520 | (tetris-draw-shape) |
| 521 | (tetris-shape-done))) |
| 522 | |
| 523 | (defun tetris-move-left () |
| 524 | "Moves the shape one square to the left" |
| 525 | (interactive) |
| 526 | (unless (= tetris-pos-x 0) |
| 527 | (tetris-erase-shape) |
| 528 | (setq tetris-pos-x (1- tetris-pos-x)) |
| 529 | (if (tetris-test-shape) |
| 530 | (setq tetris-pos-x (1+ tetris-pos-x))) |
| 531 | (tetris-draw-shape))) |
| 532 | |
| 533 | (defun tetris-move-right () |
| 534 | "Moves the shape one square to the right" |
| 535 | (interactive) |
| 536 | (unless (= (+ tetris-pos-x (tetris-shape-width)) |
| 537 | tetris-width) |
| 538 | (tetris-erase-shape) |
| 539 | (setq tetris-pos-x (1+ tetris-pos-x)) |
| 540 | (if (tetris-test-shape) |
| 541 | (setq tetris-pos-x (1- tetris-pos-x))) |
| 542 | (tetris-draw-shape))) |
| 543 | |
| 544 | (defun tetris-rotate-prev () |
| 545 | "Rotates the shape clockwise" |
| 546 | (interactive) |
| 547 | (tetris-erase-shape) |
| 548 | (setq tetris-rot (% (+ 1 tetris-rot) 4)) |
| 549 | (if (tetris-test-shape) |
| 550 | (setq tetris-rot (% (+ 3 tetris-rot) 4))) |
| 551 | (tetris-draw-shape)) |
| 552 | |
| 553 | (defun tetris-rotate-next () |
| 554 | "Rotates the shape anticlockwise" |
| 555 | (interactive) |
| 556 | (tetris-erase-shape) |
| 557 | (setq tetris-rot (% (+ 3 tetris-rot) 4)) |
| 558 | (if (tetris-test-shape) |
| 559 | (setq tetris-rot (% (+ 1 tetris-rot) 4))) |
| 560 | (tetris-draw-shape)) |
| 561 | |
| 562 | (defun tetris-end-game () |
| 563 | "Terminates the current game" |
| 564 | (interactive) |
| 565 | (gamegrid-kill-timer) |
| 566 | (use-local-map tetris-null-map) |
| 567 | (gamegrid-add-score tetris-score-file tetris-score)) |
| 568 | |
| 569 | (defun tetris-start-game () |
| 570 | "Starts a new game of Tetris" |
| 571 | (interactive) |
| 572 | (tetris-reset-game) |
| 573 | (use-local-map tetris-mode-map) |
| 574 | (let ((period (or (tetris-get-tick-period) |
| 575 | tetris-default-tick-period))) |
| 576 | (gamegrid-start-timer period 'tetris-update-game))) |
| 577 | |
| 578 | (defun tetris-pause-game () |
| 579 | "Pauses (or resumes) the current game" |
| 580 | (interactive) |
| 581 | (setq tetris-paused (not tetris-paused)) |
| 582 | (message (and tetris-paused "Game paused (press p to resume)"))) |
| 583 | |
| 584 | (defun tetris-active-p () |
| 585 | (eq (current-local-map) tetris-mode-map)) |
| 586 | |
| 587 | (put 'tetris-mode 'mode-class 'special) |
| 588 | |
| 589 | (defun tetris-mode () |
| 590 | "A mode for playing Tetris. |
| 591 | |
| 592 | tetris-mode keybindings: |
| 593 | \\{tetris-mode-map} |
| 594 | " |
| 595 | (kill-all-local-variables) |
| 596 | |
| 597 | (add-hook 'kill-buffer-hook 'gamegrid-kill-timer nil t) |
| 598 | |
| 599 | (use-local-map tetris-null-map) |
| 600 | |
| 601 | (setq major-mode 'tetris-mode) |
| 602 | (setq mode-name "Tetris") |
| 603 | |
| 604 | (setq mode-popup-menu |
| 605 | '("Tetris Commands" |
| 606 | ["Start new game" tetris-start-game] |
| 607 | ["End game" tetris-end-game |
| 608 | (tetris-active-p)] |
| 609 | ["Pause" tetris-pause-game |
| 610 | (and (tetris-active-p) (not tetris-paused))] |
| 611 | ["Resume" tetris-pause-game |
| 612 | (and (tetris-active-p) tetris-paused)])) |
| 613 | |
| 614 | (setq gamegrid-use-glyphs tetris-use-glyphs) |
| 615 | (setq gamegrid-use-color tetris-use-color) |
| 616 | |
| 617 | (gamegrid-init (tetris-display-options)) |
| 618 | |
| 619 | (run-hooks 'tetris-mode-hook)) |
| 620 | |
| 621 | ;;;###autoload |
| 622 | (defun tetris () |
| 623 | "Play the Tetris game. |
| 624 | Shapes drop from the top of the screen, and the user has to move and |
| 625 | rotate the shape to fit in with those at the bottom of the screen so |
| 626 | as to form complete rows. |
| 627 | |
| 628 | tetris-mode keybindings: |
| 629 | \\<tetris-mode-map> |
| 630 | \\[tetris-start-game] Starts a new game of Tetris |
| 631 | \\[tetris-end-game] Terminates the current game |
| 632 | \\[tetris-pause-game] Pauses (or resumes) the current game |
| 633 | \\[tetris-move-left] Moves the shape one square to the left |
| 634 | \\[tetris-move-right] Moves the shape one square to the right |
| 635 | \\[tetris-rotate-prev] Rotates the shape clockwise |
| 636 | \\[tetris-rotate-next] Rotates the shape anticlockwise |
| 637 | \\[tetris-move-bottom] Drops the shape to the bottom of the playing area |
| 638 | |
| 639 | " |
| 640 | (interactive) |
| 641 | |
| 642 | (switch-to-buffer tetris-buffer-name) |
| 643 | (gamegrid-kill-timer) |
| 644 | (tetris-mode) |
| 645 | (tetris-start-game)) |
| 646 | |
| 647 | (provide 'tetris) |
| 648 | |
| 649 | ;;; arch-tag: fb780d53-3ff0-49f0-8e19-f7f13cf2d49e |
| 650 | ;;; tetris.el ends here |