annotate lisp/play/tetris.el @ 60615:643e6516a779

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