Commit | Line | Data |
---|---|---|
6b6dee47 | 1 | ;;; snake.el -- Implementation of Snake for Emacs |
0bbf74a8 RS |
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 | ||
28 | (eval-when-compile | |
29 | (require 'cl)) | |
30 | ||
31 | (require 'gamegrid) | |
32 | ||
33 | ;; ;;;;;;;;;;;;; customization variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
34 | ||
35 | (defvar snake-use-glyphs t | |
36 | "Non-nil means use glyphs when available.") | |
37 | ||
38 | (defvar snake-use-color t | |
39 | "Non-nil means use color when available.") | |
40 | ||
41 | (defvar snake-buffer-name "*Snake*" | |
42 | "Name used for Snake buffer.") | |
43 | ||
44 | (defvar snake-buffer-width 30 | |
45 | "Width of used portion of buffer.") | |
46 | ||
47 | (defvar snake-buffer-height 22 | |
48 | "Height of used portion of buffer.") | |
49 | ||
50 | (defvar snake-width 30 | |
51 | "Width of playing area.") | |
52 | ||
53 | (defvar snake-height 20 | |
54 | "Height of playing area.") | |
55 | ||
56 | (defvar snake-initial-length 5 | |
57 | "Initial length of snake.") | |
58 | ||
59 | (defvar snake-initial-x 10 | |
60 | "Initial X position of snake.") | |
61 | ||
62 | (defvar snake-initial-y 10 | |
63 | "Initial Y position of snake.") | |
64 | ||
65 | (defvar snake-initial-velocity-x 1 | |
66 | "Initial X velocity of snake.") | |
67 | ||
68 | (defvar snake-initial-velocity-y 0 | |
69 | "Initial Y velocity of snake.") | |
70 | ||
71 | (defvar snake-tick-period 0.2 | |
72 | "The default time taken for the snake to advance one square.") | |
73 | ||
74 | (defvar snake-mode-hook nil | |
75 | "Hook run upon starting Snake.") | |
76 | ||
77 | (defvar snake-score-x 0 | |
78 | "X position of score.") | |
79 | ||
80 | (defvar snake-score-y snake-height | |
81 | "Y position of score.") | |
82 | ||
83 | (defvar snake-score-file "/tmp/snake-scores" | |
84 | "File for holding high scores.") | |
85 | ||
86 | ;; ;;;;;;;;;;;;; display options ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
87 | ||
88 | (defvar snake-blank-options | |
89 | '(((glyph colorize) | |
90 | (t ?\040)) | |
91 | ((color-x color-x) | |
92 | (mono-x grid-x) | |
93 | (color-tty color-tty)) | |
94 | (((glyph color-x) [0 0 0]) | |
95 | (color-tty "black")))) | |
96 | ||
97 | (defvar snake-snake-options | |
98 | '(((glyph colorize) | |
99 | (emacs-tty ?O) | |
100 | (t ?\040)) | |
101 | ((color-x color-x) | |
102 | (mono-x mono-x) | |
103 | (color-tty color-tty) | |
104 | (mono-tty mono-tty)) | |
105 | (((glyph color-x) [1 1 0]) | |
106 | (color-tty "yellow")))) | |
107 | ||
108 | (defvar snake-dot-options | |
109 | '(((glyph colorize) | |
110 | (t ?\*)) | |
111 | ((color-x color-x) | |
112 | (mono-x grid-x) | |
113 | (color-tty color-tty)) | |
114 | (((glyph color-x) [1 0 0]) | |
115 | (color-tty "red")))) | |
116 | ||
117 | (defvar snake-border-options | |
118 | '(((glyph colorize) | |
119 | (t ?\+)) | |
120 | ((color-x color-x) | |
121 | (mono-x grid-x)) | |
122 | (((glyph color-x) [0.5 0.5 0.5]) | |
123 | (color-tty "white")))) | |
124 | ||
125 | (defvar snake-space-options | |
126 | '(((t ?\040)) | |
127 | nil | |
128 | nil)) | |
129 | ||
130 | ;; ;;;;;;;;;;;;; constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
131 | ||
132 | (defconst snake-blank 0) | |
133 | (defconst snake-snake 1) | |
134 | (defconst snake-dot 2) | |
135 | (defconst snake-border 3) | |
136 | (defconst snake-space 4) | |
137 | ||
138 | ;; ;;;;;;;;;;;;; variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
139 | ||
140 | (defvar snake-length 0) | |
141 | (defvar snake-velocity-x 1) | |
142 | (defvar snake-velocity-y 0) | |
143 | (defvar snake-positions nil) | |
144 | (defvar snake-cycle 0) | |
145 | (defvar snake-score 0) | |
146 | (defvar snake-paused nil) | |
147 | ||
148 | (make-variable-buffer-local 'snake-length) | |
149 | (make-variable-buffer-local 'snake-velocity-x) | |
150 | (make-variable-buffer-local 'snake-velocity-y) | |
151 | (make-variable-buffer-local 'snake-positions) | |
152 | (make-variable-buffer-local 'snake-cycle) | |
153 | (make-variable-buffer-local 'snake-score) | |
154 | (make-variable-buffer-local 'snake-paused) | |
155 | ||
156 | ;; ;;;;;;;;;;;;; keymaps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
157 | ||
158 | (defvar snake-mode-map | |
159 | (make-sparse-keymap 'snake-mode-map)) | |
160 | ||
161 | (define-key snake-mode-map "n" 'snake-start-game) | |
162 | (define-key snake-mode-map "q" 'snake-end-game) | |
163 | (define-key snake-mode-map "p" 'snake-pause-game) | |
164 | ||
165 | (define-key snake-mode-map [left] 'snake-move-left) | |
166 | (define-key snake-mode-map [right] 'snake-move-right) | |
167 | (define-key snake-mode-map [up] 'snake-move-up) | |
168 | (define-key snake-mode-map [down] 'snake-move-down) | |
169 | ||
170 | (defvar snake-null-map | |
171 | (make-sparse-keymap 'snake-null-map)) | |
172 | ||
173 | (define-key snake-null-map "n" 'snake-start-game) | |
174 | ||
175 | ;; ;;;;;;;;;;;;;;;; game functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
176 | ||
177 | (defun snake-display-options () | |
178 | (let ((options (make-vector 256 nil))) | |
179 | (loop for c from 0 to 255 do | |
180 | (aset options c | |
181 | (cond ((= c snake-blank) | |
182 | snake-blank-options) | |
183 | ((= c snake-snake) | |
184 | snake-snake-options) | |
185 | ((= c snake-dot) | |
186 | snake-dot-options) | |
187 | ((= c snake-border) | |
188 | snake-border-options) | |
189 | ((= c snake-space) | |
190 | snake-space-options) | |
191 | (t | |
192 | '(nil nil nil))))) | |
193 | options)) | |
194 | ||
195 | (defun snake-update-score () | |
196 | (let* ((string (format "Score: %05d" snake-score)) | |
197 | (len (length string))) | |
198 | (loop for x from 0 to (1- len) do | |
199 | (gamegrid-set-cell (+ snake-score-x x) | |
200 | snake-score-y | |
201 | (aref string x))))) | |
202 | ||
203 | (defun snake-init-buffer () | |
204 | (gamegrid-init-buffer snake-buffer-width | |
205 | snake-buffer-height | |
206 | snake-space) | |
207 | (let ((buffer-read-only nil)) | |
208 | (loop for y from 0 to (1- snake-height) do | |
209 | (loop for x from 0 to (1- snake-width) do | |
210 | (gamegrid-set-cell x y snake-border))) | |
211 | (loop for y from 1 to (- snake-height 2) do | |
212 | (loop for x from 1 to (- snake-width 2) do | |
213 | (gamegrid-set-cell x y snake-blank))))) | |
214 | ||
215 | (defun snake-reset-game () | |
216 | (gamegrid-kill-timer) | |
217 | (snake-init-buffer) | |
218 | (setq snake-length snake-initial-length | |
219 | snake-velocity-x snake-initial-velocity-x | |
220 | snake-velocity-y snake-initial-velocity-y | |
221 | snake-positions nil | |
222 | snake-cycle 1 | |
223 | snake-score 0 | |
224 | snake-paused nil) | |
225 | (let ((x snake-initial-x) | |
226 | (y snake-initial-y)) | |
227 | (dotimes (i snake-length) | |
228 | (gamegrid-set-cell x y snake-snake) | |
229 | (setq snake-positions (cons (vector x y) snake-positions)) | |
230 | (incf x snake-velocity-x) | |
231 | (incf y snake-velocity-y))) | |
232 | (snake-update-score)) | |
233 | ||
234 | (defun snake-update-game (snake-buffer) | |
235 | "Called on each clock tick. | |
236 | Advances the snake one square, testing for collision." | |
237 | (if (and (not snake-paused) | |
238 | (eq (current-buffer) snake-buffer)) | |
239 | (let* ((pos (car snake-positions)) | |
240 | (x (+ (aref pos 0) snake-velocity-x)) | |
241 | (y (+ (aref pos 1) snake-velocity-y)) | |
242 | (c (gamegrid-get-cell x y))) | |
243 | (if (or (= c snake-border) | |
244 | (= c snake-snake)) | |
245 | (snake-end-game) | |
246 | (cond ((= c snake-dot) | |
247 | (incf snake-length) | |
248 | (incf snake-score) | |
249 | (snake-update-score)) | |
250 | (t | |
251 | (let* ((last-cons (nthcdr (- snake-length 2) | |
252 | snake-positions)) | |
253 | (tail-pos (cadr last-cons)) | |
254 | (x0 (aref tail-pos 0)) | |
255 | (y0 (aref tail-pos 1))) | |
256 | (gamegrid-set-cell x0 y0 | |
257 | (if (= (% snake-cycle 5) 0) | |
258 | snake-dot | |
259 | snake-blank)) | |
260 | (incf snake-cycle) | |
261 | (setcdr last-cons nil)))) | |
262 | (gamegrid-set-cell x y snake-snake) | |
263 | (setq snake-positions | |
264 | (cons (vector x y) snake-positions)))))) | |
265 | ||
266 | (defun snake-move-left () | |
267 | "Makes the snake move left" | |
268 | (interactive) | |
269 | (unless (= snake-velocity-x 1) | |
270 | (setq snake-velocity-x -1 | |
271 | snake-velocity-y 0))) | |
272 | ||
273 | (defun snake-move-right () | |
274 | "Makes the snake move right" | |
275 | (interactive) | |
276 | (unless (= snake-velocity-x -1) | |
277 | (setq snake-velocity-x 1 | |
278 | snake-velocity-y 0))) | |
279 | ||
280 | (defun snake-move-up () | |
281 | "Makes the snake move up" | |
282 | (interactive) | |
283 | (unless (= snake-velocity-y 1) | |
284 | (setq snake-velocity-x 0 | |
285 | snake-velocity-y -1))) | |
286 | ||
287 | (defun snake-move-down () | |
288 | "Makes the snake move down" | |
289 | (interactive) | |
290 | (unless (= snake-velocity-y -1) | |
291 | (setq snake-velocity-x 0 | |
292 | snake-velocity-y 1))) | |
293 | ||
294 | (defun snake-end-game () | |
295 | "Terminates the current game" | |
296 | (interactive) | |
297 | (gamegrid-kill-timer) | |
298 | (use-local-map snake-null-map) | |
299 | (gamegrid-add-score snake-score-file snake-score)) | |
300 | ||
301 | (defun snake-start-game () | |
302 | "Starts a new game of Snake" | |
303 | (interactive) | |
304 | (snake-reset-game) | |
305 | (use-local-map snake-mode-map) | |
306 | (gamegrid-start-timer snake-tick-period 'snake-update-game)) | |
307 | ||
308 | (defun snake-pause-game () | |
309 | "Pauses (or resumes) the current game" | |
310 | (interactive) | |
311 | (setq snake-paused (not snake-paused)) | |
312 | (message (and snake-paused "Game paused (press p to resume)"))) | |
313 | ||
314 | (defun snake-active-p () | |
315 | (eq (current-local-map) snake-mode-map)) | |
316 | ||
317 | (put 'snake-mode 'mode-class 'special) | |
318 | ||
319 | (defun snake-mode () | |
320 | "A mode for playing Snake. | |
321 | ||
322 | snake-mode keybindings: | |
323 | \\{snake-mode-map} | |
324 | " | |
325 | (kill-all-local-variables) | |
326 | ||
327 | (make-local-hook 'kill-buffer-hook) | |
328 | (add-hook 'kill-buffer-hook 'gamegrid-kill-timer nil t) | |
329 | ||
330 | (use-local-map snake-null-map) | |
331 | ||
332 | (setq major-mode 'snake-mode) | |
333 | (setq mode-name "Snake") | |
334 | ||
335 | (setq mode-popup-menu | |
336 | '("Snake Commands" | |
337 | ["Start new game" snake-start-game] | |
338 | ["End game" snake-end-game | |
339 | (snake-active-p)] | |
340 | ["Pause" snake-pause-game | |
341 | (and (snake-active-p) (not snake-paused))] | |
342 | ["Resume" snake-pause-game | |
343 | (and (snake-active-p) snake-paused)])) | |
344 | ||
345 | (setq gamegrid-use-glyphs snake-use-glyphs) | |
346 | (setq gamegrid-use-color snake-use-color) | |
347 | ||
348 | (gamegrid-init (snake-display-options)) | |
349 | ||
350 | (run-hooks 'snake-mode-hook)) | |
351 | ||
352 | ;;;###autoload | |
353 | (defun snake () | |
354 | "Play the Snake game. | |
355 | Move the snake around without colliding with its tail or with the border. | |
356 | ||
357 | Eating dots causes the snake to get longer. | |
358 | ||
359 | snake-mode keybindings: | |
360 | \\<snake-mode-map> | |
361 | \\[snake-start-game] Starts a new game of Snake | |
362 | \\[snake-end-game] Terminates the current game | |
363 | \\[snake-pause-game] Pauses (or resumes) the current game | |
364 | \\[snake-move-left] Makes the snake move left | |
365 | \\[snake-move-right] Makes the snake move right | |
366 | \\[snake-move-up] Makes the snake move up | |
367 | \\[snake-move-down] Makes the snake move down | |
368 | ||
369 | " | |
370 | (interactive) | |
371 | ||
372 | (switch-to-buffer snake-buffer-name) | |
373 | (gamegrid-kill-timer) | |
374 | (snake-mode) | |
375 | (snake-start-game)) | |
376 | ||
377 | (provide 'snake) | |
378 | ||
379 | ;;; snake.el ends here |