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