lisp/play/tetris.el

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