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