--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/games/tetris.el	Mon Aug 13 09:55:28 2007 +0200
@@ -0,0 +1,823 @@
+;;; tetris.el -- Implementation of Tetris for Emacs.
+
+;; Copyright (C) 1997 Glynn Clements <glynn@sensei.co.uk>
+
+;; Author: Glynn Clements <glynn@sensei.co.uk>
+;; Version: 1.7
+;; Created: 1997-08-13
+;; Keywords: games
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2 of the License, or
+;; (at your option) any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Not synched.
+
+;;; Commentary:
+
+;; Modified: 1997-08-17, added tetris-move-bottom
+;; Modified: 1997-08-22, changed setting of display table for compatibility
+;;	with XEmacs 19.15
+;; Modified: 1997-08-23, changed setting of display table for TTY compatibility
+;; Modified: 1997-08-24, various changes for FSF Emacs compatibility
+;; Modified: 1997-08-25
+;;	modified existing docstrings, added new docstrings
+;;	L now rotates the same way as T and mirror-L
+;;	now adds tetris-end-game to buffer-local value of kill-buffer-hook
+;; Modified: 1997-08-26, miscellaneous bugfixes
+;; Modified: 1997-08-27
+;;	added color support for non-glyph mode
+;;	added tetris-mode-hook
+;;	added tetris-update-speed-function
+;; URL: ftp://sensei.co.uk/misc/tetris.el.gz
+;; Tested with XEmacs 20.3-beta and Emacs 19.34
+;; Reported to work with XEmacs 19.15 and 20.2
+
+(eval-when-compile
+  (require 'cl))
+
+;; ;;;;;;;;;;;;; customization variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar tetris-use-glyphs t
+  "Non-nil means use glyphs when available")
+
+(defvar tetris-use-color t
+  "Non-nil means use color when available")
+
+(defvar tetris-draw-border-with-glyphs t
+  "Non-nil means draw a border even when using glyphs")
+
+(defvar tetris-font "-*-courier-medium-r-*-*-*-140-100-75-*-*-iso8859-*"
+  "Name of the font used for tetris in X mode")
+
+(defvar tetris-default-tick-period 0.3
+  "The default time taken for a shape to drop one row")
+
+(defvar tetris-update-speed-function
+  'tetris-default-update-speed-function
+  "Function run whenever the Tetris score changes
+Called with two arguments: (SHAPES ROWS)
+SHAPES is the number of shapes which have been dropped
+ROWS is the number of rows which have been completed
+
+If the return value is a number, it is used as the timer period")
+
+(defvar tetris-mode-hook nil
+  "Hook run upon starting Tetris")
+
+;; ;;;;;;;;;;;;; constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defconst tetris-buffer-name "*Tetris*"
+  "Name used for Tetris buffer")
+
+(defconst tetris-space-char [?\040]
+  "Character vector used for a space")
+
+(defconst tetris-block-char [?\040]
+  "Character vector for a full square in text mode")
+
+(defconst tetris-emacs-block-char [?O]
+  "Character vector for a full square in text mode under Emacs")
+
+(defconst tetris-border-char [?\+]
+  "Character vector for a border square in text mode")
+
+(defconst tetris-buffer-width 25
+  "Width of used portion of buffer")
+
+(defconst tetris-buffer-height 25
+  "Height of used portion of buffer")
+
+(defconst tetris-width 10
+  "Width of playing area")
+
+(defconst tetris-height 20
+  "Height of playing area")
+
+(defconst tetris-top-left-x 3
+  "X position of top left of playing area")
+
+(defconst tetris-top-left-y 1
+  "Y position of top left of playing area")
+
+(defconst tetris-next-x (+ (* 2 tetris-top-left-x) tetris-width)
+  "X position of next shape")
+
+(defconst tetris-next-y tetris-top-left-y
+  "Y position of next shape")
+
+(defconst tetris-score-x tetris-top-left-x
+  "X position of score")
+
+(defconst tetris-score-y (+ tetris-top-left-y tetris-height 2)
+  "Y position of score")
+
+(defconst tetris-blank 0)
+
+(defconst tetris-space ?\.)
+
+(defconst tetris-border ?\*)
+
+(defconst tetris-shapes
+  [[[[1 1 0 0] [1 1 0 0] [1 1 0 0] [1 1 0 0]]
+    [[1 1 0 0] [1 1 0 0] [1 1 0 0] [1 1 0 0]]
+    [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]
+    [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]]
+
+   [[[2 2 2 0] [0 2 0 0] [2 0 0 0] [2 2 0 0]]
+    [[0 0 2 0] [0 2 0 0] [2 2 2 0] [2 0 0 0]]
+    [[0 0 0 0] [2 2 0 0] [0 0 0 0] [2 0 0 0]]
+    [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]]
+
+   [[[3 3 3 0] [3 3 0 0] [0 0 3 0] [3 0 0 0]]
+    [[3 0 0 0] [0 3 0 0] [3 3 3 0] [3 0 0 0]]
+    [[0 0 0 0] [0 3 0 0] [0 0 0 0] [3 3 0 0]]
+    [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]]
+
+   [[[4 4 0 0] [0 4 0 0] [4 4 0 0] [0 4 0 0]]
+    [[0 4 4 0] [4 4 0 0] [0 4 4 0] [4 4 0 0]]
+    [[0 0 0 0] [4 0 0 0] [0 0 0 0] [4 0 0 0]]
+    [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]]
+
+   [[[0 5 5 0] [5 0 0 0] [0 5 5 0] [5 0 0 0]]
+    [[5 5 0 0] [5 5 0 0] [5 5 0 0] [5 5 0 0]]
+    [[0 0 0 0] [0 5 0 0] [0 0 0 0] [0 5 0 0]]
+    [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]]
+
+   [[[0 6 0 0] [6 0 0 0] [6 6 6 0] [0 6 0 0]]
+    [[6 6 6 0] [6 6 0 0] [0 6 0 0] [6 6 0 0]]
+    [[0 0 0 0] [6 0 0 0] [0 0 0 0] [0 6 0 0]]
+    [[0 0 0 0] [0 0 0 0] [0 0 0 0] [0 0 0 0]]]
+
+   [[[7 7 7 7] [7 0 0 0] [7 7 7 7] [7 0 0 0]]
+    [[0 0 0 0] [7 0 0 0] [0 0 0 0] [7 0 0 0]]
+    [[0 0 0 0] [7 0 0 0] [0 0 0 0] [7 0 0 0]]
+    [[0 0 0 0] [7 0 0 0] [0 0 0 0] [7 0 0 0]]]])
+
+(defconst tetris-shape-dimensions
+  [[2 2] [3 2] [3 2] [3 2] [3 2] [3 2] [4 1]])
+
+(defconst tetris-text-colors
+  ["black" "blue" "white" "yellow"
+   "magenta" "cyan" "green" "red"]
+  "Vector of colors of the various shapes in text mode
+Element 0 is the background color")
+
+(defconst tetris-colors
+  [[0 0 0] [0 0 1] [0.7 0 1] [1 1 0]
+   [1 0 1] [0 1 1] [0 1 0] [1 0 0]
+   [0.5 0.5 0.5]]
+  "Vector of colors of the various shapes
+Element 0 is the background color
+Element 8 is the border color")
+
+(defconst tetris-xpm "\
+/* XPM */
+static char *noname[] = {
+/* width height ncolors chars_per_pixel */
+\"16 16 3 1\",
+/* colors */
+\"+ s col1\",
+\". s col2\",
+\"- s col3\",
+/* pixels */
+\"---------------+\",
+\"--------------++\",
+\"--............++\",
+\"--............++\",
+\"--............++\",
+\"--............++\",
+\"--............++\",
+\"--............++\",
+\"--............++\",
+\"--............++\",
+\"--............++\",
+\"--............++\",
+\"--............++\",
+\"--............++\",
+\"-+++++++++++++++\",
+\"++++++++++++++++\"
+};
+"
+  "XPM format image used for each square")
+
+(defun tetris-default-update-speed-function (shapes rows)
+  (/ 20.0 (+ 50.0 rows)))
+
+;; ;;;;;;;;;;;;; variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar tetris-faces (make-vector 256 nil))
+
+(defvar tetris-buffer-start 1)
+
+(defvar tetris-display-mode nil)
+
+(defvar tetris-shape 0)
+(defvar tetris-rot 0)
+(defvar tetris-next-shape 0)
+(defvar tetris-n-shapes 0)
+(defvar tetris-n-rows 0)
+(defvar tetris-pos-x 0)
+(defvar tetris-pos-y 0)
+
+(defvar tetris-timer nil)
+
+(defvar tetris-display-table nil)
+
+;; ;;;;;;;;;;;;; keymaps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar tetris-mode-map
+  (make-sparse-keymap 'tetris-mode-map))
+
+(define-key tetris-mode-map "n"		'tetris-start-game)
+(define-key tetris-mode-map "q"		'tetris-end-game)
+
+(define-key tetris-mode-map " "		'tetris-move-bottom)
+(define-key tetris-mode-map [left]	'tetris-move-left)
+(define-key tetris-mode-map [right]	'tetris-move-right)
+(define-key tetris-mode-map [up]	'tetris-rotate-prev)
+(define-key tetris-mode-map [down]	'tetris-rotate-next)
+
+(defvar tetris-null-map
+  (make-sparse-keymap 'tetris-null-map))
+
+(define-key tetris-null-map "n"		'tetris-start-game)
+
+;; ;;;;;;;;;;;;;;;; timer functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun tetris-start-timer (period)
+  (setq tetris-timer
+	(if (featurep 'itimer)
+	    (start-itimer
+	     "Tetris"
+	     'tetris-update-game period period
+	     nil t (current-buffer))
+	  (run-with-timer
+	   period period
+	   'tetris-update-game (current-buffer)))))
+
+(defun tetris-set-timer (delay)
+  (if tetris-timer
+      (if (featurep 'itimer)
+	  (set-itimer-restart tetris-timer delay)
+	(timer-set-time tetris-timer
+			(list (aref tetris-timer 1)
+			      (aref tetris-timer 2)
+			      (aref tetris-timer 3))
+			delay))))
+
+(defun tetris-kill-timer ()
+  (if tetris-timer
+      (if (featurep 'itimer)
+          (delete-itimer tetris-timer)
+        (timer-set-time tetris-timer '(0 0 0) nil)))
+  (setq tetris-timer nil))
+
+;; ;;;;;;;;;;;;; display functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun tetris-color (col shade)
+  (let* ((vec (aref tetris-colors col))
+	 (v (floor (* shade 255)))
+	 (r (* v (aref vec 0)))
+	 (g (* v (aref vec 1)))
+	 (b (* v (aref vec 2))))
+    (format "#%02x%02x%02x" r g b)))
+
+(defun tetris-set-font (face)
+  (if tetris-font
+      (condition-case nil
+	  (set-face-font face tetris-font)
+	('error nil))))
+
+(defun tetris-setup-face (face color)
+  (set-face-foreground face color)
+  (set-face-background face color)
+  (tetris-set-font face)
+  (condition-case nil
+      (set-face-background-pixmap face [nothing])	;; XEmacs
+    ('error nil))
+  (condition-case nil
+      (set-face-background-pixmap face nil)		;; Emacs
+    ('error nil)))
+
+(defun tetris-make-mono-tty-face ()
+  (let ((face (make-face 'tetris-mono-tty-face)))
+    (condition-case nil
+	(set-face-property face 'reverse t)
+      ('error nil))
+    face))
+
+(defun tetris-make-color-tty-face (c)
+  (let* ((name (intern (format "tetris-color-tty-face-%d" c)))
+	 (face (make-face name)))
+    (tetris-setup-face face (aref tetris-text-colors c))
+    face))
+
+(defun tetris-make-x-border-face ()
+  (let ((face (make-face 'tetris-x-border-face)))
+    (tetris-set-font face)
+    face))
+
+(defun tetris-make-mono-x-face ()
+  (let ((face (make-face 'tetris-mono-x-face))
+	(color (face-foreground 'default)))
+    (if (null color)
+	(setq color
+	      (cdr-safe (assq 'foreground-color (frame-parameters)))))
+    (tetris-setup-face face color)
+    face))
+
+(defun tetris-make-color-x-face (c)
+  (let* ((name (intern (format "tetris-color-x-face-%d" c)))
+	 (face (make-face name)))
+    (tetris-setup-face face (tetris-color c 1.0))
+    face))
+
+(defun tetris-make-mono-tty-faces ()
+  (let ((face (tetris-make-mono-tty-face)))
+    (loop for c from 0 to 255 do
+	  (aset tetris-faces c
+		(cond
+		 ((or (= c 0) (> c 7))
+		  'default)
+		 (t
+		  face))))))
+
+(defun tetris-make-color-tty-faces ()
+  (loop for c from 0 to 255 do
+	(aset tetris-faces c
+	      (cond
+	       ((> c 7)
+		  'default)
+	       (t
+		(tetris-make-color-tty-face c))))))
+
+(defun tetris-make-mono-x-faces ()
+  (let ((face (tetris-make-mono-x-face))
+	(face2 (tetris-make-x-border-face)))
+    (loop for c from 0 to 255 do
+	  (aset tetris-faces c
+		(cond
+		 ((or (= c 0) (= c tetris-border))
+		  face2)
+		 ((> c 7)
+		  'default)
+		 (t
+		  face))))))
+
+(defun tetris-make-color-x-faces ()
+  (loop for c from 0 to 255 do
+	(aset tetris-faces c
+	      (cond
+	       ((= c tetris-border)
+		(tetris-make-x-border-face))
+	       ((> c 7)
+		'default)
+	       (t
+		(tetris-make-color-x-face c))))))
+
+(defun tetris-make-glyph (index)
+  (make-glyph
+   (vector
+    'xpm
+    :data tetris-xpm
+    :color-symbols (list
+		    (cons "col1" (tetris-color index 0.6))
+		    (cons "col2" (tetris-color index 0.8))
+		    (cons "col3" (tetris-color index 1.0))))))
+
+(defun tetris-make-display-table ()
+  (setq tetris-display-table (make-display-table))
+  (aset tetris-display-table tetris-space tetris-space-char)
+  (case tetris-display-mode
+    ('glyph
+     (aset tetris-display-table tetris-border (tetris-make-glyph 8))
+     (aset tetris-display-table tetris-blank (tetris-make-glyph 0)))
+    (otherwise
+     (aset tetris-display-table tetris-border tetris-border-char)
+     (aset tetris-display-table tetris-blank tetris-space-char)))
+  (loop for i from 1 to 7 do
+	(aset tetris-display-table
+	      (+ tetris-blank i)
+	      (case tetris-display-mode
+		('glyph
+		 (tetris-make-glyph i))
+		('emacs-tty
+		 tetris-emacs-block-char)
+		(otherwise
+		 tetris-block-char)))))
+
+(defun tetris-color-display-p ()
+  (if (fboundp 'device-class)
+      (eq (device-class (selected-device)) 'color)
+    (eq (cdr-safe (assq 'display-type (frame-parameters))) 'color)))
+
+(defun tetris-display-type ()
+  (cond ((and tetris-use-glyphs (eq window-system 'x) (featurep 'xpm))
+	 'glyph)
+	((and tetris-use-color (eq window-system 'x) (tetris-color-display-p))
+	 'color-x)
+	((eq window-system 'x)
+	 'mono-x)
+	((and tetris-use-color (tetris-color-display-p))
+	 'color-tty)
+	(t
+	 (if (fboundp 'set-face-property)
+	     'mono-tty
+	   'emacs-tty))))
+
+(defun tetris-initialize-display ()
+  (setq tetris-display-mode (tetris-display-type))
+  (tetris-make-display-table)
+  (case tetris-display-mode
+    ('mono-tty
+     (tetris-make-mono-tty-faces))
+    ('color-tty
+     (tetris-make-color-tty-faces))
+    ('mono-x
+     (tetris-make-mono-x-faces))
+    ('color-x
+     (tetris-make-color-x-faces))))
+
+(defun tetris-set-display-table ()
+  (if (fboundp 'specifierp)
+      (add-spec-to-specifier current-display-table
+			     tetris-display-table
+			     (current-buffer)
+			     nil 'remove-locale)
+    (setq buffer-display-table tetris-display-table)))
+
+(defun tetris-hide-cursor ()
+  (if (fboundp 'specifierp)
+      (set-specifier text-cursor-visible-p nil (current-buffer))))
+
+(defun tetris-draw-border-p ()
+  (or (not (eq tetris-display-mode 'glyph))
+      tetris-draw-border-with-glyphs))
+
+(defun tetris-set-color (c)
+  (unless (eq tetris-display-mode 'glyph)
+    (put-text-property
+     (1- (point)) (point) 'face (aref tetris-faces c))))
+
+;; ;;;;;;;;;;;;;;;; game functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun tetris-get-tick-period ()
+  (if (boundp 'tetris-update-speed-function)
+      (let ((period (apply tetris-update-speed-function
+			   tetris-n-shapes
+			   tetris-n-rows nil)))
+	(and (numberp period) period))))
+
+(defun tetris-cell-offset (x y)
+  (+ tetris-buffer-start
+     (* (1+ tetris-buffer-width) y)
+     x))
+
+(defun tetris-get-cell (x y)
+  (char-after (tetris-cell-offset x y)))
+
+(defun tetris-set-cell (x y c)
+  (save-excursion
+    (let ((buffer-read-only nil))
+      (goto-char (tetris-cell-offset x y))
+      (delete-char 1)
+      (insert-char c 1)
+      (tetris-set-color c))))
+
+(defun tetris-get-shape-cell (x y)
+  (aref
+   (aref
+    (aref
+     (aref tetris-shapes tetris-shape)
+     y)
+    tetris-rot)
+   x))
+
+(defun tetris-shape-width ()
+  (aref (aref tetris-shape-dimensions tetris-shape)
+	(% tetris-rot 2)))
+
+(defun tetris-shape-height ()
+  (aref (aref tetris-shape-dimensions tetris-shape)
+	(- 1 (% tetris-rot 2))))
+
+(defun tetris-draw-score ()
+  (let ((strings (vector
+		  (format "Shapes: %05d" tetris-n-shapes)
+		  (format "Rows:   %05d" tetris-n-rows))))
+    (loop for y from 0 to 1 do
+	  (let* ((string (aref strings y))
+		 (len (length string)))
+	    (loop for x from 0 to (1- len) do
+		  (tetris-set-cell
+		   (+ tetris-score-x x)
+		   (+ tetris-score-y y)
+		   (aref string x)))))))
+
+(defun tetris-update-score ()
+  (tetris-draw-score)
+  (let ((period (tetris-get-tick-period)))
+    (if period (tetris-set-timer period))))
+
+(defun tetris-new-shape ()
+  (setq tetris-shape tetris-next-shape)
+  (setq tetris-rot 0)
+  (setq tetris-next-shape (random 7))
+  (setq tetris-pos-x (random (- tetris-width (tetris-shape-width))))
+  (setq tetris-pos-y 0)
+  (setq tetris-n-shapes (1+ tetris-n-shapes))
+  (tetris-draw-next-shape)
+  (tetris-update-score))
+
+(defun tetris-draw-next-shape ()
+  (loop for y from 0 to 3 do
+	(loop for x from 0 to 3 do
+	      (tetris-set-cell
+	       (+ tetris-next-x x)
+	       (+ tetris-next-y y)
+	       (let ((tetris-shape tetris-next-shape)
+		     (tetris-rot 0))
+		 (tetris-get-shape-cell x y))))))
+
+(defun tetris-draw-shape ()
+  (loop for y from 0 to (1- (tetris-shape-height)) do
+	(loop for x from 0 to (1- (tetris-shape-width)) do
+	      (let ((c (tetris-get-shape-cell x y)))
+		(if (/= c tetris-blank)
+		    (tetris-set-cell
+		     (+ tetris-top-left-x tetris-pos-x x)
+		     (+ tetris-top-left-y tetris-pos-y y)
+		     c))))))
+
+(defun tetris-erase-shape ()
+  (loop for y from 0 to (1- (tetris-shape-height)) do
+	(loop for x from 0 to (1- (tetris-shape-width)) do
+	      (let ((c (tetris-get-shape-cell x y)))
+		(if (/= c tetris-blank)
+		    (tetris-set-cell
+		     (+ tetris-top-left-x tetris-pos-x x)
+		     (+ tetris-top-left-y tetris-pos-y y)
+		     tetris-blank))))))
+
+(defun tetris-test-shape ()
+  (let ((hit nil))
+    (loop for y from 0 to (1- (tetris-shape-height)) do
+	  (loop for x from 0 to (1- (tetris-shape-width)) do
+		(unless hit
+		  (setq hit
+			(let ((c (tetris-get-shape-cell x y))
+			      (xx (+ tetris-pos-x x))
+			      (yy (+ tetris-pos-y y)))
+			  (and (/= c tetris-blank)
+			       (or (>= xx tetris-width)
+				   (>= yy tetris-height)
+				   (/= (tetris-get-cell
+					(+ tetris-top-left-x xx)
+					(+ tetris-top-left-y yy))
+				       tetris-blank))))))))
+    hit))
+
+(defun tetris-full-row (y)
+  (let ((full t))
+    (loop for x from 0 to (1- tetris-width) do
+	  (if (= (tetris-get-cell
+		  (+ tetris-top-left-x x)
+		  (+ tetris-top-left-y y))
+		 tetris-blank)
+	      (setq full nil)))
+    full))
+
+(defun tetris-shift-row (y)
+  (loop for x from 0 to (1- tetris-width) do
+	(let ((c (tetris-get-cell
+		 (+ tetris-top-left-x x)
+		 (+ tetris-top-left-y y -1))))
+	  (tetris-set-cell
+	   (+ tetris-top-left-x x)
+	   (+ tetris-top-left-y y)
+	   c))))
+
+(defun tetris-shift-down ()
+  (loop for y0 from (1- tetris-height) downto 0 do
+	(if (tetris-full-row y0)
+	    (progn
+	      (setq tetris-n-rows (1+ tetris-n-rows))
+	      (tetris-update-score)
+	      (loop for y from y0 downto 1 do
+		    (tetris-shift-row y))))))
+
+(defun tetris-init-buffer ()
+  (let ((line (concat
+	       (make-string tetris-buffer-width tetris-space)
+	       "\n"))
+	(buffer-read-only nil))
+    (erase-buffer)
+    (setq tetris-buffer-start (point))
+    (dotimes (i tetris-buffer-height)
+      (insert-string line))
+    (if (tetris-draw-border-p)
+      (loop for y from -1 to tetris-height do
+	    (loop for x from -1 to tetris-width do
+		  (tetris-set-cell
+		   (+ tetris-top-left-x x)
+		   (+ tetris-top-left-y y)
+		   tetris-border))))
+    (loop for y from 0 to (1- tetris-height) do
+	  (loop for x from 0 to (1- tetris-width) do
+		(tetris-set-cell
+		 (+ tetris-top-left-x x)
+		 (+ tetris-top-left-y y)
+		 tetris-blank)))
+    (if (tetris-draw-border-p)
+      (loop for y from -1 to 4 do
+	    (loop for x from -1 to 4 do
+		  (tetris-set-cell
+		   (+ tetris-next-x x)
+		   (+ tetris-next-y y)
+		   tetris-border))))))
+
+(defun tetris-reset-game ()
+  (tetris-kill-timer)
+  (tetris-init-buffer)
+  (setq tetris-next-shape (random 7))
+  (setq tetris-shape		0
+	tetris-rot		0
+	tetris-n-shapes		0
+	tetris-n-rows		0
+	tetris-pos-x		0
+	tetris-pos-y		0)
+  (tetris-new-shape)
+  (tetris-draw-shape))
+
+(defun tetris-shape-done ()
+  (tetris-shift-down)
+  (tetris-new-shape)
+  (if (tetris-test-shape)
+      (progn
+	(tetris-end-game))
+    (tetris-draw-shape)))
+
+(defun tetris-update-game (tetris-buffer)
+  "Called on each clock tick.
+Drops the shape one square, testing for collision."
+  (if (eq (current-buffer) tetris-buffer)
+      (let (hit)
+	(tetris-erase-shape)
+	(setq tetris-pos-y (1+ tetris-pos-y))
+	(setq hit (tetris-test-shape))
+	(if hit
+	    (setq tetris-pos-y (1- tetris-pos-y)))
+	(tetris-draw-shape)
+	(if hit
+	    (tetris-shape-done)))))
+
+(defun tetris-move-bottom ()
+  "Drops the shape to the bottom of the playing area"
+  (interactive)
+  (let ((hit nil))
+    (tetris-erase-shape)
+    (while (not hit)
+      (setq tetris-pos-y (1+ tetris-pos-y))
+      (setq hit (tetris-test-shape)))
+    (setq tetris-pos-y (1- tetris-pos-y))
+    (tetris-draw-shape)
+    (tetris-shape-done)))
+
+(defun tetris-move-left ()
+  "Moves the shape one square to the left"
+  (interactive)
+  (unless (= tetris-pos-x 0)
+    (tetris-erase-shape)
+    (setq tetris-pos-x (1- tetris-pos-x))
+    (if (tetris-test-shape)
+	(setq tetris-pos-x (1+ tetris-pos-x)))
+    (tetris-draw-shape)))
+
+(defun tetris-move-right ()
+  "Moves the shape one square to the right"
+  (interactive)
+  (unless (= (+ tetris-pos-x (tetris-shape-width))
+	     tetris-width)
+    (tetris-erase-shape)
+    (setq tetris-pos-x (1+ tetris-pos-x))
+    (if (tetris-test-shape)
+	(setq tetris-pos-x (1- tetris-pos-x)))
+    (tetris-draw-shape)))
+
+(defun tetris-rotate-prev ()
+  "Rotates the shape clockwise"
+  (interactive)
+  (tetris-erase-shape)
+  (setq tetris-rot (% (+ 1 tetris-rot) 4))
+  (if (tetris-test-shape)
+      (setq tetris-rot (% (+ 3 tetris-rot) 4)))
+  (tetris-draw-shape))
+
+(defun tetris-rotate-next ()
+  "Rotates the shape anticlockwise"
+  (interactive)
+  (tetris-erase-shape)
+  (setq tetris-rot (% (+ 3 tetris-rot) 4))
+  (if (tetris-test-shape)
+      (setq tetris-rot (% (+ 1 tetris-rot) 4)))
+  (tetris-draw-shape))
+
+(defun tetris-end-game ()
+  "Terminates the current game"
+  (interactive)
+  (tetris-kill-timer)
+  (use-local-map tetris-null-map))
+
+(defun tetris-start-game ()
+  "Starts a new game of Tetris"
+  (interactive)
+  (tetris-reset-game)
+  (use-local-map tetris-mode-map)
+  (let ((period (or (tetris-get-tick-period)
+		    tetris-default-tick-period)))
+    (tetris-start-timer period)))
+
+(put 'tetris-mode 'mode-class 'special)
+
+(defun tetris-mode ()
+  "A mode for playing Tetris.
+
+tetris-mode keybindings:
+   \\{tetris-mode-map}
+"
+  (kill-all-local-variables)
+
+  (make-local-hook 'kill-buffer-hook)
+  (add-hook 'kill-buffer-hook 'tetris-end-game nil t)
+
+  (make-local-variable 'tetris-display-mode)
+  (make-local-variable 'tetris-display-table)
+  (make-local-variable 'tetris-faces)
+  (make-local-variable 'tetris-timer)
+  (make-local-variable 'tetris-buffer-start)
+  (make-local-variable 'tetris-shape)
+  (make-local-variable 'tetris-rot)
+  (make-local-variable 'tetris-next-shape)
+  (make-local-variable 'tetris-n-shapes)
+  (make-local-variable 'tetris-n-rows)
+  (make-local-variable 'tetris-pos-x)
+  (make-local-variable 'tetris-pos-y)
+
+  (use-local-map tetris-null-map)
+
+  (setq buffer-read-only t)
+  (setq truncate-lines 't)
+  (setq major-mode 'tetris-mode)
+  (setq mode-name "Tetris")
+
+  (buffer-disable-undo (current-buffer))
+
+  (tetris-initialize-display)
+  (tetris-set-display-table)
+  (tetris-hide-cursor)
+
+  (run-hooks 'tetris-mode-hook))
+
+(defun tetris ()
+  "Tetris
+
+Shapes drop from the top of the screen, and the user has to move and
+rotate the shape to fit in with those at the bottom of the screen so
+as to form complete rows.
+
+tetris-mode keybindings:
+   \\<tetris-mode-map>
+\\[tetris-start-game]	Starts a new game of Tetris
+\\[tetris-end-game]	Terminates the current game
+\\[tetris-move-left]	Moves the shape one square to the left
+\\[tetris-move-right]	Moves the shape one square to the right
+\\[tetris-rotate-prev]	Rotates the shape clockwise
+\\[tetris-rotate-next]	Rotates the shape anticlockwise
+\\[tetris-move-bottom]	Drops the shape to the bottom of the playing area
+
+"
+  (interactive)
+
+  (switch-to-buffer tetris-buffer-name)
+  (tetris-kill-timer)
+  (tetris-mode)
+  (tetris-start-game))
+
+(provide 'tetris)
+
+;;; tetris.el ends here
+