;;; tetris.el --- implementation of Tetris for Emacs
-;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005,
-;; 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+;; 2009, 2010, 2011 Free Software Foundation, Inc.
;; Author: Glynn Clements <glynn@sensei.co.uk>
;; Version: 2.01
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs 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 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; ;;;;;;;;;;;;; customization variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defgroup tetris nil
- "Play a game of tetris."
+ "Play a game of Tetris."
:prefix "tetris-"
:group 'games)
(defcustom tetris-use-glyphs t
- "*Non-nil means use glyphs when available."
+ "Non-nil means use glyphs when available."
:group 'tetris
:type 'boolean)
(defcustom tetris-use-color t
- "*Non-nil means use color when available."
+ "Non-nil means use color when available."
:group 'tetris
:type 'boolean)
(defcustom tetris-draw-border-with-glyphs t
- "*Non-nil means draw a border even when using glyphs."
+ "Non-nil means draw a border even when using glyphs."
:group 'tetris
:type 'boolean)
(defcustom tetris-default-tick-period 0.3
- "*The default time taken for a shape to drop one row."
+ "The default time taken for a shape to drop one row."
:group 'tetris
:type 'number)
(defcustom tetris-update-speed-function
'tetris-default-update-speed-function
- "Function run whenever the Tetris score changes
+ "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
+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."
:group 'tetris
:type 'hook)
(defcustom tetris-tty-colors
- [nil "blue" "white" "yellow" "magenta" "cyan" "green" "red"]
- "Vector of colors of the various shapes in text mode
-Element 0 is ignored."
+ ["blue" "white" "yellow" "magenta" "cyan" "green" "red"]
+ "Vector of colors of the various shapes in text mode."
:group 'tetris
:type (let ((names `("Shape 1" "Shape 2" "Shape 3"
"Shape 4" "Shape 5" "Shape 6" "Shape 7"))
- (result `(vector (const nil))))
+ (result nil))
(while names
(add-to-list 'result
(cons 'choice
result))
(defcustom tetris-x-colors
- [nil [0 0 1] [0.7 0 1] [1 1 0] [1 0 1] [0 1 1] [0 1 0] [1 0 0]]
- "Vector of colors of the various shapes
-Element 0 is ignored."
+ [[0 0 1] [0.7 0 1] [1 1 0] [1 0 1] [0 1 1] [0 1 0] [1 0 0]]
+ "Vector of colors of the various shapes."
:group 'tetris
:type 'sexp)
;; ;;;;;;;;;;;;; constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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]]]])
+ [[[[0 0] [1 0] [0 1] [1 1]]]
+
+ [[[0 0] [1 0] [2 0] [2 1]]
+ [[1 -1] [1 0] [1 1] [0 1]]
+ [[0 -1] [0 0] [1 0] [2 0]]
+ [[1 -1] [2 -1] [1 0] [1 1]]]
+
+ [[[0 0] [1 0] [2 0] [0 1]]
+ [[0 -1] [1 -1] [1 0] [1 1]]
+ [[2 -1] [0 0] [1 0] [2 0]]
+ [[1 -1] [1 0] [1 1] [2 1]]]
+
+ [[[0 0] [1 0] [1 1] [2 1]]
+ [[1 0] [0 1] [1 1] [0 2]]]
+
+ [[[1 0] [2 0] [0 1] [1 1]]
+ [[0 0] [0 1] [1 1] [1 2]]]
+
+ [[[1 0] [0 1] [1 1] [2 1]]
+ [[1 0] [1 1] [2 1] [1 2]]
+ [[0 1] [1 1] [2 1] [1 2]]
+ [[1 0] [0 1] [1 1] [1 2]]]
+
+ [[[0 0] [1 0] [2 0] [3 0]]
+ [[1 -1] [1 0] [1 1] [1 2]]]]
+ "Each shape is described by a vector that contains the coordinates of
+each one of its four blocks.")
;;the scoring rules were taken from "xtetris". Blocks score differently
;;depending on their rotation
(defconst tetris-shape-scores
- [ [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]] )
+ [[6] [6 7 6 7] [6 7 6 7] [6 7] [6 7] [5 5 6 5] [5 8]] )
(defconst tetris-shape-dimensions
[[2 2] [3 2] [3 2] [3 2] [3 2] [3 2] [4 1]])
-(defconst tetris-blank 0)
+(defconst tetris-blank 7)
(defconst tetris-border 8)
;; ;;;;;;;;;;;;; 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 "p" 'tetris-pause-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)
+ (let ((map (make-sparse-keymap 'tetris-mode-map)))
+ (define-key map "n" 'tetris-start-game)
+ (define-key map "q" 'tetris-end-game)
+ (define-key map "p" 'tetris-pause-game)
+
+ (define-key map " " 'tetris-move-bottom)
+ (define-key map [left] 'tetris-move-left)
+ (define-key map [right] 'tetris-move-right)
+ (define-key map [up] 'tetris-rotate-prev)
+ (define-key map [down] 'tetris-rotate-next)
+ map))
(defvar tetris-null-map
- (make-sparse-keymap 'tetris-null-map))
-
-(define-key tetris-null-map "n" 'tetris-start-game)
+ (let ((map (make-sparse-keymap 'tetris-null-map)))
+ (define-key map "n" 'tetris-start-game)
+ map))
;; ;;;;;;;;;;;;;;;; game functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(aset options c
(cond ((= c tetris-blank)
tetris-blank-options)
- ((and (>= c 1) (<= c 7))
+ ((and (>= c 0) (<= c 6))
(append
tetris-cell-options
`((((glyph color-x) ,(aref tetris-x-colors c))
tetris-n-rows nil)))
(and (numberp period) period))))
-(defun tetris-get-shape-cell (x y)
- (aref (aref (aref (aref tetris-shapes
- tetris-shape)
- y)
- tetris-rot)
- x))
+(defun tetris-get-shape-cell (block)
+ (aref (aref (aref tetris-shapes
+ tetris-shape) tetris-rot)
+ block))
(defun tetris-shape-width ()
- (aref (aref tetris-shape-dimensions tetris-shape)
- (% tetris-rot 2)))
+ (aref (aref tetris-shape-dimensions tetris-shape) 0))
-(defun tetris-shape-height ()
- (aref (aref tetris-shape-dimensions tetris-shape)
- (- 1 (% tetris-rot 2))))
+(defun tetris-shape-rotations ()
+ (length (aref tetris-shapes tetris-shape)))
(defun tetris-draw-score ()
(let ((strings (vector (format "Shapes: %05d" tetris-n-shapes)
(tetris-update-score)))
(defun tetris-draw-next-shape ()
- (loop for y from 0 to 3 do
- (loop for x from 0 to 3 do
- (gamegrid-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))))))
+ (loop for x from 0 to 3 do
+ (loop for y from 0 to 3 do
+ (gamegrid-set-cell (+ tetris-next-x x)
+ (+ tetris-next-y y)
+ tetris-blank)))
+ (loop for i from 0 to 3 do
+ (let ((tetris-shape tetris-next-shape)
+ (tetris-rot 0))
+ (gamegrid-set-cell (+ tetris-next-x
+ (aref (tetris-get-shape-cell i) 0))
+ (+ tetris-next-y
+ (aref (tetris-get-shape-cell i) 1))
+ tetris-shape))))
(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)
- (gamegrid-set-cell (+ tetris-top-left-x
- tetris-pos-x
- x)
- (+ tetris-top-left-y
- tetris-pos-y
- y)
- c))))))
+ (loop for i from 0 to 3 do
+ (let ((c (tetris-get-shape-cell i)))
+ (gamegrid-set-cell (+ tetris-top-left-x
+ tetris-pos-x
+ (aref c 0))
+ (+ tetris-top-left-y
+ tetris-pos-y
+ (aref c 1))
+ tetris-shape))))
(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))
- (px (+ tetris-top-left-x tetris-pos-x x))
- (py (+ tetris-top-left-y tetris-pos-y y)))
- (if (/= c tetris-blank)
- (gamegrid-set-cell px py tetris-blank))))))
+ (loop for i from 0 to 3 do
+ (let ((c (tetris-get-shape-cell i)))
+ (gamegrid-set-cell (+ tetris-top-left-x
+ tetris-pos-x
+ (aref c 0))
+ (+ tetris-top-left-y
+ tetris-pos-y
+ (aref c 1))
+ 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))
- (px (+ tetris-top-left-x xx))
- (py (+ tetris-top-left-y yy)))
- (and (/= c tetris-blank)
- (or (>= xx tetris-width)
- (>= yy tetris-height)
- (/= (gamegrid-get-cell px py)
- tetris-blank))))))))
+ (loop for i from 0 to 3 do
+ (unless hit
+ (setq hit
+ (let* ((c (tetris-get-shape-cell i))
+ (xx (+ tetris-pos-x
+ (aref c 0)))
+ (yy (+ tetris-pos-y
+ (aref c 1))))
+ (or (>= xx tetris-width)
+ (>= yy tetris-height)
+ (/= (gamegrid-get-cell
+ (+ xx tetris-top-left-x)
+ (+ yy tetris-top-left-y))
+ tetris-blank))))))
hit))
(defun tetris-full-row (y)
(tetris-shape-done)))))
(defun tetris-move-bottom ()
- "Drops the shape to the bottom of the playing area"
+ "Drop the shape to the bottom of the playing area."
(interactive)
- (if (not tetris-paused)
- (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))))
+ (unless tetris-paused
+ (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"
+ "Move the shape one square to the left."
(interactive)
- (unless (or (= tetris-pos-x 0)
- tetris-paused)
+ (unless tetris-paused
(tetris-erase-shape)
(setq tetris-pos-x (1- tetris-pos-x))
(if (tetris-test-shape)
- (setq tetris-pos-x (1+ tetris-pos-x)))
+ (setq tetris-pos-x (1+ tetris-pos-x)))
(tetris-draw-shape)))
(defun tetris-move-right ()
- "Moves the shape one square to the right"
+ "Move the shape one square to the right."
(interactive)
- (unless (or (= (+ tetris-pos-x (tetris-shape-width))
- tetris-width)
- tetris-paused)
+ (unless tetris-paused
(tetris-erase-shape)
(setq tetris-pos-x (1+ tetris-pos-x))
(if (tetris-test-shape)
(tetris-draw-shape)))
(defun tetris-rotate-prev ()
- "Rotates the shape clockwise"
+ "Rotate the shape clockwise."
(interactive)
- (if (not tetris-paused)
- (progn (tetris-erase-shape)
- (setq tetris-rot (% (+ 1 tetris-rot) 4))
- (if (tetris-test-shape)
- (setq tetris-rot (% (+ 3 tetris-rot) 4)))
- (tetris-draw-shape))))
+ (unless tetris-paused
+ (tetris-erase-shape)
+ (setq tetris-rot (% (+ 1 tetris-rot)
+ (tetris-shape-rotations)))
+ (if (tetris-test-shape)
+ (setq tetris-rot (% (+ 3 tetris-rot)
+ (tetris-shape-rotations))))
+ (tetris-draw-shape)))
(defun tetris-rotate-next ()
- "Rotates the shape anticlockwise"
+ "Rotate the shape anticlockwise."
(interactive)
- (if (not tetris-paused)
- (progn
+ (unless tetris-paused
(tetris-erase-shape)
- (setq tetris-rot (% (+ 3 tetris-rot) 4))
+ (setq tetris-rot (% (+ 3 tetris-rot)
+ (tetris-shape-rotations)))
(if (tetris-test-shape)
- (setq tetris-rot (% (+ 1 tetris-rot) 4)))
- (tetris-draw-shape))))
+ (setq tetris-rot (% (+ 1 tetris-rot)
+ (tetris-shape-rotations))))
+ (tetris-draw-shape)))
(defun tetris-end-game ()
- "Terminates the current game"
+ "Terminate the current game."
(interactive)
(gamegrid-kill-timer)
(use-local-map tetris-null-map)
(gamegrid-add-score tetris-score-file tetris-score))
(defun tetris-start-game ()
- "Starts a new game of Tetris"
+ "Start a new game of Tetris."
(interactive)
(tetris-reset-game)
(use-local-map tetris-mode-map)
(gamegrid-start-timer period 'tetris-update-game)))
(defun tetris-pause-game ()
- "Pauses (or resumes) the current game"
+ "Pause (or resume) the current game."
(interactive)
(setq tetris-paused (not tetris-paused))
(message (and tetris-paused "Game paused (press p to resume)")))
(put 'tetris-mode 'mode-class 'special)
-(defun tetris-mode ()
- "A mode for playing Tetris.
-
-tetris-mode keybindings:
- \\{tetris-mode-map}
-"
- (kill-all-local-variables)
+(define-derived-mode tetris-mode nil "Tetris"
+ "A mode for playing Tetris."
(add-hook 'kill-buffer-hook 'gamegrid-kill-timer nil t)
(use-local-map tetris-null-map)
- (setq major-mode 'tetris-mode)
- (setq mode-name "Tetris")
-
(unless (featurep 'emacs)
(setq mode-popup-menu
'("Tetris Commands"
["Resume" tetris-pause-game
(and (tetris-active-p) tetris-paused)])))
+ (setq show-trailing-whitespace nil)
+
(setq gamegrid-use-glyphs tetris-use-glyphs)
(setq gamegrid-use-color tetris-use-color)
- (gamegrid-init (tetris-display-options))
-
- (run-mode-hooks 'tetris-mode-hook))
+ (gamegrid-init (tetris-display-options)))
;;;###autoload
(defun tetris ()
"
(interactive)
+ (select-window (or (get-buffer-window tetris-buffer-name)
+ (selected-window)))
(switch-to-buffer tetris-buffer-name)
(gamegrid-kill-timer)
(tetris-mode)