Mercurial > emacs
annotate lisp/play/tetris.el @ 104626:caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
(default-line-spacing, default-abbrev-mode, default-ctl-arrow)
(default-direction-reversed, default-truncate-lines)
(default-left-margin, default-tab-width, default-case-fold-search)
(default-left-margin-width, default-right-margin-width)
(default-left-fringe-width, default-right-fringe-width)
(default-fringes-outside-margins, default-scroll-bar-width)
(default-vertical-scroll-bar, default-indicate-empty-lines)
(default-indicate-buffer-boundaries, default-fringe-indicator-alist)
(default-fringe-cursor-alist, default-scroll-up-aggressively)
(default-scroll-down-aggressively, default-fill-column)
(default-cursor-type, default-buffer-file-type)
(default-cursor-in-non-selected-windows)
(default-buffer-file-coding-system, default-major-mode)
(default-enable-multibyte-characters): Mark as obsolete.
* cus-start.el (default-major-mode): Customize `major-mode' instead.
(enable-multibyte-characters): Not customizable any more.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Thu, 27 Aug 2009 04:24:00 +0000 |
parents | a9dc0e7c3f2b |
children | 1382a0cd8022 |
rev | line source |
---|---|
38425
c6e12c6b1498
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
22490
diff
changeset
|
1 ;;; tetris.el --- implementation of Tetris for Emacs |
22490 | 2 |
74509 | 3 ;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005, |
100908 | 4 ;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc. |
22490 | 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 | |
94675
949bd6ad1ba4
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
13 ;; GNU Emacs is free software: you can redistribute it and/or modify |
22490 | 14 ;; it under the terms of the GNU General Public License as published by |
94675
949bd6ad1ba4
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
15 ;; the Free Software Foundation, either version 3 of the License, or |
949bd6ad1ba4
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
16 ;; (at your option) any later version. |
22490 | 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 | |
94675
949bd6ad1ba4
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
22490 | 25 |
26 ;;; Commentary: | |
27 | |
38425
c6e12c6b1498
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
22490
diff
changeset
|
28 ;;; Code: |
c6e12c6b1498
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
22490
diff
changeset
|
29 |
22490 | 30 (eval-when-compile |
31 (require 'cl)) | |
32 | |
33 (require 'gamegrid) | |
34 | |
35 ;; ;;;;;;;;;;;;; customization variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
36 | |
42921
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
37 (defgroup tetris nil |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
38 "Play a game of tetris." |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
39 :prefix "tetris-" |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
40 :group 'games) |
22490 | 41 |
42921
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
42 (defcustom tetris-use-glyphs t |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
43 "*Non-nil means use glyphs when available." |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
44 :group 'tetris |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
45 :type 'boolean) |
22490 | 46 |
42921
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
47 (defcustom tetris-use-color t |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
48 "*Non-nil means use color when available." |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
49 :group 'tetris |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
50 :type 'boolean) |
22490 | 51 |
42921
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
52 (defcustom tetris-draw-border-with-glyphs t |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
53 "*Non-nil means draw a border even when using glyphs." |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
54 :group 'tetris |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
55 :type 'boolean) |
22490 | 56 |
42921
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
57 (defcustom tetris-default-tick-period 0.3 |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
58 "*The default time taken for a shape to drop one row." |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
59 :group 'tetris |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
60 :type 'number) |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
61 |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
62 (defcustom tetris-update-speed-function |
22490 | 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 | |
42921
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
69 If the return value is a number, it is used as the timer period." |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
70 :group 'tetris |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
71 :type 'function) |
22490 | 72 |
42921
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
73 (defcustom tetris-mode-hook nil |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
74 "Hook run upon starting Tetris." |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
75 :group 'tetris |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
76 :type 'hook) |
22490 | 77 |
42921
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
78 (defcustom tetris-tty-colors |
22490 | 79 [nil "blue" "white" "yellow" "magenta" "cyan" "green" "red"] |
80 "Vector of colors of the various shapes in text mode | |
42921
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
81 Element 0 is ignored." |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
82 :group 'tetris |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
83 :type (let ((names `("Shape 1" "Shape 2" "Shape 3" |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
84 "Shape 4" "Shape 5" "Shape 6" "Shape 7")) |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
85 (result `(vector (const nil)))) |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
86 (while names |
43655
1ae60187a39d
fixed parens in the last patch
Sam Steingold <sds@gnu.org>
parents:
43653
diff
changeset
|
87 (add-to-list 'result |
1ae60187a39d
fixed parens in the last patch
Sam Steingold <sds@gnu.org>
parents:
43653
diff
changeset
|
88 (cons 'choice |
1ae60187a39d
fixed parens in the last patch
Sam Steingold <sds@gnu.org>
parents:
43653
diff
changeset
|
89 (cons :tag |
1ae60187a39d
fixed parens in the last patch
Sam Steingold <sds@gnu.org>
parents:
43653
diff
changeset
|
90 (cons (car names) |
42921
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
91 (mapcar (lambda (color) |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
92 (list 'const color)) |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
93 (defined-colors))))) |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
94 t) |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
95 (setq names (cdr names))) |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
96 result)) |
22490 | 97 |
42921
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
98 (defcustom tetris-x-colors |
22490 | 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 | |
42921
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
101 Element 0 is ignored." |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
102 :group 'tetris |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
103 :type 'sexp) |
22490 | 104 |
42921
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
105 (defcustom tetris-buffer-name "*Tetris*" |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
106 "Name used for Tetris buffer." |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
107 :group 'tetris |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
108 :type 'string) |
22490 | 109 |
42921
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
110 (defcustom tetris-buffer-width 30 |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
111 "Width of used portion of buffer." |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
112 :group 'tetris |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
113 :type 'number) |
22490 | 114 |
42921
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
115 (defcustom tetris-buffer-height 22 |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
116 "Height of used portion of buffer." |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
117 :group 'tetris |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
118 :type 'number) |
22490 | 119 |
42921
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
120 (defcustom tetris-width 10 |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
121 "Width of playing area." |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
122 :group 'tetris |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
123 :type 'number) |
22490 | 124 |
42921
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
125 (defcustom tetris-height 20 |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
126 "Height of playing area." |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
127 :group 'tetris |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
128 :type 'number) |
22490 | 129 |
42921
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
130 (defcustom tetris-top-left-x 3 |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
131 "X position of top left of playing area." |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
132 :group 'tetris |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
133 :type 'number) |
22490 | 134 |
42921
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
135 (defcustom tetris-top-left-y 1 |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
136 "Y position of top left of playing area." |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
137 :group 'tetris |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
138 :type 'number) |
22490 | 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 | |
43653
dd7b3395a514
(tetris-score-file): Put in home dir, not in /tmp.
Richard M. Stallman <rms@gnu.org>
parents:
42921
diff
changeset
|
152 ;; It is not safe to put this in /tmp. |
43655
1ae60187a39d
fixed parens in the last patch
Sam Steingold <sds@gnu.org>
parents:
43653
diff
changeset
|
153 ;; Someone could make a symlink in /tmp |
43653
dd7b3395a514
(tetris-score-file): Put in home dir, not in /tmp.
Richard M. Stallman <rms@gnu.org>
parents:
42921
diff
changeset
|
154 ;; pointing to a file you don't want to clobber. |
44485
2fd94b88c732
(tetris-score-file): Likewise.
Colin Walters <walters@gnu.org>
parents:
43655
diff
changeset
|
155 (defvar tetris-score-file "tetris-scores" |
22490 | 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) | |
47461
b2bce4f54bce
(tetris-blank-options, tetris-cell-options):
Francesco Potortì <pot@gnu.org>
parents:
44485
diff
changeset
|
167 (color-tty color-tty)) |
22490 | 168 (((glyph color-x) [0 0 0]) |
47461
b2bce4f54bce
(tetris-blank-options, tetris-cell-options):
Francesco Potortì <pot@gnu.org>
parents:
44485
diff
changeset
|
169 (color-tty "black")))) |
22490 | 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) | |
47461
b2bce4f54bce
(tetris-blank-options, tetris-cell-options):
Francesco Potortì <pot@gnu.org>
parents:
44485
diff
changeset
|
178 (mono-tty mono-tty)) |
22490 | 179 ;; color information is taken from tetris-x-colors and tetris-tty-colors |
180 )) | |
181 | |
47461
b2bce4f54bce
(tetris-blank-options, tetris-cell-options):
Francesco Potortì <pot@gnu.org>
parents:
44485
diff
changeset
|
182 (defvar tetris-border-options |
b2bce4f54bce
(tetris-blank-options, tetris-cell-options):
Francesco Potortì <pot@gnu.org>
parents:
44485
diff
changeset
|
183 '(((glyph colorize) |
b2bce4f54bce
(tetris-blank-options, tetris-cell-options):
Francesco Potortì <pot@gnu.org>
parents:
44485
diff
changeset
|
184 (t ?\+)) |
b2bce4f54bce
(tetris-blank-options, tetris-cell-options):
Francesco Potortì <pot@gnu.org>
parents:
44485
diff
changeset
|
185 ((color-x color-x) |
b2bce4f54bce
(tetris-blank-options, tetris-cell-options):
Francesco Potortì <pot@gnu.org>
parents:
44485
diff
changeset
|
186 (mono-x grid-x) |
b2bce4f54bce
(tetris-blank-options, tetris-cell-options):
Francesco Potortì <pot@gnu.org>
parents:
44485
diff
changeset
|
187 (color-tty color-tty)) |
b2bce4f54bce
(tetris-blank-options, tetris-cell-options):
Francesco Potortì <pot@gnu.org>
parents:
44485
diff
changeset
|
188 (((glyph color-x) [0.5 0.5 0.5]) |
b2bce4f54bce
(tetris-blank-options, tetris-cell-options):
Francesco Potortì <pot@gnu.org>
parents:
44485
diff
changeset
|
189 (color-tty "white")))) |
b2bce4f54bce
(tetris-blank-options, tetris-cell-options):
Francesco Potortì <pot@gnu.org>
parents:
44485
diff
changeset
|
190 |
22490 | 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 | |
43655
1ae60187a39d
fixed parens in the last patch
Sam Steingold <sds@gnu.org>
parents:
43653
diff
changeset
|
234 ;;the scoring rules were taken from "xtetris". Blocks score differently |
22490 | 235 ;;depending on their rotation |
236 | |
43655
1ae60187a39d
fixed parens in the last patch
Sam Steingold <sds@gnu.org>
parents:
43653
diff
changeset
|
237 (defconst tetris-shape-scores |
22490 | 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 (make-sparse-keymap 'tetris-mode-map)) | |
278 | |
279 (define-key tetris-mode-map "n" 'tetris-start-game) | |
280 (define-key tetris-mode-map "q" 'tetris-end-game) | |
281 (define-key tetris-mode-map "p" 'tetris-pause-game) | |
282 | |
283 (define-key tetris-mode-map " " 'tetris-move-bottom) | |
284 (define-key tetris-mode-map [left] 'tetris-move-left) | |
285 (define-key tetris-mode-map [right] 'tetris-move-right) | |
286 (define-key tetris-mode-map [up] 'tetris-rotate-prev) | |
287 (define-key tetris-mode-map [down] 'tetris-rotate-next) | |
288 | |
289 (defvar tetris-null-map | |
290 (make-sparse-keymap 'tetris-null-map)) | |
291 | |
292 (define-key tetris-null-map "n" 'tetris-start-game) | |
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) | |
75482
d08d2bb89f98
(tetris-new-shape): Stop drawing if game is over.
Chong Yidong <cyd@stupidchicken.com>
parents:
75347
diff
changeset
|
363 (tetris-draw-shape) |
d08d2bb89f98
(tetris-new-shape): Stop drawing if game is over.
Chong Yidong <cyd@stupidchicken.com>
parents:
75347
diff
changeset
|
364 (tetris-draw-next-shape) |
d08d2bb89f98
(tetris-new-shape): Stop drawing if game is over.
Chong Yidong <cyd@stupidchicken.com>
parents:
75347
diff
changeset
|
365 (tetris-update-score))) |
22490 | 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 | |
43655
1ae60187a39d
fixed parens in the last patch
Sam Steingold <sds@gnu.org>
parents:
43653
diff
changeset
|
490 (+ tetris-score |
22490 | 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 "Drops the shape to the bottom of the playing area" | |
512 (interactive) | |
76281
678584f358ef
(tetris-move-bottom, tetris-move-left)
Eli Zaretskii <eliz@gnu.org>
parents:
75482
diff
changeset
|
513 (if (not tetris-paused) |
678584f358ef
(tetris-move-bottom, tetris-move-left)
Eli Zaretskii <eliz@gnu.org>
parents:
75482
diff
changeset
|
514 (let ((hit nil)) |
678584f358ef
(tetris-move-bottom, tetris-move-left)
Eli Zaretskii <eliz@gnu.org>
parents:
75482
diff
changeset
|
515 (tetris-erase-shape) |
678584f358ef
(tetris-move-bottom, tetris-move-left)
Eli Zaretskii <eliz@gnu.org>
parents:
75482
diff
changeset
|
516 (while (not hit) |
678584f358ef
(tetris-move-bottom, tetris-move-left)
Eli Zaretskii <eliz@gnu.org>
parents:
75482
diff
changeset
|
517 (setq tetris-pos-y (1+ tetris-pos-y)) |
678584f358ef
(tetris-move-bottom, tetris-move-left)
Eli Zaretskii <eliz@gnu.org>
parents:
75482
diff
changeset
|
518 (setq hit (tetris-test-shape))) |
678584f358ef
(tetris-move-bottom, tetris-move-left)
Eli Zaretskii <eliz@gnu.org>
parents:
75482
diff
changeset
|
519 (setq tetris-pos-y (1- tetris-pos-y)) |
678584f358ef
(tetris-move-bottom, tetris-move-left)
Eli Zaretskii <eliz@gnu.org>
parents:
75482
diff
changeset
|
520 (tetris-draw-shape) |
678584f358ef
(tetris-move-bottom, tetris-move-left)
Eli Zaretskii <eliz@gnu.org>
parents:
75482
diff
changeset
|
521 (tetris-shape-done)))) |
22490 | 522 |
523 (defun tetris-move-left () | |
524 "Moves the shape one square to the left" | |
525 (interactive) | |
76281
678584f358ef
(tetris-move-bottom, tetris-move-left)
Eli Zaretskii <eliz@gnu.org>
parents:
75482
diff
changeset
|
526 (unless (or (= tetris-pos-x 0) |
678584f358ef
(tetris-move-bottom, tetris-move-left)
Eli Zaretskii <eliz@gnu.org>
parents:
75482
diff
changeset
|
527 tetris-paused) |
22490 | 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 "Moves the shape one square to the right" | |
536 (interactive) | |
76281
678584f358ef
(tetris-move-bottom, tetris-move-left)
Eli Zaretskii <eliz@gnu.org>
parents:
75482
diff
changeset
|
537 (unless (or (= (+ tetris-pos-x (tetris-shape-width)) |
678584f358ef
(tetris-move-bottom, tetris-move-left)
Eli Zaretskii <eliz@gnu.org>
parents:
75482
diff
changeset
|
538 tetris-width) |
678584f358ef
(tetris-move-bottom, tetris-move-left)
Eli Zaretskii <eliz@gnu.org>
parents:
75482
diff
changeset
|
539 tetris-paused) |
22490 | 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 "Rotates the shape clockwise" | |
548 (interactive) | |
76281
678584f358ef
(tetris-move-bottom, tetris-move-left)
Eli Zaretskii <eliz@gnu.org>
parents:
75482
diff
changeset
|
549 (if (not tetris-paused) |
678584f358ef
(tetris-move-bottom, tetris-move-left)
Eli Zaretskii <eliz@gnu.org>
parents:
75482
diff
changeset
|
550 (progn (tetris-erase-shape) |
678584f358ef
(tetris-move-bottom, tetris-move-left)
Eli Zaretskii <eliz@gnu.org>
parents:
75482
diff
changeset
|
551 (setq tetris-rot (% (+ 1 tetris-rot) 4)) |
678584f358ef
(tetris-move-bottom, tetris-move-left)
Eli Zaretskii <eliz@gnu.org>
parents:
75482
diff
changeset
|
552 (if (tetris-test-shape) |
678584f358ef
(tetris-move-bottom, tetris-move-left)
Eli Zaretskii <eliz@gnu.org>
parents:
75482
diff
changeset
|
553 (setq tetris-rot (% (+ 3 tetris-rot) 4))) |
678584f358ef
(tetris-move-bottom, tetris-move-left)
Eli Zaretskii <eliz@gnu.org>
parents:
75482
diff
changeset
|
554 (tetris-draw-shape)))) |
22490 | 555 |
556 (defun tetris-rotate-next () | |
557 "Rotates the shape anticlockwise" | |
558 (interactive) | |
76281
678584f358ef
(tetris-move-bottom, tetris-move-left)
Eli Zaretskii <eliz@gnu.org>
parents:
75482
diff
changeset
|
559 (if (not tetris-paused) |
678584f358ef
(tetris-move-bottom, tetris-move-left)
Eli Zaretskii <eliz@gnu.org>
parents:
75482
diff
changeset
|
560 (progn |
678584f358ef
(tetris-move-bottom, tetris-move-left)
Eli Zaretskii <eliz@gnu.org>
parents:
75482
diff
changeset
|
561 (tetris-erase-shape) |
678584f358ef
(tetris-move-bottom, tetris-move-left)
Eli Zaretskii <eliz@gnu.org>
parents:
75482
diff
changeset
|
562 (setq tetris-rot (% (+ 3 tetris-rot) 4)) |
678584f358ef
(tetris-move-bottom, tetris-move-left)
Eli Zaretskii <eliz@gnu.org>
parents:
75482
diff
changeset
|
563 (if (tetris-test-shape) |
678584f358ef
(tetris-move-bottom, tetris-move-left)
Eli Zaretskii <eliz@gnu.org>
parents:
75482
diff
changeset
|
564 (setq tetris-rot (% (+ 1 tetris-rot) 4))) |
678584f358ef
(tetris-move-bottom, tetris-move-left)
Eli Zaretskii <eliz@gnu.org>
parents:
75482
diff
changeset
|
565 (tetris-draw-shape)))) |
22490 | 566 |
567 (defun tetris-end-game () | |
568 "Terminates 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 "Starts 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 "Pauses (or resumes) 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 (defun tetris-mode () | |
595 "A mode for playing Tetris. | |
596 | |
597 tetris-mode keybindings: | |
598 \\{tetris-mode-map} | |
599 " | |
600 (kill-all-local-variables) | |
601 | |
602 (add-hook 'kill-buffer-hook 'gamegrid-kill-timer nil t) | |
603 | |
604 (use-local-map tetris-null-map) | |
605 | |
606 (setq major-mode 'tetris-mode) | |
607 (setq mode-name "Tetris") | |
608 | |
64392
9f028db3b769
(tetris-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
609 (unless (featurep 'emacs) |
9f028db3b769
(tetris-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
610 (setq mode-popup-menu |
9f028db3b769
(tetris-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
611 '("Tetris Commands" |
9f028db3b769
(tetris-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
612 ["Start new game" tetris-start-game] |
9f028db3b769
(tetris-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
613 ["End game" tetris-end-game |
9f028db3b769
(tetris-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
614 (tetris-active-p)] |
9f028db3b769
(tetris-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
615 ["Pause" tetris-pause-game |
9f028db3b769
(tetris-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
616 (and (tetris-active-p) (not tetris-paused))] |
9f028db3b769
(tetris-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
617 ["Resume" tetris-pause-game |
9f028db3b769
(tetris-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
618 (and (tetris-active-p) tetris-paused)]))) |
22490 | 619 |
620 (setq gamegrid-use-glyphs tetris-use-glyphs) | |
621 (setq gamegrid-use-color tetris-use-color) | |
622 | |
623 (gamegrid-init (tetris-display-options)) | |
624 | |
62770 | 625 (run-mode-hooks 'tetris-mode-hook)) |
22490 | 626 |
627 ;;;###autoload | |
628 (defun tetris () | |
629 "Play the Tetris game. | |
630 Shapes drop from the top of the screen, and the user has to move and | |
631 rotate the shape to fit in with those at the bottom of the screen so | |
632 as to form complete rows. | |
633 | |
634 tetris-mode keybindings: | |
635 \\<tetris-mode-map> | |
636 \\[tetris-start-game] Starts a new game of Tetris | |
637 \\[tetris-end-game] Terminates the current game | |
638 \\[tetris-pause-game] Pauses (or resumes) the current game | |
639 \\[tetris-move-left] Moves the shape one square to the left | |
640 \\[tetris-move-right] Moves the shape one square to the right | |
641 \\[tetris-rotate-prev] Rotates the shape clockwise | |
642 \\[tetris-rotate-next] Rotates the shape anticlockwise | |
643 \\[tetris-move-bottom] Drops the shape to the bottom of the playing area | |
644 | |
645 " | |
646 (interactive) | |
647 | |
648 (switch-to-buffer tetris-buffer-name) | |
649 (gamegrid-kill-timer) | |
650 (tetris-mode) | |
651 (tetris-start-game)) | |
652 | |
76953 | 653 (random t) |
654 | |
22490 | 655 (provide 'tetris) |
656 | |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
79716
diff
changeset
|
657 ;; arch-tag: fb780d53-3ff0-49f0-8e19-f7f13cf2d49e |
22490 | 658 ;;; tetris.el ends here |