Mercurial > emacs
annotate lisp/play/tetris.el @ 110149:4ac2b883320e
Forgor to save ChangeLog for previous commit.
author | Jan D. <jan.h.d@swipnet.se> |
---|---|
date | Thu, 02 Sep 2010 12:20:20 +0200 |
parents | ddd0e4f58fa3 |
children | 417b1e4d63cd |
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 |
104848
1382a0cd8022
Remove leading * from defcustom and defface docs.
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
3 ;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, |
106815 | 4 ;; 2009, 2010 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 |
108016
6be35f3ece28
tetris.el: Use `define-derived-mode'; fix window selection; doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
38 "Play a game of Tetris." |
42921
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 |
104848
1382a0cd8022
Remove leading * from defcustom and defface docs.
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
43 "Non-nil means use glyphs when available." |
42921
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 |
104848
1382a0cd8022
Remove leading * from defcustom and defface docs.
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
48 "Non-nil means use color when available." |
42921
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 |
104848
1382a0cd8022
Remove leading * from defcustom and defface docs.
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
53 "Non-nil means draw a border even when using glyphs." |
42921
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 |
104848
1382a0cd8022
Remove leading * from defcustom and defface docs.
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
58 "The default time taken for a shape to drop one row." |
42921
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 |
108016
6be35f3ece28
tetris.el: Use `define-derived-mode'; fix window selection; doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
64 "Function run whenever the Tetris score changes. |
22490 | 65 Called with two arguments: (SHAPES ROWS) |
108016
6be35f3ece28
tetris.el: Use `define-derived-mode'; fix window selection; doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
66 SHAPES is the number of shapes which have been dropped. |
6be35f3ece28
tetris.el: Use `define-derived-mode'; fix window selection; doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
67 ROWS is the number of rows which have been completed. |
22490 | 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 |
109503
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
79 ["blue" "white" "yellow" "magenta" "cyan" "green" "red"] |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
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 :group 'tetris |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
82 :type (let ((names `("Shape 1" "Shape 2" "Shape 3" |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
83 "Shape 4" "Shape 5" "Shape 6" "Shape 7")) |
109503
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
84 (result nil)) |
42921
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
85 (while names |
43655
1ae60187a39d
fixed parens in the last patch
Sam Steingold <sds@gnu.org>
parents:
43653
diff
changeset
|
86 (add-to-list 'result |
1ae60187a39d
fixed parens in the last patch
Sam Steingold <sds@gnu.org>
parents:
43653
diff
changeset
|
87 (cons 'choice |
1ae60187a39d
fixed parens in the last patch
Sam Steingold <sds@gnu.org>
parents:
43653
diff
changeset
|
88 (cons :tag |
1ae60187a39d
fixed parens in the last patch
Sam Steingold <sds@gnu.org>
parents:
43653
diff
changeset
|
89 (cons (car names) |
42921
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
90 (mapcar (lambda (color) |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
91 (list 'const color)) |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
92 (defined-colors))))) |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
93 t) |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
94 (setq names (cdr names))) |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
95 result)) |
22490 | 96 |
42921
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
97 (defcustom tetris-x-colors |
109503
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
98 [[0 0 1] [0.7 0 1] [1 1 0] [1 0 1] [0 1 1] [0 1 0] [1 0 0]] |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
99 "Vector of colors of the various shapes." |
42921
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
100 :group 'tetris |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
101 :type 'sexp) |
22490 | 102 |
42921
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
103 (defcustom tetris-buffer-name "*Tetris*" |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
104 "Name used for Tetris buffer." |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
105 :group 'tetris |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
106 :type 'string) |
22490 | 107 |
42921
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
108 (defcustom tetris-buffer-width 30 |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
109 "Width of used portion of buffer." |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
110 :group 'tetris |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
111 :type 'number) |
22490 | 112 |
42921
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
113 (defcustom tetris-buffer-height 22 |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
114 "Height of used portion of buffer." |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
115 :group 'tetris |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
116 :type 'number) |
22490 | 117 |
42921
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
118 (defcustom tetris-width 10 |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
119 "Width of playing area." |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
120 :group 'tetris |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
121 :type 'number) |
22490 | 122 |
42921
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
123 (defcustom tetris-height 20 |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
124 "Height of playing area." |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
125 :group 'tetris |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
126 :type 'number) |
22490 | 127 |
42921
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
128 (defcustom tetris-top-left-x 3 |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
129 "X position of top left of playing area." |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
130 :group 'tetris |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
131 :type 'number) |
22490 | 132 |
42921
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
133 (defcustom tetris-top-left-y 1 |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
134 "Y position of top left of playing area." |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
135 :group 'tetris |
6267794dc181
(tetris): New defgroup.
Richard M. Stallman <rms@gnu.org>
parents:
41487
diff
changeset
|
136 :type 'number) |
22490 | 137 |
138 (defvar tetris-next-x (+ (* 2 tetris-top-left-x) tetris-width) | |
139 "X position of next shape.") | |
140 | |
141 (defvar tetris-next-y tetris-top-left-y | |
142 "Y position of next shape.") | |
143 | |
144 (defvar tetris-score-x tetris-next-x | |
145 "X position of score.") | |
146 | |
147 (defvar tetris-score-y (+ tetris-next-y 6) | |
148 "Y position of score.") | |
149 | |
43653
dd7b3395a514
(tetris-score-file): Put in home dir, not in /tmp.
Richard M. Stallman <rms@gnu.org>
parents:
42921
diff
changeset
|
150 ;; 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
|
151 ;; 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
|
152 ;; 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
|
153 (defvar tetris-score-file "tetris-scores" |
22490 | 154 ;; anybody with a well-connected server want to host this? |
155 ;(defvar tetris-score-file "/anonymous@ftp.pgt.com:/pub/cgw/tetris-scores" | |
156 "File for holding high scores.") | |
157 | |
158 ;; ;;;;;;;;;;;;; display options ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
159 | |
160 (defvar tetris-blank-options | |
161 '(((glyph colorize) | |
162 (t ?\040)) | |
163 ((color-x color-x) | |
164 (mono-x grid-x) | |
47461
b2bce4f54bce
(tetris-blank-options, tetris-cell-options):
Francesco Potortì <pot@gnu.org>
parents:
44485
diff
changeset
|
165 (color-tty color-tty)) |
22490 | 166 (((glyph color-x) [0 0 0]) |
47461
b2bce4f54bce
(tetris-blank-options, tetris-cell-options):
Francesco Potortì <pot@gnu.org>
parents:
44485
diff
changeset
|
167 (color-tty "black")))) |
22490 | 168 |
169 (defvar tetris-cell-options | |
170 '(((glyph colorize) | |
171 (emacs-tty ?O) | |
172 (t ?\040)) | |
173 ((color-x color-x) | |
174 (mono-x mono-x) | |
175 (color-tty color-tty) | |
47461
b2bce4f54bce
(tetris-blank-options, tetris-cell-options):
Francesco Potortì <pot@gnu.org>
parents:
44485
diff
changeset
|
176 (mono-tty mono-tty)) |
22490 | 177 ;; color information is taken from tetris-x-colors and tetris-tty-colors |
178 )) | |
179 | |
47461
b2bce4f54bce
(tetris-blank-options, tetris-cell-options):
Francesco Potortì <pot@gnu.org>
parents:
44485
diff
changeset
|
180 (defvar tetris-border-options |
b2bce4f54bce
(tetris-blank-options, tetris-cell-options):
Francesco Potortì <pot@gnu.org>
parents:
44485
diff
changeset
|
181 '(((glyph colorize) |
b2bce4f54bce
(tetris-blank-options, tetris-cell-options):
Francesco Potortì <pot@gnu.org>
parents:
44485
diff
changeset
|
182 (t ?\+)) |
b2bce4f54bce
(tetris-blank-options, tetris-cell-options):
Francesco Potortì <pot@gnu.org>
parents:
44485
diff
changeset
|
183 ((color-x color-x) |
b2bce4f54bce
(tetris-blank-options, tetris-cell-options):
Francesco Potortì <pot@gnu.org>
parents:
44485
diff
changeset
|
184 (mono-x grid-x) |
b2bce4f54bce
(tetris-blank-options, tetris-cell-options):
Francesco Potortì <pot@gnu.org>
parents:
44485
diff
changeset
|
185 (color-tty color-tty)) |
b2bce4f54bce
(tetris-blank-options, tetris-cell-options):
Francesco Potortì <pot@gnu.org>
parents:
44485
diff
changeset
|
186 (((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
|
187 (color-tty "white")))) |
b2bce4f54bce
(tetris-blank-options, tetris-cell-options):
Francesco Potortì <pot@gnu.org>
parents:
44485
diff
changeset
|
188 |
22490 | 189 (defvar tetris-space-options |
190 '(((t ?\040)) | |
191 nil | |
192 nil)) | |
193 | |
194 ;; ;;;;;;;;;;;;; constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
195 | |
196 (defconst tetris-shapes | |
109503
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
197 [[[[0 0] [1 0] [0 1] [1 1]]] |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
198 |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
199 [[[0 0] [1 0] [2 0] [2 1]] |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
200 [[1 -1] [1 0] [1 1] [0 1]] |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
201 [[0 -1] [0 0] [1 0] [2 0]] |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
202 [[1 -1] [2 -1] [1 0] [1 1]]] |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
203 |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
204 [[[0 0] [1 0] [2 0] [0 1]] |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
205 [[0 -1] [1 -1] [1 0] [1 1]] |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
206 [[2 -1] [0 0] [1 0] [2 0]] |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
207 [[1 -1] [1 0] [1 1] [2 1]]] |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
208 |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
209 [[[0 0] [1 0] [1 1] [2 1]] |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
210 [[1 0] [0 1] [1 1] [0 2]]] |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
211 |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
212 [[[1 0] [2 0] [0 1] [1 1]] |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
213 [[0 0] [0 1] [1 1] [1 2]]] |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
214 |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
215 [[[1 0] [0 1] [1 1] [2 1]] |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
216 [[1 0] [1 1] [2 1] [1 2]] |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
217 [[0 1] [1 1] [2 1] [1 2]] |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
218 [[1 0] [0 1] [1 1] [1 2]]] |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
219 |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
220 [[[0 0] [1 0] [2 0] [3 0]] |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
221 [[1 -1] [1 0] [1 1] [1 2]]]] |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
222 "Each shape is described by a vector that contains the coordinates of |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
223 each one of its four blocks.") |
22490 | 224 |
43655
1ae60187a39d
fixed parens in the last patch
Sam Steingold <sds@gnu.org>
parents:
43653
diff
changeset
|
225 ;;the scoring rules were taken from "xtetris". Blocks score differently |
22490 | 226 ;;depending on their rotation |
227 | |
43655
1ae60187a39d
fixed parens in the last patch
Sam Steingold <sds@gnu.org>
parents:
43653
diff
changeset
|
228 (defconst tetris-shape-scores |
109503
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
229 [[6] [6 7 6 7] [6 7 6 7] [6 7] [6 7] [5 5 6 5] [5 8]] ) |
22490 | 230 |
231 (defconst tetris-shape-dimensions | |
232 [[2 2] [3 2] [3 2] [3 2] [3 2] [3 2] [4 1]]) | |
233 | |
109503
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
234 (defconst tetris-blank 7) |
22490 | 235 |
236 (defconst tetris-border 8) | |
237 | |
238 (defconst tetris-space 9) | |
239 | |
240 (defun tetris-default-update-speed-function (shapes rows) | |
241 (/ 20.0 (+ 50.0 rows))) | |
242 | |
243 ;; ;;;;;;;;;;;;; variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
244 | |
245 (defvar tetris-shape 0) | |
246 (defvar tetris-rot 0) | |
247 (defvar tetris-next-shape 0) | |
248 (defvar tetris-n-shapes 0) | |
249 (defvar tetris-n-rows 0) | |
250 (defvar tetris-score 0) | |
251 (defvar tetris-pos-x 0) | |
252 (defvar tetris-pos-y 0) | |
253 (defvar tetris-paused nil) | |
254 | |
255 (make-variable-buffer-local 'tetris-shape) | |
256 (make-variable-buffer-local 'tetris-rot) | |
257 (make-variable-buffer-local 'tetris-next-shape) | |
258 (make-variable-buffer-local 'tetris-n-shapes) | |
259 (make-variable-buffer-local 'tetris-n-rows) | |
260 (make-variable-buffer-local 'tetris-score) | |
261 (make-variable-buffer-local 'tetris-pos-x) | |
262 (make-variable-buffer-local 'tetris-pos-y) | |
263 (make-variable-buffer-local 'tetris-paused) | |
264 | |
265 ;; ;;;;;;;;;;;;; keymaps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
266 | |
267 (defvar tetris-mode-map | |
108016
6be35f3ece28
tetris.el: Use `define-derived-mode'; fix window selection; doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
268 (let ((map (make-sparse-keymap 'tetris-mode-map))) |
6be35f3ece28
tetris.el: Use `define-derived-mode'; fix window selection; doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
269 (define-key map "n" 'tetris-start-game) |
6be35f3ece28
tetris.el: Use `define-derived-mode'; fix window selection; doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
270 (define-key map "q" 'tetris-end-game) |
6be35f3ece28
tetris.el: Use `define-derived-mode'; fix window selection; doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
271 (define-key map "p" 'tetris-pause-game) |
22490 | 272 |
108016
6be35f3ece28
tetris.el: Use `define-derived-mode'; fix window selection; doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
273 (define-key map " " 'tetris-move-bottom) |
6be35f3ece28
tetris.el: Use `define-derived-mode'; fix window selection; doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
274 (define-key map [left] 'tetris-move-left) |
6be35f3ece28
tetris.el: Use `define-derived-mode'; fix window selection; doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
275 (define-key map [right] 'tetris-move-right) |
6be35f3ece28
tetris.el: Use `define-derived-mode'; fix window selection; doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
276 (define-key map [up] 'tetris-rotate-prev) |
6be35f3ece28
tetris.el: Use `define-derived-mode'; fix window selection; doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
277 (define-key map [down] 'tetris-rotate-next) |
6be35f3ece28
tetris.el: Use `define-derived-mode'; fix window selection; doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
278 map)) |
22490 | 279 |
280 (defvar tetris-null-map | |
108016
6be35f3ece28
tetris.el: Use `define-derived-mode'; fix window selection; doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
281 (let ((map (make-sparse-keymap 'tetris-null-map))) |
6be35f3ece28
tetris.el: Use `define-derived-mode'; fix window selection; doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
282 (define-key map "n" 'tetris-start-game) |
6be35f3ece28
tetris.el: Use `define-derived-mode'; fix window selection; doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
283 map)) |
22490 | 284 |
285 ;; ;;;;;;;;;;;;;;;; game functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
286 | |
287 (defun tetris-display-options () | |
288 (let ((options (make-vector 256 nil))) | |
289 (loop for c from 0 to 255 do | |
290 (aset options c | |
291 (cond ((= c tetris-blank) | |
292 tetris-blank-options) | |
109503
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
293 ((and (>= c 0) (<= c 6)) |
22490 | 294 (append |
295 tetris-cell-options | |
296 `((((glyph color-x) ,(aref tetris-x-colors c)) | |
297 (color-tty ,(aref tetris-tty-colors c)) | |
298 (t nil))))) | |
299 ((= c tetris-border) | |
300 tetris-border-options) | |
301 ((= c tetris-space) | |
302 tetris-space-options) | |
303 (t | |
304 '(nil nil nil))))) | |
305 options)) | |
306 | |
307 (defun tetris-get-tick-period () | |
308 (if (boundp 'tetris-update-speed-function) | |
309 (let ((period (apply tetris-update-speed-function | |
310 tetris-n-shapes | |
311 tetris-n-rows nil))) | |
312 (and (numberp period) period)))) | |
313 | |
109503
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
314 (defun tetris-get-shape-cell (block) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
315 (aref (aref (aref tetris-shapes |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
316 tetris-shape) tetris-rot) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
317 block)) |
22490 | 318 |
319 (defun tetris-shape-width () | |
109503
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
320 (aref (aref tetris-shape-dimensions tetris-shape) 0)) |
22490 | 321 |
109503
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
322 (defun tetris-shape-rotations () |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
323 (length (aref tetris-shapes tetris-shape))) |
22490 | 324 |
325 (defun tetris-draw-score () | |
326 (let ((strings (vector (format "Shapes: %05d" tetris-n-shapes) | |
327 (format "Rows: %05d" tetris-n-rows) | |
328 (format "Score: %05d" tetris-score)))) | |
329 (loop for y from 0 to 2 do | |
330 (let* ((string (aref strings y)) | |
331 (len (length string))) | |
332 (loop for x from 0 to (1- len) do | |
333 (gamegrid-set-cell (+ tetris-score-x x) | |
334 (+ tetris-score-y y) | |
335 (aref string x))))))) | |
336 | |
337 (defun tetris-update-score () | |
338 (tetris-draw-score) | |
339 (let ((period (tetris-get-tick-period))) | |
340 (if period (gamegrid-set-timer period)))) | |
341 | |
342 (defun tetris-new-shape () | |
343 (setq tetris-shape tetris-next-shape) | |
344 (setq tetris-rot 0) | |
345 (setq tetris-next-shape (random 7)) | |
346 (setq tetris-pos-x (/ (- tetris-width (tetris-shape-width)) 2)) | |
347 (setq tetris-pos-y 0) | |
348 (if (tetris-test-shape) | |
349 (tetris-end-game) | |
75482
d08d2bb89f98
(tetris-new-shape): Stop drawing if game is over.
Chong Yidong <cyd@stupidchicken.com>
parents:
75347
diff
changeset
|
350 (tetris-draw-shape) |
d08d2bb89f98
(tetris-new-shape): Stop drawing if game is over.
Chong Yidong <cyd@stupidchicken.com>
parents:
75347
diff
changeset
|
351 (tetris-draw-next-shape) |
d08d2bb89f98
(tetris-new-shape): Stop drawing if game is over.
Chong Yidong <cyd@stupidchicken.com>
parents:
75347
diff
changeset
|
352 (tetris-update-score))) |
22490 | 353 |
354 (defun tetris-draw-next-shape () | |
109503
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
355 (loop for x from 0 to 3 do |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
356 (loop for y from 0 to 3 do |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
357 (gamegrid-set-cell (+ tetris-next-x x) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
358 (+ tetris-next-y y) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
359 tetris-blank))) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
360 (loop for i from 0 to 3 do |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
361 (let ((tetris-shape tetris-next-shape) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
362 (tetris-rot 0)) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
363 (gamegrid-set-cell (+ tetris-next-x |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
364 (aref (tetris-get-shape-cell i) 0)) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
365 (+ tetris-next-y |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
366 (aref (tetris-get-shape-cell i) 1)) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
367 tetris-shape)))) |
22490 | 368 |
369 (defun tetris-draw-shape () | |
109503
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
370 (loop for i from 0 to 3 do |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
371 (let ((c (tetris-get-shape-cell i))) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
372 (gamegrid-set-cell (+ tetris-top-left-x |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
373 tetris-pos-x |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
374 (aref c 0)) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
375 (+ tetris-top-left-y |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
376 tetris-pos-y |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
377 (aref c 1)) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
378 tetris-shape)))) |
22490 | 379 |
380 (defun tetris-erase-shape () | |
109503
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
381 (loop for i from 0 to 3 do |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
382 (let ((c (tetris-get-shape-cell i))) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
383 (gamegrid-set-cell (+ tetris-top-left-x |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
384 tetris-pos-x |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
385 (aref c 0)) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
386 (+ tetris-top-left-y |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
387 tetris-pos-y |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
388 (aref c 1)) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
389 tetris-blank)))) |
22490 | 390 |
391 (defun tetris-test-shape () | |
392 (let ((hit nil)) | |
109503
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
393 (loop for i from 0 to 3 do |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
394 (unless hit |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
395 (setq hit |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
396 (let* ((c (tetris-get-shape-cell i)) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
397 (xx (+ tetris-pos-x |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
398 (aref c 0))) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
399 (yy (+ tetris-pos-y |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
400 (aref c 1)))) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
401 (or (>= xx tetris-width) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
402 (>= yy tetris-height) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
403 (/= (gamegrid-get-cell |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
404 (+ xx tetris-top-left-x) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
405 (+ yy tetris-top-left-y)) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
406 tetris-blank)))))) |
22490 | 407 hit)) |
408 | |
409 (defun tetris-full-row (y) | |
410 (let ((full t)) | |
411 (loop for x from 0 to (1- tetris-width) do | |
412 (if (= (gamegrid-get-cell (+ tetris-top-left-x x) | |
413 (+ tetris-top-left-y y)) | |
414 tetris-blank) | |
415 (setq full nil))) | |
416 full)) | |
417 | |
418 (defun tetris-shift-row (y) | |
419 (if (= y 0) | |
420 (loop for x from 0 to (1- tetris-width) do | |
421 (gamegrid-set-cell (+ tetris-top-left-x x) | |
422 (+ tetris-top-left-y y) | |
423 tetris-blank)) | |
424 (loop for x from 0 to (1- tetris-width) do | |
425 (let ((c (gamegrid-get-cell (+ tetris-top-left-x x) | |
426 (+ tetris-top-left-y y -1)))) | |
427 (gamegrid-set-cell (+ tetris-top-left-x x) | |
428 (+ tetris-top-left-y y) | |
429 c))))) | |
430 | |
431 (defun tetris-shift-down () | |
432 (loop for y0 from 0 to (1- tetris-height) do | |
433 (if (tetris-full-row y0) | |
434 (progn (setq tetris-n-rows (1+ tetris-n-rows)) | |
435 (loop for y from y0 downto 0 do | |
436 (tetris-shift-row y)))))) | |
437 | |
438 (defun tetris-draw-border-p () | |
439 (or (not (eq gamegrid-display-mode 'glyph)) | |
440 tetris-draw-border-with-glyphs)) | |
441 | |
442 (defun tetris-init-buffer () | |
443 (gamegrid-init-buffer tetris-buffer-width | |
444 tetris-buffer-height | |
445 tetris-space) | |
446 (let ((buffer-read-only nil)) | |
447 (if (tetris-draw-border-p) | |
448 (loop for y from -1 to tetris-height do | |
449 (loop for x from -1 to tetris-width do | |
450 (gamegrid-set-cell (+ tetris-top-left-x x) | |
451 (+ tetris-top-left-y y) | |
452 tetris-border)))) | |
453 (loop for y from 0 to (1- tetris-height) do | |
454 (loop for x from 0 to (1- tetris-width) do | |
455 (gamegrid-set-cell (+ tetris-top-left-x x) | |
456 (+ tetris-top-left-y y) | |
457 tetris-blank))) | |
458 (if (tetris-draw-border-p) | |
459 (loop for y from -1 to 4 do | |
460 (loop for x from -1 to 4 do | |
461 (gamegrid-set-cell (+ tetris-next-x x) | |
462 (+ tetris-next-y y) | |
463 tetris-border)))))) | |
464 | |
465 (defun tetris-reset-game () | |
466 (gamegrid-kill-timer) | |
467 (tetris-init-buffer) | |
468 (setq tetris-next-shape (random 7)) | |
469 (setq tetris-shape 0 | |
470 tetris-rot 0 | |
471 tetris-pos-x 0 | |
472 tetris-pos-y 0 | |
473 tetris-n-shapes 0 | |
474 tetris-n-rows 0 | |
475 tetris-score 0 | |
476 tetris-paused nil) | |
477 (tetris-new-shape)) | |
478 | |
479 (defun tetris-shape-done () | |
480 (tetris-shift-down) | |
481 (setq tetris-n-shapes (1+ tetris-n-shapes)) | |
482 (setq tetris-score | |
43655
1ae60187a39d
fixed parens in the last patch
Sam Steingold <sds@gnu.org>
parents:
43653
diff
changeset
|
483 (+ tetris-score |
22490 | 484 (aref (aref tetris-shape-scores tetris-shape) tetris-rot))) |
485 (tetris-update-score) | |
486 (tetris-new-shape)) | |
487 | |
488 (defun tetris-update-game (tetris-buffer) | |
489 "Called on each clock tick. | |
490 Drops the shape one square, testing for collision." | |
491 (if (and (not tetris-paused) | |
492 (eq (current-buffer) tetris-buffer)) | |
493 (let (hit) | |
494 (tetris-erase-shape) | |
495 (setq tetris-pos-y (1+ tetris-pos-y)) | |
496 (setq hit (tetris-test-shape)) | |
497 (if hit | |
498 (setq tetris-pos-y (1- tetris-pos-y))) | |
499 (tetris-draw-shape) | |
500 (if hit | |
501 (tetris-shape-done))))) | |
502 | |
503 (defun tetris-move-bottom () | |
108016
6be35f3ece28
tetris.el: Use `define-derived-mode'; fix window selection; doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
504 "Drop the shape to the bottom of the playing area." |
22490 | 505 (interactive) |
109503
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
506 (unless tetris-paused |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
507 (let ((hit nil)) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
508 (tetris-erase-shape) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
509 (while (not hit) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
510 (setq tetris-pos-y (1+ tetris-pos-y)) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
511 (setq hit (tetris-test-shape))) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
512 (setq tetris-pos-y (1- tetris-pos-y)) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
513 (tetris-draw-shape) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
514 (tetris-shape-done)))) |
22490 | 515 |
516 (defun tetris-move-left () | |
108016
6be35f3ece28
tetris.el: Use `define-derived-mode'; fix window selection; doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
517 "Move the shape one square to the left." |
22490 | 518 (interactive) |
109503
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
519 (unless tetris-paused |
22490 | 520 (tetris-erase-shape) |
521 (setq tetris-pos-x (1- tetris-pos-x)) | |
522 (if (tetris-test-shape) | |
109503
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
523 (setq tetris-pos-x (1+ tetris-pos-x))) |
22490 | 524 (tetris-draw-shape))) |
525 | |
526 (defun tetris-move-right () | |
108016
6be35f3ece28
tetris.el: Use `define-derived-mode'; fix window selection; doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
527 "Move the shape one square to the right." |
22490 | 528 (interactive) |
109503
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
529 (unless tetris-paused |
22490 | 530 (tetris-erase-shape) |
531 (setq tetris-pos-x (1+ tetris-pos-x)) | |
532 (if (tetris-test-shape) | |
533 (setq tetris-pos-x (1- tetris-pos-x))) | |
534 (tetris-draw-shape))) | |
535 | |
536 (defun tetris-rotate-prev () | |
108016
6be35f3ece28
tetris.el: Use `define-derived-mode'; fix window selection; doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
537 "Rotate the shape clockwise." |
22490 | 538 (interactive) |
109503
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
539 (unless tetris-paused |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
540 (tetris-erase-shape) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
541 (setq tetris-rot (% (+ 1 tetris-rot) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
542 (tetris-shape-rotations))) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
543 (if (tetris-test-shape) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
544 (setq tetris-rot (% (+ 3 tetris-rot) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
545 (tetris-shape-rotations)))) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
546 (tetris-draw-shape))) |
22490 | 547 |
548 (defun tetris-rotate-next () | |
108016
6be35f3ece28
tetris.el: Use `define-derived-mode'; fix window selection; doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
549 "Rotate the shape anticlockwise." |
22490 | 550 (interactive) |
109503
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
551 (unless tetris-paused |
76281
678584f358ef
(tetris-move-bottom, tetris-move-left)
Eli Zaretskii <eliz@gnu.org>
parents:
75482
diff
changeset
|
552 (tetris-erase-shape) |
109503
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
553 (setq tetris-rot (% (+ 3 tetris-rot) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
554 (tetris-shape-rotations))) |
76281
678584f358ef
(tetris-move-bottom, tetris-move-left)
Eli Zaretskii <eliz@gnu.org>
parents:
75482
diff
changeset
|
555 (if (tetris-test-shape) |
109503
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
556 (setq tetris-rot (% (+ 1 tetris-rot) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
557 (tetris-shape-rotations)))) |
ddd0e4f58fa3
* lisp/play/tetris.el: Cleanup image representation and rotation.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108016
diff
changeset
|
558 (tetris-draw-shape))) |
22490 | 559 |
560 (defun tetris-end-game () | |
108016
6be35f3ece28
tetris.el: Use `define-derived-mode'; fix window selection; doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
561 "Terminate the current game." |
22490 | 562 (interactive) |
563 (gamegrid-kill-timer) | |
564 (use-local-map tetris-null-map) | |
565 (gamegrid-add-score tetris-score-file tetris-score)) | |
566 | |
567 (defun tetris-start-game () | |
108016
6be35f3ece28
tetris.el: Use `define-derived-mode'; fix window selection; doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
568 "Start a new game of Tetris." |
22490 | 569 (interactive) |
570 (tetris-reset-game) | |
571 (use-local-map tetris-mode-map) | |
572 (let ((period (or (tetris-get-tick-period) | |
573 tetris-default-tick-period))) | |
574 (gamegrid-start-timer period 'tetris-update-game))) | |
575 | |
576 (defun tetris-pause-game () | |
108016
6be35f3ece28
tetris.el: Use `define-derived-mode'; fix window selection; doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
577 "Pause (or resume) the current game." |
22490 | 578 (interactive) |
579 (setq tetris-paused (not tetris-paused)) | |
580 (message (and tetris-paused "Game paused (press p to resume)"))) | |
581 | |
582 (defun tetris-active-p () | |
583 (eq (current-local-map) tetris-mode-map)) | |
584 | |
585 (put 'tetris-mode 'mode-class 'special) | |
586 | |
108016
6be35f3ece28
tetris.el: Use `define-derived-mode'; fix window selection; doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
587 (define-derived-mode tetris-mode nil "Tetris" |
6be35f3ece28
tetris.el: Use `define-derived-mode'; fix window selection; doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
588 "A mode for playing Tetris." |
22490 | 589 |
590 (add-hook 'kill-buffer-hook 'gamegrid-kill-timer nil t) | |
591 | |
592 (use-local-map tetris-null-map) | |
593 | |
64392
9f028db3b769
(tetris-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
594 (unless (featurep 'emacs) |
9f028db3b769
(tetris-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
595 (setq mode-popup-menu |
9f028db3b769
(tetris-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
596 '("Tetris Commands" |
9f028db3b769
(tetris-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
597 ["Start new game" tetris-start-game] |
9f028db3b769
(tetris-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
598 ["End game" tetris-end-game |
9f028db3b769
(tetris-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
599 (tetris-active-p)] |
9f028db3b769
(tetris-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
600 ["Pause" tetris-pause-game |
9f028db3b769
(tetris-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
601 (and (tetris-active-p) (not tetris-paused))] |
9f028db3b769
(tetris-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
602 ["Resume" tetris-pause-game |
9f028db3b769
(tetris-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
603 (and (tetris-active-p) tetris-paused)]))) |
22490 | 604 |
108016
6be35f3ece28
tetris.el: Use `define-derived-mode'; fix window selection; doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
605 (setq show-trailing-whitespace nil) |
6be35f3ece28
tetris.el: Use `define-derived-mode'; fix window selection; doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
606 |
22490 | 607 (setq gamegrid-use-glyphs tetris-use-glyphs) |
608 (setq gamegrid-use-color tetris-use-color) | |
609 | |
108016
6be35f3ece28
tetris.el: Use `define-derived-mode'; fix window selection; doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
610 (gamegrid-init (tetris-display-options))) |
22490 | 611 |
612 ;;;###autoload | |
613 (defun tetris () | |
614 "Play the Tetris game. | |
615 Shapes drop from the top of the screen, and the user has to move and | |
616 rotate the shape to fit in with those at the bottom of the screen so | |
617 as to form complete rows. | |
618 | |
619 tetris-mode keybindings: | |
620 \\<tetris-mode-map> | |
621 \\[tetris-start-game] Starts a new game of Tetris | |
622 \\[tetris-end-game] Terminates the current game | |
623 \\[tetris-pause-game] Pauses (or resumes) the current game | |
624 \\[tetris-move-left] Moves the shape one square to the left | |
625 \\[tetris-move-right] Moves the shape one square to the right | |
626 \\[tetris-rotate-prev] Rotates the shape clockwise | |
627 \\[tetris-rotate-next] Rotates the shape anticlockwise | |
628 \\[tetris-move-bottom] Drops the shape to the bottom of the playing area | |
629 | |
630 " | |
631 (interactive) | |
632 | |
108016
6be35f3ece28
tetris.el: Use `define-derived-mode'; fix window selection; doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
633 (select-window (or (get-buffer-window tetris-buffer-name) |
6be35f3ece28
tetris.el: Use `define-derived-mode'; fix window selection; doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
106815
diff
changeset
|
634 (selected-window))) |
22490 | 635 (switch-to-buffer tetris-buffer-name) |
636 (gamegrid-kill-timer) | |
637 (tetris-mode) | |
638 (tetris-start-game)) | |
639 | |
76953 | 640 (random t) |
641 | |
22490 | 642 (provide 'tetris) |
643 | |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
79716
diff
changeset
|
644 ;; arch-tag: fb780d53-3ff0-49f0-8e19-f7f13cf2d49e |
22490 | 645 ;;; tetris.el ends here |