Mercurial > emacs
annotate lisp/play/snake.el @ 90601:a1a25ac6c88a
Merge from emacs--devo--0
Patches applied:
* emacs--devo--0 (patch 427-436)
- Update from CVS
- Merge from gnus--rel--5.10
* gnus--rel--5.10 (patch 134-136)
- Merge from emacs--devo--0
- Update from CVS
Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-110
author | Miles Bader <miles@gnu.org> |
---|---|
date | Thu, 14 Sep 2006 09:24:00 +0000 |
parents | c5406394f567 |
children | 6588c6259dfb |
rev | line source |
---|---|
38425
c6e12c6b1498
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
22489
diff
changeset
|
1 ;;; snake.el --- implementation of Snake for Emacs |
22488 | 2 |
68634
836785857446
Update copyright notices of all files in the lisp/play directory.
Romain Francoise <romain@orebokech.com>
parents:
64701
diff
changeset
|
3 ;; Copyright (C) 1997, 2002, 2003, 2004, 2005, |
836785857446
Update copyright notices of all files in the lisp/play directory.
Romain Francoise <romain@orebokech.com>
parents:
64701
diff
changeset
|
4 ;; 2006 Free Software Foundation, Inc. |
22488 | 5 |
6 ;; Author: Glynn Clements <glynn@sensei.co.uk> | |
7 ;; Created: 1997-09-10 | |
8 ;; Keywords: games | |
9 | |
10 ;; This file is part of GNU Emacs. | |
11 | |
12 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
13 ;; it under the terms of the GNU General Public License as published by | |
14 ;; the Free Software Foundation; either version 2, or (at your option) | |
15 ;; any later version. | |
16 | |
17 ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 ;; GNU General Public License for more details. | |
21 | |
22 ;; You should have received a copy of the GNU General Public License | |
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
64085 | 24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
25 ;; Boston, MA 02110-1301, USA. | |
22488 | 26 |
27 ;;; Commentary: | |
28 | |
38425
c6e12c6b1498
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
22489
diff
changeset
|
29 ;;; Code: |
c6e12c6b1498
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
22489
diff
changeset
|
30 |
22488 | 31 (eval-when-compile |
32 (require 'cl)) | |
33 | |
34 (require 'gamegrid) | |
35 | |
36 ;; ;;;;;;;;;;;;; customization variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
37 | |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
38 (defvar snake-use-glyphs-flag t |
22488 | 39 "Non-nil means use glyphs when available.") |
40 | |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
41 (defvar snake-use-color-flag t |
22488 | 42 "Non-nil means use color when available.") |
43 | |
44 (defvar snake-buffer-name "*Snake*" | |
45 "Name used for Snake buffer.") | |
46 | |
47 (defvar snake-buffer-width 30 | |
48 "Width of used portion of buffer.") | |
49 | |
50 (defvar snake-buffer-height 22 | |
51 "Height of used portion of buffer.") | |
52 | |
53 (defvar snake-width 30 | |
54 "Width of playing area.") | |
55 | |
56 (defvar snake-height 20 | |
57 "Height of playing area.") | |
58 | |
59 (defvar snake-initial-length 5 | |
60 "Initial length of snake.") | |
61 | |
62 (defvar snake-initial-x 10 | |
63 "Initial X position of snake.") | |
64 | |
65 (defvar snake-initial-y 10 | |
66 "Initial Y position of snake.") | |
67 | |
68 (defvar snake-initial-velocity-x 1 | |
69 "Initial X velocity of snake.") | |
70 | |
71 (defvar snake-initial-velocity-y 0 | |
72 "Initial Y velocity of snake.") | |
73 | |
74 (defvar snake-tick-period 0.2 | |
75 "The default time taken for the snake to advance one square.") | |
76 | |
77 (defvar snake-mode-hook nil | |
78 "Hook run upon starting Snake.") | |
79 | |
80 (defvar snake-score-x 0 | |
81 "X position of score.") | |
82 | |
83 (defvar snake-score-y snake-height | |
84 "Y position of score.") | |
85 | |
43650
93a9551db080
(snake-score-file): Put in home dir, not in /tmp.
Richard M. Stallman <rms@gnu.org>
parents:
43464
diff
changeset
|
86 ;; It is not safe to put this in /tmp. |
43655
1ae60187a39d
fixed parens in the last patch
Sam Steingold <sds@gnu.org>
parents:
43650
diff
changeset
|
87 ;; Someone could make a symlink in /tmp |
43650
93a9551db080
(snake-score-file): Put in home dir, not in /tmp.
Richard M. Stallman <rms@gnu.org>
parents:
43464
diff
changeset
|
88 ;; pointing to a file you don't want to clobber. |
44484
d47ceb68ccc8
(snake-score-file): Default to just "snake-scores".
Colin Walters <walters@gnu.org>
parents:
43655
diff
changeset
|
89 (defvar snake-score-file "snake-scores" |
22488 | 90 "File for holding high scores.") |
91 | |
92 ;; ;;;;;;;;;;;;; display options ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
93 | |
94 (defvar snake-blank-options | |
95 '(((glyph colorize) | |
96 (t ?\040)) | |
97 ((color-x color-x) | |
98 (mono-x grid-x) | |
99 (color-tty color-tty)) | |
100 (((glyph color-x) [0 0 0]) | |
101 (color-tty "black")))) | |
102 | |
103 (defvar snake-snake-options | |
104 '(((glyph colorize) | |
105 (emacs-tty ?O) | |
106 (t ?\040)) | |
107 ((color-x color-x) | |
108 (mono-x mono-x) | |
109 (color-tty color-tty) | |
110 (mono-tty mono-tty)) | |
111 (((glyph color-x) [1 1 0]) | |
112 (color-tty "yellow")))) | |
113 | |
114 (defvar snake-dot-options | |
115 '(((glyph colorize) | |
116 (t ?\*)) | |
117 ((color-x color-x) | |
118 (mono-x grid-x) | |
119 (color-tty color-tty)) | |
120 (((glyph color-x) [1 0 0]) | |
121 (color-tty "red")))) | |
122 | |
123 (defvar snake-border-options | |
124 '(((glyph colorize) | |
125 (t ?\+)) | |
126 ((color-x color-x) | |
47460
2b50b378bb16
(snake-border-options): Use color on tty if available.
Francesco Potortì <pot@gnu.org>
parents:
44484
diff
changeset
|
127 (mono-x grid-x) |
2b50b378bb16
(snake-border-options): Use color on tty if available.
Francesco Potortì <pot@gnu.org>
parents:
44484
diff
changeset
|
128 (color-tty color-tty)) |
22488 | 129 (((glyph color-x) [0.5 0.5 0.5]) |
130 (color-tty "white")))) | |
131 | |
132 (defvar snake-space-options | |
133 '(((t ?\040)) | |
134 nil | |
135 nil)) | |
136 | |
137 ;; ;;;;;;;;;;;;; constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
138 | |
139 (defconst snake-blank 0) | |
140 (defconst snake-snake 1) | |
141 (defconst snake-dot 2) | |
142 (defconst snake-border 3) | |
143 (defconst snake-space 4) | |
144 | |
145 ;; ;;;;;;;;;;;;; variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
146 | |
147 (defvar snake-length 0) | |
148 (defvar snake-velocity-x 1) | |
149 (defvar snake-velocity-y 0) | |
150 (defvar snake-positions nil) | |
151 (defvar snake-cycle 0) | |
152 (defvar snake-score 0) | |
153 (defvar snake-paused nil) | |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
154 (defvar snake-moved-p nil) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
155 (defvar snake-velocity-queue nil |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
156 "This queue stores the velocities requested too quickly by user. |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
157 They will take effect one at a time at each clock-interval. |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
158 This is necessary for proper behavior. |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
159 |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
160 For instance, if you are moving right, you press up and then left, you |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
161 want the snake to move up just once before starting to move left. If |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
162 we implemented all your keystrokes immediately, the snake would |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
163 effectively never move up. Thus, we need to move it up for one turn |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
164 and then start moving it leftwards.") |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
165 |
22488 | 166 |
167 (make-variable-buffer-local 'snake-length) | |
168 (make-variable-buffer-local 'snake-velocity-x) | |
169 (make-variable-buffer-local 'snake-velocity-y) | |
170 (make-variable-buffer-local 'snake-positions) | |
171 (make-variable-buffer-local 'snake-cycle) | |
172 (make-variable-buffer-local 'snake-score) | |
173 (make-variable-buffer-local 'snake-paused) | |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
174 (make-variable-buffer-local 'snake-moved-p) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
175 (make-variable-buffer-local 'snake-velocity-queue) |
22488 | 176 |
177 ;; ;;;;;;;;;;;;; keymaps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
178 | |
179 (defvar snake-mode-map | |
180 (make-sparse-keymap 'snake-mode-map)) | |
181 | |
182 (define-key snake-mode-map "n" 'snake-start-game) | |
183 (define-key snake-mode-map "q" 'snake-end-game) | |
184 (define-key snake-mode-map "p" 'snake-pause-game) | |
185 | |
186 (define-key snake-mode-map [left] 'snake-move-left) | |
187 (define-key snake-mode-map [right] 'snake-move-right) | |
188 (define-key snake-mode-map [up] 'snake-move-up) | |
189 (define-key snake-mode-map [down] 'snake-move-down) | |
190 | |
191 (defvar snake-null-map | |
192 (make-sparse-keymap 'snake-null-map)) | |
193 | |
194 (define-key snake-null-map "n" 'snake-start-game) | |
195 | |
196 ;; ;;;;;;;;;;;;;;;; game functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
197 | |
198 (defun snake-display-options () | |
199 (let ((options (make-vector 256 nil))) | |
200 (loop for c from 0 to 255 do | |
201 (aset options c | |
202 (cond ((= c snake-blank) | |
203 snake-blank-options) | |
204 ((= c snake-snake) | |
205 snake-snake-options) | |
206 ((= c snake-dot) | |
207 snake-dot-options) | |
208 ((= c snake-border) | |
209 snake-border-options) | |
210 ((= c snake-space) | |
211 snake-space-options) | |
212 (t | |
213 '(nil nil nil))))) | |
214 options)) | |
215 | |
216 (defun snake-update-score () | |
217 (let* ((string (format "Score: %05d" snake-score)) | |
218 (len (length string))) | |
219 (loop for x from 0 to (1- len) do | |
220 (gamegrid-set-cell (+ snake-score-x x) | |
221 snake-score-y | |
222 (aref string x))))) | |
223 | |
224 (defun snake-init-buffer () | |
225 (gamegrid-init-buffer snake-buffer-width | |
226 snake-buffer-height | |
227 snake-space) | |
228 (let ((buffer-read-only nil)) | |
229 (loop for y from 0 to (1- snake-height) do | |
230 (loop for x from 0 to (1- snake-width) do | |
231 (gamegrid-set-cell x y snake-border))) | |
232 (loop for y from 1 to (- snake-height 2) do | |
233 (loop for x from 1 to (- snake-width 2) do | |
234 (gamegrid-set-cell x y snake-blank))))) | |
235 | |
236 (defun snake-reset-game () | |
237 (gamegrid-kill-timer) | |
238 (snake-init-buffer) | |
239 (setq snake-length snake-initial-length | |
240 snake-velocity-x snake-initial-velocity-x | |
241 snake-velocity-y snake-initial-velocity-y | |
242 snake-positions nil | |
243 snake-cycle 1 | |
244 snake-score 0 | |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
245 snake-paused nil |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
246 snake-moved-p nil |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
247 snake-velocity-queue nil) |
22488 | 248 (let ((x snake-initial-x) |
249 (y snake-initial-y)) | |
250 (dotimes (i snake-length) | |
251 (gamegrid-set-cell x y snake-snake) | |
252 (setq snake-positions (cons (vector x y) snake-positions)) | |
253 (incf x snake-velocity-x) | |
254 (incf y snake-velocity-y))) | |
255 (snake-update-score)) | |
256 | |
257 (defun snake-update-game (snake-buffer) | |
258 "Called on each clock tick. | |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
259 Advances the snake one square, testing for collision. |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
260 Argument SNAKE-BUFFER is the name of the buffer." |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
261 (when (and (not snake-paused) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
262 (eq (current-buffer) snake-buffer)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
263 (snake-update-velocity) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
264 (let* ((pos (car snake-positions)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
265 (x (+ (aref pos 0) snake-velocity-x)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
266 (y (+ (aref pos 1) snake-velocity-y)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
267 (c (gamegrid-get-cell x y))) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
268 (if (or (= c snake-border) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
269 (= c snake-snake)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
270 (snake-end-game) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
271 (cond ((= c snake-dot) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
272 (incf snake-length) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
273 (incf snake-score) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
274 (snake-update-score)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
275 (t |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
276 (let* ((last-cons (nthcdr (- snake-length 2) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
277 snake-positions)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
278 (tail-pos (cadr last-cons)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
279 (x0 (aref tail-pos 0)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
280 (y0 (aref tail-pos 1))) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
281 (gamegrid-set-cell x0 y0 |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
282 (if (= (% snake-cycle 5) 0) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
283 snake-dot |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
284 snake-blank)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
285 (incf snake-cycle) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
286 (setcdr last-cons nil)))) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
287 (gamegrid-set-cell x y snake-snake) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
288 (setq snake-positions |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
289 (cons (vector x y) snake-positions)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
290 (setq snake-moved-p nil))))) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
291 |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
292 (defun snake-update-velocity () |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
293 (unless snake-moved-p |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
294 (if snake-velocity-queue |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
295 (let ((new-vel (car (last snake-velocity-queue)))) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
296 (setq snake-velocity-x (car new-vel) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
297 snake-velocity-y (cadr new-vel)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
298 (setq snake-velocity-queue |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
299 (nreverse (cdr (nreverse snake-velocity-queue)))))) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
300 (setq snake-moved-p t))) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
301 |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
302 (defun snake-final-x-velocity () |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
303 (or (caar snake-velocity-queue) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
304 snake-velocity-x)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
305 |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
306 (defun snake-final-y-velocity () |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
307 (or (cadr (car snake-velocity-queue)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
308 snake-velocity-y)) |
22488 | 309 |
310 (defun snake-move-left () | |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
311 "Make the snake move left." |
22488 | 312 (interactive) |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
313 (when (zerop (snake-final-x-velocity)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
314 (push '(-1 0) snake-velocity-queue))) |
22488 | 315 |
316 (defun snake-move-right () | |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
317 "Make the snake move right." |
22488 | 318 (interactive) |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
319 (when (zerop (snake-final-x-velocity)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
320 (push '(1 0) snake-velocity-queue))) |
22488 | 321 |
322 (defun snake-move-up () | |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
323 "Make the snake move up." |
22488 | 324 (interactive) |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
325 (when (zerop (snake-final-y-velocity)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
326 (push '(0 -1) snake-velocity-queue))) |
22488 | 327 |
328 (defun snake-move-down () | |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
329 "Make the snake move down." |
22488 | 330 (interactive) |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
331 (when (zerop (snake-final-y-velocity)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
332 (push '(0 1) snake-velocity-queue))) |
22488 | 333 |
334 (defun snake-end-game () | |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
335 "Terminate the current game." |
22488 | 336 (interactive) |
337 (gamegrid-kill-timer) | |
338 (use-local-map snake-null-map) | |
339 (gamegrid-add-score snake-score-file snake-score)) | |
340 | |
341 (defun snake-start-game () | |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
342 "Start a new game of Snake." |
22488 | 343 (interactive) |
344 (snake-reset-game) | |
345 (use-local-map snake-mode-map) | |
346 (gamegrid-start-timer snake-tick-period 'snake-update-game)) | |
347 | |
348 (defun snake-pause-game () | |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
349 "Pause (or resume) the current game." |
22488 | 350 (interactive) |
351 (setq snake-paused (not snake-paused)) | |
352 (message (and snake-paused "Game paused (press p to resume)"))) | |
353 | |
354 (defun snake-active-p () | |
355 (eq (current-local-map) snake-mode-map)) | |
356 | |
357 (put 'snake-mode 'mode-class 'special) | |
358 | |
359 (defun snake-mode () | |
360 "A mode for playing Snake. | |
361 | |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
362 Snake mode keybindings: |
22488 | 363 \\{snake-mode-map} |
364 " | |
365 (kill-all-local-variables) | |
366 | |
367 (add-hook 'kill-buffer-hook 'gamegrid-kill-timer nil t) | |
368 | |
369 (use-local-map snake-null-map) | |
370 | |
371 (setq major-mode 'snake-mode) | |
372 (setq mode-name "Snake") | |
373 | |
64391
1818c2670a66
(snake-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
374 (unless (featurep 'emacs) |
1818c2670a66
(snake-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
375 (setq mode-popup-menu |
1818c2670a66
(snake-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
376 '("Snake Commands" |
1818c2670a66
(snake-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
377 ["Start new game" snake-start-game] |
1818c2670a66
(snake-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
378 ["End game" snake-end-game |
1818c2670a66
(snake-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
379 (snake-active-p)] |
1818c2670a66
(snake-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
380 ["Pause" snake-pause-game |
1818c2670a66
(snake-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
381 (and (snake-active-p) (not snake-paused))] |
1818c2670a66
(snake-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
382 ["Resume" snake-pause-game |
1818c2670a66
(snake-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
383 (and (snake-active-p) snake-paused)]))) |
22488 | 384 |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
385 (setq gamegrid-use-glyphs snake-use-glyphs-flag) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
386 (setq gamegrid-use-color snake-use-color-flag) |
22488 | 387 |
388 (gamegrid-init (snake-display-options)) | |
389 | |
62770 | 390 (run-mode-hooks 'snake-mode-hook)) |
22488 | 391 |
392 ;;;###autoload | |
393 (defun snake () | |
394 "Play the Snake game. | |
395 Move the snake around without colliding with its tail or with the border. | |
396 | |
397 Eating dots causes the snake to get longer. | |
398 | |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
399 Snake mode keybindings: |
22488 | 400 \\<snake-mode-map> |
401 \\[snake-start-game] Starts a new game of Snake | |
402 \\[snake-end-game] Terminates the current game | |
403 \\[snake-pause-game] Pauses (or resumes) the current game | |
404 \\[snake-move-left] Makes the snake move left | |
405 \\[snake-move-right] Makes the snake move right | |
406 \\[snake-move-up] Makes the snake move up | |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
407 \\[snake-move-down] Makes the snake move down" |
22488 | 408 (interactive) |
409 | |
410 (switch-to-buffer snake-buffer-name) | |
411 (gamegrid-kill-timer) | |
412 (snake-mode) | |
413 (snake-start-game)) | |
414 | |
415 (provide 'snake) | |
416 | |
52401 | 417 ;;; arch-tag: 512ffc92-cfac-4287-9a4e-92890701a5c8 |
22488 | 418 ;;; snake.el ends here |