Mercurial > emacs
annotate lisp/play/snake.el @ 96905:43f0edb65a25
(Fns_selection_exists_p, Fns_selection_owner_p)
(Fx_get_selection_internal, Fns_rotate_cut_buffers_internal)
(Fns_own_selection_internal, Fx_disown_selection_internal)
(Fns_get_cut_buffer_internal, Fns_store_cut_buffer_internal):
Change to use 'doc: /* ... */' style of docstrings. Doc fixes.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Tue, 22 Jul 2008 19:25:08 +0000 |
parents | 949bd6ad1ba4 |
children | a9dc0e7c3f2b |
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 |
74509 | 3 ;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005, |
79716 | 4 ;; 2006, 2007, 2008 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 | |
94675
949bd6ad1ba4
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
12 ;; GNU Emacs is free software: you can redistribute it and/or modify |
22488 | 13 ;; it under the terms of the GNU General Public License as published by |
94675
949bd6ad1ba4
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
14 ;; the Free Software Foundation, either version 3 of the License, or |
949bd6ad1ba4
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
15 ;; (at your option) any later version. |
22488 | 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 | |
94675
949bd6ad1ba4
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
22488 | 24 |
25 ;;; Commentary: | |
26 | |
38425
c6e12c6b1498
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
22489
diff
changeset
|
27 ;;; Code: |
c6e12c6b1498
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
22489
diff
changeset
|
28 |
22488 | 29 (eval-when-compile |
30 (require 'cl)) | |
31 | |
32 (require 'gamegrid) | |
33 | |
34 ;; ;;;;;;;;;;;;; customization variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
35 | |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
36 (defvar snake-use-glyphs-flag t |
22488 | 37 "Non-nil means use glyphs when available.") |
38 | |
43464
dc17128932c4
(snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents:
41485
diff
changeset
|
39 (defvar snake-use-color-flag t |
22488 | 40 "Non-nil means use color when available.") |
41 | |
42 (defvar snake-buffer-name "*Snake*" | |
43 "Name used for Snake buffer.") | |
44 | |
45 (defvar snake-buffer-width 30 | |
46 "Width of used portion of buffer.") | |
47 | |
48 (defvar snake-buffer-height 22 | |
49 "Height of used portion of buffer.") | |
50 | |
51 (defvar snake-width 30 | |
52 "Width of playing area.") | |
53 | |
54 (defvar snake-height 20 | |
55 "Height of playing area.") | |
56 | |
57 (defvar snake-initial-length 5 | |
58 "Initial length of snake.") | |
59 | |
60 (defvar snake-initial-x 10 | |
61 "Initial X position of snake.") | |
62 | |
63 (defvar snake-initial-y 10 | |
64 "Initial Y position of snake.") | |
65 | |
66 (defvar snake-initial-velocity-x 1 | |
67 "Initial X velocity of snake.") | |
68 | |
69 (defvar snake-initial-velocity-y 0 | |
70 "Initial Y velocity of snake.") | |
71 | |
72 (defvar snake-tick-period 0.2 | |
73 "The default time taken for the snake to advance one square.") | |
74 | |
75 (defvar snake-mode-hook nil | |
76 "Hook run upon starting Snake.") | |
77 | |
78 (defvar snake-score-x 0 | |
79 "X position of score.") | |
80 | |
81 (defvar snake-score-y snake-height | |
82 "Y position of score.") | |
83 | |
43650
93a9551db080
(snake-score-file): Put in home dir, not in /tmp.
Richard M. Stallman <rms@gnu.org>
parents:
43464
diff
changeset
|
84 ;; 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
|
85 ;; 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
|
86 ;; 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
|
87 (defvar snake-score-file "snake-scores" |
22488 | 88 "File for holding high scores.") |
89 | |
90 ;; ;;;;;;;;;;;;; display options ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
91 | |
92 (defvar snake-blank-options | |
93 '(((glyph colorize) | |
94 (t ?\040)) | |
95 ((color-x color-x) | |
96 (mono-x grid-x) | |
97 (color-tty color-tty)) | |
98 (((glyph color-x) [0 0 0]) | |
99 (color-tty "black")))) | |
100 | |
101 (defvar snake-snake-options | |
102 '(((glyph colorize) | |
103 (emacs-tty ?O) | |
104 (t ?\040)) | |
105 ((color-x color-x) | |
106 (mono-x mono-x) | |
107 (color-tty color-tty) | |
108 (mono-tty mono-tty)) | |
109 (((glyph color-x) [1 1 0]) | |
110 (color-tty "yellow")))) | |
111 | |
112 (defvar snake-dot-options | |
113 '(((glyph colorize) | |
114 (t ?\*)) | |
115 ((color-x color-x) | |
116 (mono-x grid-x) | |
117 (color-tty color-tty)) | |
118 (((glyph color-x) [1 0 0]) | |
119 (color-tty "red")))) | |
120 | |
121 (defvar snake-border-options | |
122 '(((glyph colorize) | |
123 (t ?\+)) | |
124 ((color-x color-x) | |
47460
2b50b378bb16
(snake-border-options): Use color on tty if available.
Francesco Potortì <pot@gnu.org>
parents:
44484
diff
changeset
|
125 (mono-x grid-x) |
2b50b378bb16
(snake-border-options): Use color on tty if available.
Francesco Potortì <pot@gnu.org>
parents:
44484
diff
changeset
|
126 (color-tty color-tty)) |
22488 | 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 | |
64391
1818c2670a66
(snake-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
372 (unless (featurep 'emacs) |
1818c2670a66
(snake-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
373 (setq mode-popup-menu |
1818c2670a66
(snake-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
374 '("Snake Commands" |
1818c2670a66
(snake-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
375 ["Start new game" snake-start-game] |
1818c2670a66
(snake-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
376 ["End game" snake-end-game |
1818c2670a66
(snake-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
377 (snake-active-p)] |
1818c2670a66
(snake-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
378 ["Pause" snake-pause-game |
1818c2670a66
(snake-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
379 (and (snake-active-p) (not snake-paused))] |
1818c2670a66
(snake-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
380 ["Resume" snake-pause-game |
1818c2670a66
(snake-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents:
64085
diff
changeset
|
381 (and (snake-active-p) snake-paused)]))) |
22488 | 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 | |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
79716
diff
changeset
|
415 ;; arch-tag: 512ffc92-cfac-4287-9a4e-92890701a5c8 |
22488 | 416 ;;; snake.el ends here |