lisp/play/tetris.el

   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