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