lisp/play/tetris.el

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