Commit | Line | Data |
---|---|---|
6e44da43 | 1 | ;;; snake.el --- implementation of Snake for Emacs |
0bbf74a8 | 2 | |
ba318903 | 3 | ;; Copyright (C) 1997, 2001-2014 Free Software Foundation, Inc. |
0bbf74a8 RS |
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 | ||
b1fc2b50 | 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
0bbf74a8 | 12 | ;; it under the terms of the GNU General Public License as published by |
b1fc2b50 GM |
13 | ;; the Free Software Foundation, either version 3 of the License, or |
14 | ;; (at your option) any later version. | |
0bbf74a8 RS |
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 | |
b1fc2b50 | 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
0bbf74a8 RS |
23 | |
24 | ;;; Commentary: | |
25 | ||
6e44da43 PJ |
26 | ;;; Code: |
27 | ||
a464a6c7 | 28 | (eval-when-compile (require 'cl-lib)) |
0bbf74a8 RS |
29 | |
30 | (require 'gamegrid) | |
31 | ||
32 | ;; ;;;;;;;;;;;;; customization variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
33 | ||
5bcfaa07 | 34 | (defvar snake-use-glyphs-flag t |
0bbf74a8 RS |
35 | "Non-nil means use glyphs when available.") |
36 | ||
5bcfaa07 | 37 | (defvar snake-use-color-flag t |
0bbf74a8 RS |
38 | "Non-nil means use color when available.") |
39 | ||
40 | (defvar snake-buffer-name "*Snake*" | |
41 | "Name used for Snake buffer.") | |
42 | ||
43 | (defvar snake-buffer-width 30 | |
44 | "Width of used portion of buffer.") | |
45 | ||
46 | (defvar snake-buffer-height 22 | |
47 | "Height of used portion of buffer.") | |
48 | ||
49 | (defvar snake-width 30 | |
50 | "Width of playing area.") | |
51 | ||
52 | (defvar snake-height 20 | |
53 | "Height of playing area.") | |
54 | ||
55 | (defvar snake-initial-length 5 | |
56 | "Initial length of snake.") | |
57 | ||
58 | (defvar snake-initial-x 10 | |
59 | "Initial X position of snake.") | |
60 | ||
61 | (defvar snake-initial-y 10 | |
62 | "Initial Y position of snake.") | |
63 | ||
64 | (defvar snake-initial-velocity-x 1 | |
65 | "Initial X velocity of snake.") | |
66 | ||
67 | (defvar snake-initial-velocity-y 0 | |
68 | "Initial Y velocity of snake.") | |
69 | ||
70 | (defvar snake-tick-period 0.2 | |
71 | "The default time taken for the snake to advance one square.") | |
72 | ||
73 | (defvar snake-mode-hook nil | |
74 | "Hook run upon starting Snake.") | |
75 | ||
76 | (defvar snake-score-x 0 | |
77 | "X position of score.") | |
78 | ||
79 | (defvar snake-score-y snake-height | |
80 | "Y position of score.") | |
81 | ||
35ce93eb | 82 | ;; It is not safe to put this in /tmp. |
adcce7d5 | 83 | ;; Someone could make a symlink in /tmp |
35ce93eb | 84 | ;; pointing to a file you don't want to clobber. |
e6eb4750 | 85 | (defvar snake-score-file "snake-scores" |
0bbf74a8 RS |
86 | "File for holding high scores.") |
87 | ||
88 | ;; ;;;;;;;;;;;;; display options ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
89 | ||
90 | (defvar snake-blank-options | |
91 | '(((glyph colorize) | |
92 | (t ?\040)) | |
93 | ((color-x color-x) | |
94 | (mono-x grid-x) | |
95 | (color-tty color-tty)) | |
96 | (((glyph color-x) [0 0 0]) | |
97 | (color-tty "black")))) | |
98 | ||
99 | (defvar snake-snake-options | |
100 | '(((glyph colorize) | |
101 | (emacs-tty ?O) | |
102 | (t ?\040)) | |
103 | ((color-x color-x) | |
104 | (mono-x mono-x) | |
105 | (color-tty color-tty) | |
106 | (mono-tty mono-tty)) | |
107 | (((glyph color-x) [1 1 0]) | |
108 | (color-tty "yellow")))) | |
109 | ||
110 | (defvar snake-dot-options | |
111 | '(((glyph colorize) | |
112 | (t ?\*)) | |
113 | ((color-x color-x) | |
114 | (mono-x grid-x) | |
115 | (color-tty color-tty)) | |
116 | (((glyph color-x) [1 0 0]) | |
117 | (color-tty "red")))) | |
118 | ||
119 | (defvar snake-border-options | |
120 | '(((glyph colorize) | |
121 | (t ?\+)) | |
122 | ((color-x color-x) | |
c2f8b57c FP |
123 | (mono-x grid-x) |
124 | (color-tty color-tty)) | |
0bbf74a8 RS |
125 | (((glyph color-x) [0.5 0.5 0.5]) |
126 | (color-tty "white")))) | |
127 | ||
128 | (defvar snake-space-options | |
129 | '(((t ?\040)) | |
130 | nil | |
131 | nil)) | |
132 | ||
133 | ;; ;;;;;;;;;;;;; constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
134 | ||
135 | (defconst snake-blank 0) | |
136 | (defconst snake-snake 1) | |
137 | (defconst snake-dot 2) | |
138 | (defconst snake-border 3) | |
139 | (defconst snake-space 4) | |
140 | ||
141 | ;; ;;;;;;;;;;;;; variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
142 | ||
143 | (defvar snake-length 0) | |
144 | (defvar snake-velocity-x 1) | |
145 | (defvar snake-velocity-y 0) | |
146 | (defvar snake-positions nil) | |
147 | (defvar snake-cycle 0) | |
148 | (defvar snake-score 0) | |
149 | (defvar snake-paused nil) | |
5bcfaa07 RS |
150 | (defvar snake-moved-p nil) |
151 | (defvar snake-velocity-queue nil | |
152 | "This queue stores the velocities requested too quickly by user. | |
153 | They will take effect one at a time at each clock-interval. | |
154 | This is necessary for proper behavior. | |
155 | ||
156 | For instance, if you are moving right, you press up and then left, you | |
157 | want the snake to move up just once before starting to move left. If | |
158 | we implemented all your keystrokes immediately, the snake would | |
159 | effectively never move up. Thus, we need to move it up for one turn | |
160 | and then start moving it leftwards.") | |
161 | ||
0bbf74a8 RS |
162 | |
163 | (make-variable-buffer-local 'snake-length) | |
164 | (make-variable-buffer-local 'snake-velocity-x) | |
165 | (make-variable-buffer-local 'snake-velocity-y) | |
166 | (make-variable-buffer-local 'snake-positions) | |
167 | (make-variable-buffer-local 'snake-cycle) | |
168 | (make-variable-buffer-local 'snake-score) | |
169 | (make-variable-buffer-local 'snake-paused) | |
5bcfaa07 RS |
170 | (make-variable-buffer-local 'snake-moved-p) |
171 | (make-variable-buffer-local 'snake-velocity-queue) | |
0bbf74a8 RS |
172 | |
173 | ;; ;;;;;;;;;;;;; keymaps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
174 | ||
175 | (defvar snake-mode-map | |
b016851c | 176 | (let ((map (make-sparse-keymap 'snake-mode-map))) |
0bbf74a8 | 177 | |
b016851c SM |
178 | (define-key map "n" 'snake-start-game) |
179 | (define-key map "q" 'snake-end-game) | |
180 | (define-key map "p" 'snake-pause-game) | |
0bbf74a8 | 181 | |
b016851c SM |
182 | (define-key map [left] 'snake-move-left) |
183 | (define-key map [right] 'snake-move-right) | |
184 | (define-key map [up] 'snake-move-up) | |
185 | (define-key map [down] 'snake-move-down) | |
186 | map)) | |
0bbf74a8 RS |
187 | |
188 | (defvar snake-null-map | |
b016851c SM |
189 | (let ((map (make-sparse-keymap 'snake-null-map))) |
190 | (define-key map "n" 'snake-start-game) | |
191 | map)) | |
0bbf74a8 RS |
192 | |
193 | ;; ;;;;;;;;;;;;;;;; game functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
194 | ||
195 | (defun snake-display-options () | |
196 | (let ((options (make-vector 256 nil))) | |
a464a6c7 | 197 | (dotimes (c 256) |
0bbf74a8 RS |
198 | (aset options c |
199 | (cond ((= c snake-blank) | |
200 | snake-blank-options) | |
201 | ((= c snake-snake) | |
202 | snake-snake-options) | |
203 | ((= c snake-dot) | |
204 | snake-dot-options) | |
205 | ((= c snake-border) | |
206 | snake-border-options) | |
207 | ((= c snake-space) | |
208 | snake-space-options) | |
209 | (t | |
210 | '(nil nil nil))))) | |
211 | options)) | |
212 | ||
213 | (defun snake-update-score () | |
214 | (let* ((string (format "Score: %05d" snake-score)) | |
215 | (len (length string))) | |
a464a6c7 | 216 | (dotimes (x len) |
0bbf74a8 RS |
217 | (gamegrid-set-cell (+ snake-score-x x) |
218 | snake-score-y | |
219 | (aref string x))))) | |
220 | ||
221 | (defun snake-init-buffer () | |
222 | (gamegrid-init-buffer snake-buffer-width | |
223 | snake-buffer-height | |
224 | snake-space) | |
225 | (let ((buffer-read-only nil)) | |
a464a6c7 SM |
226 | (dotimes (y snake-height) |
227 | (dotimes (x snake-width) | |
228 | (gamegrid-set-cell x y snake-border))) | |
229 | (cl-loop for y from 1 to (- snake-height 2) do | |
230 | (cl-loop for x from 1 to (- snake-width 2) do | |
231 | (gamegrid-set-cell x y snake-blank))))) | |
0bbf74a8 RS |
232 | |
233 | (defun snake-reset-game () | |
234 | (gamegrid-kill-timer) | |
235 | (snake-init-buffer) | |
236 | (setq snake-length snake-initial-length | |
237 | snake-velocity-x snake-initial-velocity-x | |
238 | snake-velocity-y snake-initial-velocity-y | |
239 | snake-positions nil | |
240 | snake-cycle 1 | |
241 | snake-score 0 | |
5bcfaa07 RS |
242 | snake-paused nil |
243 | snake-moved-p nil | |
244 | snake-velocity-queue nil) | |
0bbf74a8 RS |
245 | (let ((x snake-initial-x) |
246 | (y snake-initial-y)) | |
247 | (dotimes (i snake-length) | |
248 | (gamegrid-set-cell x y snake-snake) | |
249 | (setq snake-positions (cons (vector x y) snake-positions)) | |
a464a6c7 SM |
250 | (cl-incf x snake-velocity-x) |
251 | (cl-incf y snake-velocity-y))) | |
0bbf74a8 RS |
252 | (snake-update-score)) |
253 | ||
254 | (defun snake-update-game (snake-buffer) | |
255 | "Called on each clock tick. | |
5bcfaa07 RS |
256 | Advances the snake one square, testing for collision. |
257 | Argument SNAKE-BUFFER is the name of the buffer." | |
258 | (when (and (not snake-paused) | |
259 | (eq (current-buffer) snake-buffer)) | |
260 | (snake-update-velocity) | |
261 | (let* ((pos (car snake-positions)) | |
262 | (x (+ (aref pos 0) snake-velocity-x)) | |
263 | (y (+ (aref pos 1) snake-velocity-y)) | |
264 | (c (gamegrid-get-cell x y))) | |
265 | (if (or (= c snake-border) | |
266 | (= c snake-snake)) | |
267 | (snake-end-game) | |
268 | (cond ((= c snake-dot) | |
a464a6c7 SM |
269 | (cl-incf snake-length) |
270 | (cl-incf snake-score) | |
5bcfaa07 RS |
271 | (snake-update-score)) |
272 | (t | |
273 | (let* ((last-cons (nthcdr (- snake-length 2) | |
274 | snake-positions)) | |
275 | (tail-pos (cadr last-cons)) | |
276 | (x0 (aref tail-pos 0)) | |
277 | (y0 (aref tail-pos 1))) | |
278 | (gamegrid-set-cell x0 y0 | |
279 | (if (= (% snake-cycle 5) 0) | |
280 | snake-dot | |
281 | snake-blank)) | |
a464a6c7 | 282 | (cl-incf snake-cycle) |
5bcfaa07 RS |
283 | (setcdr last-cons nil)))) |
284 | (gamegrid-set-cell x y snake-snake) | |
285 | (setq snake-positions | |
286 | (cons (vector x y) snake-positions)) | |
287 | (setq snake-moved-p nil))))) | |
288 | ||
289 | (defun snake-update-velocity () | |
290 | (unless snake-moved-p | |
291 | (if snake-velocity-queue | |
292 | (let ((new-vel (car (last snake-velocity-queue)))) | |
293 | (setq snake-velocity-x (car new-vel) | |
294 | snake-velocity-y (cadr new-vel)) | |
295 | (setq snake-velocity-queue | |
296 | (nreverse (cdr (nreverse snake-velocity-queue)))))) | |
297 | (setq snake-moved-p t))) | |
298 | ||
299 | (defun snake-final-x-velocity () | |
300 | (or (caar snake-velocity-queue) | |
301 | snake-velocity-x)) | |
302 | ||
303 | (defun snake-final-y-velocity () | |
304 | (or (cadr (car snake-velocity-queue)) | |
305 | snake-velocity-y)) | |
0bbf74a8 RS |
306 | |
307 | (defun snake-move-left () | |
5bcfaa07 | 308 | "Make the snake move left." |
0bbf74a8 | 309 | (interactive) |
5bcfaa07 RS |
310 | (when (zerop (snake-final-x-velocity)) |
311 | (push '(-1 0) snake-velocity-queue))) | |
0bbf74a8 RS |
312 | |
313 | (defun snake-move-right () | |
5bcfaa07 | 314 | "Make the snake move right." |
0bbf74a8 | 315 | (interactive) |
5bcfaa07 RS |
316 | (when (zerop (snake-final-x-velocity)) |
317 | (push '(1 0) snake-velocity-queue))) | |
0bbf74a8 RS |
318 | |
319 | (defun snake-move-up () | |
5bcfaa07 | 320 | "Make the snake move up." |
0bbf74a8 | 321 | (interactive) |
5bcfaa07 RS |
322 | (when (zerop (snake-final-y-velocity)) |
323 | (push '(0 -1) snake-velocity-queue))) | |
0bbf74a8 RS |
324 | |
325 | (defun snake-move-down () | |
5bcfaa07 | 326 | "Make the snake move down." |
0bbf74a8 | 327 | (interactive) |
5bcfaa07 RS |
328 | (when (zerop (snake-final-y-velocity)) |
329 | (push '(0 1) snake-velocity-queue))) | |
0bbf74a8 RS |
330 | |
331 | (defun snake-end-game () | |
5bcfaa07 | 332 | "Terminate the current game." |
0bbf74a8 RS |
333 | (interactive) |
334 | (gamegrid-kill-timer) | |
335 | (use-local-map snake-null-map) | |
336 | (gamegrid-add-score snake-score-file snake-score)) | |
337 | ||
338 | (defun snake-start-game () | |
5bcfaa07 | 339 | "Start a new game of Snake." |
0bbf74a8 RS |
340 | (interactive) |
341 | (snake-reset-game) | |
342 | (use-local-map snake-mode-map) | |
343 | (gamegrid-start-timer snake-tick-period 'snake-update-game)) | |
344 | ||
345 | (defun snake-pause-game () | |
5bcfaa07 | 346 | "Pause (or resume) the current game." |
0bbf74a8 RS |
347 | (interactive) |
348 | (setq snake-paused (not snake-paused)) | |
349 | (message (and snake-paused "Game paused (press p to resume)"))) | |
350 | ||
351 | (defun snake-active-p () | |
352 | (eq (current-local-map) snake-mode-map)) | |
353 | ||
354 | (put 'snake-mode 'mode-class 'special) | |
355 | ||
1b3b87df SM |
356 | (define-derived-mode snake-mode special-mode "Snake" |
357 | "A mode for playing Snake." | |
0bbf74a8 | 358 | |
0bbf74a8 RS |
359 | (add-hook 'kill-buffer-hook 'gamegrid-kill-timer nil t) |
360 | ||
361 | (use-local-map snake-null-map) | |
362 | ||
2f4fbe7a RS |
363 | (unless (featurep 'emacs) |
364 | (setq mode-popup-menu | |
365 | '("Snake Commands" | |
366 | ["Start new game" snake-start-game] | |
367 | ["End game" snake-end-game | |
368 | (snake-active-p)] | |
369 | ["Pause" snake-pause-game | |
370 | (and (snake-active-p) (not snake-paused))] | |
371 | ["Resume" snake-pause-game | |
372 | (and (snake-active-p) snake-paused)]))) | |
0bbf74a8 | 373 | |
5bcfaa07 RS |
374 | (setq gamegrid-use-glyphs snake-use-glyphs-flag) |
375 | (setq gamegrid-use-color snake-use-color-flag) | |
0bbf74a8 | 376 | |
1b3b87df | 377 | (gamegrid-init (snake-display-options))) |
0bbf74a8 RS |
378 | |
379 | ;;;###autoload | |
380 | (defun snake () | |
381 | "Play the Snake game. | |
382 | Move the snake around without colliding with its tail or with the border. | |
383 | ||
384 | Eating dots causes the snake to get longer. | |
385 | ||
5bcfaa07 | 386 | Snake mode keybindings: |
0bbf74a8 RS |
387 | \\<snake-mode-map> |
388 | \\[snake-start-game] Starts a new game of Snake | |
389 | \\[snake-end-game] Terminates the current game | |
390 | \\[snake-pause-game] Pauses (or resumes) the current game | |
391 | \\[snake-move-left] Makes the snake move left | |
392 | \\[snake-move-right] Makes the snake move right | |
393 | \\[snake-move-up] Makes the snake move up | |
5bcfaa07 | 394 | \\[snake-move-down] Makes the snake move down" |
0bbf74a8 RS |
395 | (interactive) |
396 | ||
397 | (switch-to-buffer snake-buffer-name) | |
398 | (gamegrid-kill-timer) | |
399 | (snake-mode) | |
400 | (snake-start-game)) | |
401 | ||
402 | (provide 'snake) | |
403 | ||
404 | ;;; snake.el ends here |