Mercurial > emacs
annotate lisp/play/snake.el @ 46677:86e8d59e2e49
*** empty log message ***
author | Dave Love <fx@gnu.org> |
---|---|
date | Wed, 24 Jul 2002 23:01:32 +0000 |
parents | d47ceb68ccc8 |
children | 2b50b378bb16 |
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 |
3 ;; Copyright (C) 1997 Free Software Foundation, Inc. | |
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) | |
126 (mono-x grid-x)) | |
127 (((glyph color-x) [0.5 0.5 0.5]) | |
128 (color-tty "white")))) | |
129 | |
130 (defvar snake-space-options | |
131 '(((t ?\040)) | |
132 nil | |
133 nil)) | |
134 | |
135 ;; ;;;;;;;;;;;;; constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
136 | |
137 (defconst snake-blank 0) | |
138 (defconst snake-snake 1) | |
139 (defconst snake-dot 2) | |
140 (defconst snake-border 3) | |
141 (defconst snake-space 4) | |
142 | |
143 ;; ;;;;;;;;;;;;; variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
144 | |
145 (defvar snake-length 0) | |
146 (defvar snake-velocity-x 1) | |
147 (defvar snake-velocity-y 0) | |
148 (defvar snake-positions nil) | |
149 (defvar snake-cycle 0) | |
150 (defvar snake-score 0) | |
151 (defvar snake-paused nil) | |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
152 (defvar snake-moved-p nil) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
153 (defvar snake-velocity-queue nil |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
154 "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
|
155 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
|
156 This is necessary for proper behavior. |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
157 |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
158 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
|
159 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
|
160 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
|
161 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
|
162 and then start moving it leftwards.") |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
163 |
22488 | 164 |
165 (make-variable-buffer-local 'snake-length) | |
166 (make-variable-buffer-local 'snake-velocity-x) | |
167 (make-variable-buffer-local 'snake-velocity-y) | |
168 (make-variable-buffer-local 'snake-positions) | |
169 (make-variable-buffer-local 'snake-cycle) | |
170 (make-variable-buffer-local 'snake-score) | |
171 (make-variable-buffer-local 'snake-paused) | |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
172 (make-variable-buffer-local 'snake-moved-p) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
173 (make-variable-buffer-local 'snake-velocity-queue) |
22488 | 174 |
175 ;; ;;;;;;;;;;;;; keymaps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
176 | |
177 (defvar snake-mode-map | |
178 (make-sparse-keymap 'snake-mode-map)) | |
179 | |
180 (define-key snake-mode-map "n" 'snake-start-game) | |
181 (define-key snake-mode-map "q" 'snake-end-game) | |
182 (define-key snake-mode-map "p" 'snake-pause-game) | |
183 | |
184 (define-key snake-mode-map [left] 'snake-move-left) | |
185 (define-key snake-mode-map [right] 'snake-move-right) | |
186 (define-key snake-mode-map [up] 'snake-move-up) | |
187 (define-key snake-mode-map [down] 'snake-move-down) | |
188 | |
189 (defvar snake-null-map | |
190 (make-sparse-keymap 'snake-null-map)) | |
191 | |
192 (define-key snake-null-map "n" 'snake-start-game) | |
193 | |
194 ;; ;;;;;;;;;;;;;;;; game functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
195 | |
196 (defun snake-display-options () | |
197 (let ((options (make-vector 256 nil))) | |
198 (loop for c from 0 to 255 do | |
199 (aset options c | |
200 (cond ((= c snake-blank) | |
201 snake-blank-options) | |
202 ((= c snake-snake) | |
203 snake-snake-options) | |
204 ((= c snake-dot) | |
205 snake-dot-options) | |
206 ((= c snake-border) | |
207 snake-border-options) | |
208 ((= c snake-space) | |
209 snake-space-options) | |
210 (t | |
211 '(nil nil nil))))) | |
212 options)) | |
213 | |
214 (defun snake-update-score () | |
215 (let* ((string (format "Score: %05d" snake-score)) | |
216 (len (length string))) | |
217 (loop for x from 0 to (1- len) do | |
218 (gamegrid-set-cell (+ snake-score-x x) | |
219 snake-score-y | |
220 (aref string x))))) | |
221 | |
222 (defun snake-init-buffer () | |
223 (gamegrid-init-buffer snake-buffer-width | |
224 snake-buffer-height | |
225 snake-space) | |
226 (let ((buffer-read-only nil)) | |
227 (loop for y from 0 to (1- snake-height) do | |
228 (loop for x from 0 to (1- snake-width) do | |
229 (gamegrid-set-cell x y snake-border))) | |
230 (loop for y from 1 to (- snake-height 2) do | |
231 (loop for x from 1 to (- snake-width 2) do | |
232 (gamegrid-set-cell x y snake-blank))))) | |
233 | |
234 (defun snake-reset-game () | |
235 (gamegrid-kill-timer) | |
236 (snake-init-buffer) | |
237 (setq snake-length snake-initial-length | |
238 snake-velocity-x snake-initial-velocity-x | |
239 snake-velocity-y snake-initial-velocity-y | |
240 snake-positions nil | |
241 snake-cycle 1 | |
242 snake-score 0 | |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
243 snake-paused nil |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
244 snake-moved-p nil |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
245 snake-velocity-queue nil) |
22488 | 246 (let ((x snake-initial-x) |
247 (y snake-initial-y)) | |
248 (dotimes (i snake-length) | |
249 (gamegrid-set-cell x y snake-snake) | |
250 (setq snake-positions (cons (vector x y) snake-positions)) | |
251 (incf x snake-velocity-x) | |
252 (incf y snake-velocity-y))) | |
253 (snake-update-score)) | |
254 | |
255 (defun snake-update-game (snake-buffer) | |
256 "Called on each clock tick. | |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
257 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
|
258 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
|
259 (when (and (not snake-paused) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
260 (eq (current-buffer) snake-buffer)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
261 (snake-update-velocity) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
262 (let* ((pos (car snake-positions)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
263 (x (+ (aref pos 0) snake-velocity-x)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
264 (y (+ (aref pos 1) snake-velocity-y)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
265 (c (gamegrid-get-cell x y))) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
266 (if (or (= c snake-border) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
267 (= c snake-snake)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
268 (snake-end-game) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
269 (cond ((= c snake-dot) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
270 (incf snake-length) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
271 (incf snake-score) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
272 (snake-update-score)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
273 (t |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
274 (let* ((last-cons (nthcdr (- snake-length 2) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
275 snake-positions)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
276 (tail-pos (cadr last-cons)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
277 (x0 (aref tail-pos 0)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
278 (y0 (aref tail-pos 1))) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
279 (gamegrid-set-cell x0 y0 |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
280 (if (= (% snake-cycle 5) 0) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
281 snake-dot |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
282 snake-blank)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
283 (incf snake-cycle) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
284 (setcdr last-cons nil)))) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
285 (gamegrid-set-cell x y snake-snake) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
286 (setq snake-positions |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
287 (cons (vector x y) snake-positions)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
288 (setq snake-moved-p nil))))) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
289 |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
290 (defun snake-update-velocity () |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
291 (unless snake-moved-p |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
292 (if snake-velocity-queue |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
293 (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
|
294 (setq snake-velocity-x (car new-vel) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
295 snake-velocity-y (cadr new-vel)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
296 (setq snake-velocity-queue |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
297 (nreverse (cdr (nreverse snake-velocity-queue)))))) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
298 (setq snake-moved-p t))) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
299 |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
300 (defun snake-final-x-velocity () |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
301 (or (caar snake-velocity-queue) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
302 snake-velocity-x)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
303 |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
304 (defun snake-final-y-velocity () |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
305 (or (cadr (car snake-velocity-queue)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
306 snake-velocity-y)) |
22488 | 307 |
308 (defun snake-move-left () | |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
309 "Make the snake move left." |
22488 | 310 (interactive) |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
311 (when (zerop (snake-final-x-velocity)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
312 (push '(-1 0) snake-velocity-queue))) |
22488 | 313 |
314 (defun snake-move-right () | |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
315 "Make the snake move right." |
22488 | 316 (interactive) |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
317 (when (zerop (snake-final-x-velocity)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
318 (push '(1 0) snake-velocity-queue))) |
22488 | 319 |
320 (defun snake-move-up () | |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
321 "Make the snake move up." |
22488 | 322 (interactive) |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
323 (when (zerop (snake-final-y-velocity)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
324 (push '(0 -1) snake-velocity-queue))) |
22488 | 325 |
326 (defun snake-move-down () | |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
327 "Make the snake move down." |
22488 | 328 (interactive) |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
329 (when (zerop (snake-final-y-velocity)) |
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
330 (push '(0 1) snake-velocity-queue))) |
22488 | 331 |
332 (defun snake-end-game () | |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
333 "Terminate the current game." |
22488 | 334 (interactive) |
335 (gamegrid-kill-timer) | |
336 (use-local-map snake-null-map) | |
337 (gamegrid-add-score snake-score-file snake-score)) | |
338 | |
339 (defun snake-start-game () | |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
340 "Start a new game of Snake." |
22488 | 341 (interactive) |
342 (snake-reset-game) | |
343 (use-local-map snake-mode-map) | |
344 (gamegrid-start-timer snake-tick-period 'snake-update-game)) | |
345 | |
346 (defun snake-pause-game () | |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
347 "Pause (or resume) the current game." |
22488 | 348 (interactive) |
349 (setq snake-paused (not snake-paused)) | |
350 (message (and snake-paused "Game paused (press p to resume)"))) | |
351 | |
352 (defun snake-active-p () | |
353 (eq (current-local-map) snake-mode-map)) | |
354 | |
355 (put 'snake-mode 'mode-class 'special) | |
356 | |
357 (defun snake-mode () | |
358 "A mode for playing Snake. | |
359 | |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
360 Snake mode keybindings: |
22488 | 361 \\{snake-mode-map} |
362 " | |
363 (kill-all-local-variables) | |
364 | |
365 (add-hook 'kill-buffer-hook 'gamegrid-kill-timer nil t) | |
366 | |
367 (use-local-map snake-null-map) | |
368 | |
369 (setq major-mode 'snake-mode) | |
370 (setq mode-name "Snake") | |
371 | |
372 (setq mode-popup-menu | |
373 '("Snake Commands" | |
374 ["Start new game" snake-start-game] | |
375 ["End game" snake-end-game | |
376 (snake-active-p)] | |
377 ["Pause" snake-pause-game | |
378 (and (snake-active-p) (not snake-paused))] | |
379 ["Resume" snake-pause-game | |
380 (and (snake-active-p) snake-paused)])) | |
381 | |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
382 (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
|
383 (setq gamegrid-use-color snake-use-color-flag) |
22488 | 384 |
385 (gamegrid-init (snake-display-options)) | |
386 | |
387 (run-hooks 'snake-mode-hook)) | |
388 | |
389 ;;;###autoload | |
390 (defun snake () | |
391 "Play the Snake game. | |
392 Move the snake around without colliding with its tail or with the border. | |
393 | |
394 Eating dots causes the snake to get longer. | |
395 | |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
396 Snake mode keybindings: |
22488 | 397 \\<snake-mode-map> |
398 \\[snake-start-game] Starts a new game of Snake | |
399 \\[snake-end-game] Terminates the current game | |
400 \\[snake-pause-game] Pauses (or resumes) the current game | |
401 \\[snake-move-left] Makes the snake move left | |
402 \\[snake-move-right] Makes the snake move right | |
403 \\[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
|
404 \\[snake-move-down] Makes the snake move down" |
22488 | 405 (interactive) |
406 | |
407 (switch-to-buffer snake-buffer-name) | |
408 (gamegrid-kill-timer) | |
409 (snake-mode) | |
410 (snake-start-game)) | |
411 | |
412 (provide 'snake) | |
413 | |
414 ;;; snake.el ends here |