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-border-options
 164   '(((glyph colorize)
 165      (t ?\+))
 166     ((color-x color-x)
 167      (mono-x grid-x)
 168      (t nil))
 169     (((glyph color-x) [0.5 0.5 0.5])
 170      (t nil))))
 171
 172 (defvar tetris-blank-options
 173   '(((glyph colorize)
 174      (t ?\040))
 175     ((color-x color-x)
 176      (mono-x grid-x)
 177      (color-tty color-tty)
 178      (t nil))
 179     (((glyph color-x) [0 0 0])
 180      (color-tty "black")
 181      (t nil))))
 182
 183 (defvar tetris-cell-options
 184   '(((glyph colorize)
 185      (emacs-tty ?O)
 186      (t ?\040))
 187     ((color-x color-x)
 188      (mono-x mono-x)
 189      (color-tty color-tty)
 190      (mono-tty mono-tty)
 191      (t nil))
 192     ;; color information is taken from tetris-x-colors and tetris-tty-colors
 193     ))
 194
 195 (defvar tetris-space-options
 196   '(((t ?\040))
 197     nil
 198     nil))
 199
 200 ;; ;;;;;;;;;;;;; constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 201
 202 (defconst tetris-shapes
 203   [[[[1 1 0 0] [1 1 0 0] [1 1 0 0] [1 1 0 0]]
 204     [[1 1 0 0] [1 1 0 0] [1 1 0 0] [1 1 0 0]]
 205     [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]
 206     [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]]
 207
 208    [[[2 2 2 0] [0 2 0 0] [2 0 0 0] [2 2 0 0]]
 209     [[0 0 2 0] [0 2 0 0] [2 2 2 0] [2 0 0 0]]
 210     [[0 0 0 0] [2 2 0 0] [0 0 0 0] [2 0 0 0]]
 211     [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]]
 212
 213    [[[3 3 3 0] [3 3 0 0] [0 0 3 0] [3 0 0 0]]
 214     [[3 0 0 0] [0 3 0 0] [3 3 3 0] [3 0 0 0]]
 215     [[0 0 0 0] [0 3 0 0] [0 0 0 0] [3 3 0 0]]
 216     [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]]
 217
 218    [[[4 4 0 0] [0 4 0 0] [4 4 0 0] [0 4 0 0]]
 219     [[0 4 4 0] [4 4 0 0] [0 4 4 0] [4 4 0 0]]
 220     [[0 0 0 0] [4 0 0 0] [0 0 0 0] [4 0 0 0]]
 221     [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]]
 222
 223    [[[0 5 5 0] [5 0 0 0] [0 5 5 0] [5 0 0 0]]
 224     [[5 5 0 0] [5 5 0 0] [5 5 0 0] [5 5 0 0]]
 225     [[0 0 0 0] [0 5 0 0] [0 0 0 0] [0 5 0 0]]
 226     [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]]
 227
 228    [[[0 6 0 0] [6 0 0 0] [6 6 6 0] [0 6 0 0]]
 229     [[6 6 6 0] [6 6 0 0] [0 6 0 0] [6 6 0 0]]
 230     [[0 0 0 0] [6 0 0 0] [0 0 0 0] [0 6 0 0]]
 231     [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]]
 232
 233    [[[7 7 7 7] [7 0 0 0] [7 7 7 7] [7 0 0 0]]
 234     [[0 0 0 0] [7 0 0 0] [0 0 0 0] [7 0 0 0]]
 235     [[0 0 0 0] [7 0 0 0] [0 0 0 0] [7 0 0 0]]
 236     [[0 0 0 0] [7 0 0 0] [0 0 0 0] [7 0 0 0]]]])
 237
 238 ;;the scoring rules were taken from "xtetris".  Blocks score differently
 239 ;;depending on their rotation
 240
 241 (defconst tetris-shape-scores
 242   [ [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]] )
 243
 244 (defconst tetris-shape-dimensions
 245   [[2 2] [3 2] [3 2] [3 2] [3 2] [3 2] [4 1]])
 246
 247 (defconst tetris-blank 0)
 248
 249 (defconst tetris-border 8)
 250
 251 (defconst tetris-space 9)
 252
 253 (defun tetris-default-update-speed-function (shapes rows)
 254   (/ 20.0 (+ 50.0 rows)))
 255
 256 ;; ;;;;;;;;;;;;; variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 257
 258 (defvar tetris-shape 0)
 259 (defvar tetris-rot 0)
 260 (defvar tetris-next-shape 0)
 261 (defvar tetris-n-shapes 0)
 262 (defvar tetris-n-rows 0)
 263 (defvar tetris-score 0)
 264 (defvar tetris-pos-x 0)
 265 (defvar tetris-pos-y 0)
 266 (defvar tetris-paused nil)
 267
 268 (make-variable-buffer-local 'tetris-shape)
 269 (make-variable-buffer-local 'tetris-rot)
 270 (make-variable-buffer-local 'tetris-next-shape)
 271 (make-variable-buffer-local 'tetris-n-shapes)
 272 (make-variable-buffer-local 'tetris-n-rows)
 273 (make-variable-buffer-local 'tetris-score)
 274 (make-variable-buffer-local 'tetris-pos-x)
 275 (make-variable-buffer-local 'tetris-pos-y)
 276 (make-variable-buffer-local 'tetris-paused)
 277
 278 ;; ;;;;;;;;;;;;; keymaps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 279
 280 (defvar tetris-mode-map
 281   (make-sparse-keymap 'tetris-mode-map))
 282
 283 (define-key tetris-mode-map "n"         'tetris-start-game)
 284 (define-key tetris-mode-map "q"         'tetris-end-game)
 285 (define-key tetris-mode-map "p"         'tetris-pause-game)
 286
 287 (define-key tetris-mode-map " "         'tetris-move-bottom)
 288 (define-key tetris-mode-map [left]      'tetris-move-left)
 289 (define-key tetris-mode-map [right]     'tetris-move-right)
 290 (define-key tetris-mode-map [up]        'tetris-rotate-prev)
 291 (define-key tetris-mode-map [down]      'tetris-rotate-next)
 292
 293 (defvar tetris-null-map
 294   (make-sparse-keymap 'tetris-null-map))
 295
 296 (define-key tetris-null-map "n"         'tetris-start-game)
 297
 298 ;; ;;;;;;;;;;;;;;;; game functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 299
 300 (defun tetris-display-options ()
 301   (let ((options (make-vector 256 nil)))
 302     (loop for c from 0 to 255 do
 303       (aset options c
 304             (cond ((= c tetris-blank)
 305                     tetris-blank-options)
 306                   ((and (>= c 1) (<= c 7))
 307                    (append
 308                     tetris-cell-options
 309                     `((((glyph color-x) ,(aref tetris-x-colors c))
 310                        (color-tty ,(aref tetris-tty-colors c))
 311                        (t nil)))))
 312                    ((= c tetris-border)
 313                     tetris-border-options)
 314                    ((= c tetris-space)
 315                     tetris-space-options)
 316                   (t
 317                    '(nil nil nil)))))
 318     options))
 319
 320 (defun tetris-get-tick-period ()
 321   (if (boundp 'tetris-update-speed-function)
 322       (let ((period (apply tetris-update-speed-function
 323                            tetris-n-shapes
 324                            tetris-n-rows nil)))
 325         (and (numberp period) period))))
 326
 327 (defun tetris-get-shape-cell (x y)
 328   (aref (aref (aref (aref tetris-shapes
 329                           tetris-shape)
 330                     y)
 331               tetris-rot)
 332         x))
 333
 334 (defun tetris-shape-width ()
 335   (aref (aref tetris-shape-dimensions tetris-shape)
 336         (% tetris-rot 2)))
 337
 338 (defun tetris-shape-height ()
 339   (aref (aref tetris-shape-dimensions tetris-shape)
 340         (- 1 (% tetris-rot 2))))
 341
 342 (defun tetris-draw-score ()
 343   (let ((strings (vector (format "Shapes: %05d" tetris-n-shapes)
 344                          (format "Rows:   %05d" tetris-n-rows)
 345                          (format "Score:  %05d" tetris-score))))
 346     (loop for y from 0 to 2 do
 347           (let* ((string (aref strings y))
 348                  (len (length string)))
 349             (loop for x from 0 to (1- len) do
 350                   (gamegrid-set-cell (+ tetris-score-x x)
 351                                      (+ tetris-score-y y)
 352                                      (aref string x)))))))
 353
 354 (defun tetris-update-score ()
 355   (tetris-draw-score)
 356   (let ((period (tetris-get-tick-period)))
 357     (if period (gamegrid-set-timer period))))
 358
 359 (defun tetris-new-shape ()
 360   (setq tetris-shape tetris-next-shape)
 361   (setq tetris-rot 0)
 362   (setq tetris-next-shape (random 7))
 363   (setq tetris-pos-x (/ (- tetris-width (tetris-shape-width)) 2))
 364   (setq tetris-pos-y 0)
 365   (if (tetris-test-shape)
 366       (tetris-end-game)
 367     (tetris-draw-shape))
 368   (tetris-draw-next-shape)
 369   (tetris-update-score))
 370
 371 (defun tetris-draw-next-shape ()
 372   (loop for y from 0 to 3 do
 373         (loop for x from 0 to 3 do
 374               (gamegrid-set-cell (+ tetris-next-x x)
 375                                  (+ tetris-next-y y)
 376                                  (let ((tetris-shape tetris-next-shape)
 377                                        (tetris-rot 0))
 378                                    (tetris-get-shape-cell x y))))))
 379
 380 (defun tetris-draw-shape ()
 381   (loop for y from 0 to (1- (tetris-shape-height)) do
 382         (loop for x from 0 to (1- (tetris-shape-width)) do
 383               (let ((c (tetris-get-shape-cell x y)))
 384                 (if (/= c tetris-blank)
 385                     (gamegrid-set-cell (+ tetris-top-left-x
 386                                           tetris-pos-x
 387                                           x)
 388                                        (+ tetris-top-left-y
 389                                           tetris-pos-y
 390                                           y)
 391                                        c))))))
 392
 393 (defun tetris-erase-shape ()
 394   (loop for y from 0 to (1- (tetris-shape-height)) do
 395         (loop for x from 0 to (1- (tetris-shape-width)) do
 396               (let ((c (tetris-get-shape-cell x y))
 397                     (px (+ tetris-top-left-x tetris-pos-x x))
 398                     (py (+ tetris-top-left-y tetris-pos-y y)))
 399                 (if (/= c tetris-blank)
 400                     (gamegrid-set-cell px py tetris-blank))))))
 401
 402 (defun tetris-test-shape ()
 403   (let ((hit nil))
 404     (loop for y from 0 to (1- (tetris-shape-height)) do
 405           (loop for x from 0 to (1- (tetris-shape-width)) do
 406                 (unless hit
 407                   (setq hit
 408                         (let* ((c (tetris-get-shape-cell x y))
 409                               (xx (+ tetris-pos-x x))
 410                               (yy (+ tetris-pos-y y))
 411                               (px (+ tetris-top-left-x xx))
 412                               (py (+ tetris-top-left-y yy)))
 413                           (and (/= c tetris-blank)
 414                                (or (>= xx tetris-width)
 415                                    (>= yy tetris-height)
 416                                    (/= (gamegrid-get-cell px py)
 417                                        tetris-blank))))))))
 418     hit))
 419
 420 (defun tetris-full-row (y)
 421   (let ((full t))
 422     (loop for x from 0 to (1- tetris-width) do
 423           (if (= (gamegrid-get-cell (+ tetris-top-left-x x)
 424                                     (+ tetris-top-left-y y))
 425                  tetris-blank)
 426               (setq full nil)))
 427     full))
 428
 429 (defun tetris-shift-row (y)
 430   (if (= y 0)
 431       (loop for x from 0 to (1- tetris-width) do
 432         (gamegrid-set-cell (+ tetris-top-left-x x)
 433                            (+ tetris-top-left-y y)
 434                            tetris-blank))
 435   (loop for x from 0 to (1- tetris-width) do
 436         (let ((c (gamegrid-get-cell (+ tetris-top-left-x x)
 437                                     (+ tetris-top-left-y y -1))))
 438           (gamegrid-set-cell (+ tetris-top-left-x x)
 439                              (+ tetris-top-left-y y)
 440                            c)))))
 441
 442 (defun tetris-shift-down ()
 443   (loop for y0 from 0 to (1- tetris-height) do
 444         (if (tetris-full-row y0)
 445             (progn (setq tetris-n-rows (1+ tetris-n-rows))
 446                    (loop for y from y0 downto 0 do
 447                          (tetris-shift-row y))))))
 448
 449 (defun tetris-draw-border-p ()
 450   (or (not (eq gamegrid-display-mode 'glyph))
 451       tetris-draw-border-with-glyphs))
 452
 453 (defun tetris-init-buffer ()
 454   (gamegrid-init-buffer tetris-buffer-width
 455                         tetris-buffer-height
 456                         tetris-space)
 457   (let ((buffer-read-only nil))
 458     (if (tetris-draw-border-p)
 459         (loop for y from -1 to tetris-height do
 460               (loop for x from -1 to tetris-width do
 461                     (gamegrid-set-cell (+ tetris-top-left-x x)
 462                                        (+ tetris-top-left-y y)
 463                                        tetris-border))))
 464     (loop for y from 0 to (1- tetris-height) do
 465           (loop for x from 0 to (1- tetris-width) do
 466                 (gamegrid-set-cell (+ tetris-top-left-x x)
 467                                    (+ tetris-top-left-y y)
 468                                    tetris-blank)))
 469     (if (tetris-draw-border-p)
 470         (loop for y from -1 to 4 do
 471               (loop for x from -1 to 4 do
 472                     (gamegrid-set-cell (+ tetris-next-x x)
 473                                        (+ tetris-next-y y)
 474                                        tetris-border))))))
 475
 476 (defun tetris-reset-game ()
 477   (gamegrid-kill-timer)
 478   (tetris-init-buffer)
 479   (setq tetris-next-shape (random 7))
 480   (setq tetris-shape    0
 481         tetris-rot      0
 482         tetris-pos-x    0
 483         tetris-pos-y    0
 484         tetris-n-shapes 0
 485         tetris-n-rows   0
 486         tetris-score    0
 487         tetris-paused   nil)
 488   (tetris-new-shape))
 489
 490 (defun tetris-shape-done ()
 491   (tetris-shift-down)
 492   (setq tetris-n-shapes (1+ tetris-n-shapes))
 493   (setq tetris-score
 494         (+ tetris-score
 495            (aref (aref tetris-shape-scores tetris-shape) tetris-rot)))
 496   (tetris-update-score)
 497   (tetris-new-shape))
 498
 499 (defun tetris-update-game (tetris-buffer)
 500   "Called on each clock tick.
 501 Drops the shape one square, testing for collision."
 502   (if (and (not tetris-paused)
 503            (eq (current-buffer) tetris-buffer))
 504       (let (hit)
 505         (tetris-erase-shape)
 506         (setq tetris-pos-y (1+ tetris-pos-y))
 507         (setq hit (tetris-test-shape))
 508         (if hit
 509             (setq tetris-pos-y (1- tetris-pos-y)))
 510         (tetris-draw-shape)
 511         (if hit
 512             (tetris-shape-done)))))
 513
 514 (defun tetris-move-bottom ()
 515   "Drops the shape to the bottom of the playing area"
 516   (interactive)
 517   (let ((hit nil))
 518     (tetris-erase-shape)
 519     (while (not hit)
 520       (setq tetris-pos-y (1+ tetris-pos-y))
 521       (setq hit (tetris-test-shape)))
 522     (setq tetris-pos-y (1- tetris-pos-y))
 523     (tetris-draw-shape)
 524     (tetris-shape-done)))
 525
 526 (defun tetris-move-left ()
 527   "Moves the shape one square to the left"
 528   (interactive)
 529   (unless (= tetris-pos-x 0)
 530     (tetris-erase-shape)
 531     (setq tetris-pos-x (1- tetris-pos-x))
 532     (if (tetris-test-shape)
 533         (setq tetris-pos-x (1+ tetris-pos-x)))
 534     (tetris-draw-shape)))
 535
 536 (defun tetris-move-right ()
 537   "Moves the shape one square to the right"
 538   (interactive)
 539   (unless (= (+ tetris-pos-x (tetris-shape-width))
 540              tetris-width)
 541     (tetris-erase-shape)
 542     (setq tetris-pos-x (1+ tetris-pos-x))
 543     (if (tetris-test-shape)
 544         (setq tetris-pos-x (1- tetris-pos-x)))
 545     (tetris-draw-shape)))
 546
 547 (defun tetris-rotate-prev ()
 548   "Rotates the shape clockwise"
 549   (interactive)
 550   (tetris-erase-shape)
 551   (setq tetris-rot (% (+ 1 tetris-rot) 4))
 552   (if (tetris-test-shape)
 553       (setq tetris-rot (% (+ 3 tetris-rot) 4)))
 554   (tetris-draw-shape))
 555
 556 (defun tetris-rotate-next ()
 557   "Rotates the shape anticlockwise"
 558   (interactive)
 559   (tetris-erase-shape)
 560   (setq tetris-rot (% (+ 3 tetris-rot) 4))
 561   (if (tetris-test-shape)
 562       (setq tetris-rot (% (+ 1 tetris-rot) 4)))
 563   (tetris-draw-shape))
 564
 565 (defun tetris-end-game ()
 566   "Terminates the current game"
 567   (interactive)
 568   (gamegrid-kill-timer)
 569   (use-local-map tetris-null-map)
 570   (gamegrid-add-score tetris-score-file tetris-score))
 571
 572 (defun tetris-start-game ()
 573   "Starts a new game of Tetris"
 574   (interactive)
 575   (tetris-reset-game)
 576   (use-local-map tetris-mode-map)
 577   (let ((period (or (tetris-get-tick-period)
 578                     tetris-default-tick-period)))
 579     (gamegrid-start-timer period 'tetris-update-game)))
 580
 581 (defun tetris-pause-game ()
 582   "Pauses (or resumes) the current game"
 583   (interactive)
 584   (setq tetris-paused (not tetris-paused))
 585   (message (and tetris-paused "Game paused (press p to resume)")))
 586
 587 (defun tetris-active-p ()
 588   (eq (current-local-map) tetris-mode-map))
 589
 590 (put 'tetris-mode 'mode-class 'special)
 591
 592 (defun tetris-mode ()
 593   "A mode for playing Tetris.
 594
 595 tetris-mode keybindings:
 596    \\{tetris-mode-map}
 597 "
 598   (kill-all-local-variables)
 599
 600   (add-hook 'kill-buffer-hook 'gamegrid-kill-timer nil t)
 601
 602   (use-local-map tetris-null-map)
 603
 604   (setq major-mode 'tetris-mode)
 605   (setq mode-name "Tetris")
 606
 607   (setq mode-popup-menu
 608         '("Tetris Commands"
 609           ["Start new game"     tetris-start-game]
 610           ["End game"           tetris-end-game
 611            (tetris-active-p)]
 612           ["Pause"              tetris-pause-game
 613            (and (tetris-active-p) (not tetris-paused))]
 614           ["Resume"             tetris-pause-game
 615            (and (tetris-active-p) tetris-paused)]))
 616
 617   (setq gamegrid-use-glyphs tetris-use-glyphs)
 618   (setq gamegrid-use-color tetris-use-color)
 619
 620   (gamegrid-init (tetris-display-options))
 621
 622   (run-hooks 'tetris-mode-hook))
 623
 624 ;;;###autoload
 625 (defun tetris ()
 626   "Play the Tetris game.
 627 Shapes drop from the top of the screen, and the user has to move and
 628 rotate the shape to fit in with those at the bottom of the screen so
 629 as to form complete rows.
 630
 631 tetris-mode keybindings:
 632    \\<tetris-mode-map>
 633 \\[tetris-start-game]   Starts a new game of Tetris
 634 \\[tetris-end-game]     Terminates the current game
 635 \\[tetris-pause-game]   Pauses (or resumes) the current game
 636 \\[tetris-move-left]    Moves the shape one square to the left
 637 \\[tetris-move-right]   Moves the shape one square to the right
 638 \\[tetris-rotate-prev]  Rotates the shape clockwise
 639 \\[tetris-rotate-next]  Rotates the shape anticlockwise
 640 \\[tetris-move-bottom]  Drops the shape to the bottom of the playing area
 641
 642 "
 643   (interactive)
 644
 645   (switch-to-buffer tetris-buffer-name)
 646   (gamegrid-kill-timer)
 647   (tetris-mode)
 648   (tetris-start-game))
 649
 650 (provide 'tetris)
 651
 652 ;;; tetris.el ends here