1 ;;; snake.el -- Implementation of Snake for Emacs
3 ;; Copyright (C) 1997 Free Software Foundation, Inc.
5 ;; Author: Glynn Clements <glynn@sensei.co.uk>
9 ;; This file is part of GNU Emacs.
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)
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.
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.
33 ;; ;;;;;;;;;;;;; customization variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
35 (defvar snake-use-glyphs t
36 "Non-nil means use glyphs when available.")
38 (defvar snake-use-color t
39 "Non-nil means use color when available.")
41 (defvar snake-buffer-name
"*Snake*"
42 "Name used for Snake buffer.")
44 (defvar snake-buffer-width
30
45 "Width of used portion of buffer.")
47 (defvar snake-buffer-height
22
48 "Height of used portion of buffer.")
50 (defvar snake-width
30
51 "Width of playing area.")
53 (defvar snake-height
20
54 "Height of playing area.")
56 (defvar snake-initial-length
5
57 "Initial length of snake.")
59 (defvar snake-initial-x
10
60 "Initial X position of snake.")
62 (defvar snake-initial-y
10
63 "Initial Y position of snake.")
65 (defvar snake-initial-velocity-x
1
66 "Initial X velocity of snake.")
68 (defvar snake-initial-velocity-y
0
69 "Initial Y velocity of snake.")
71 (defvar snake-tick-period
0.2
72 "The default time taken for the snake to advance one square.")
74 (defvar snake-mode-hook nil
75 "Hook run upon starting Snake.")
77 (defvar snake-score-x
0
78 "X position of score.")
80 (defvar snake-score-y snake-height
81 "Y position of score.")
83 (defvar snake-score-file
"/tmp/snake-scores"
84 "File for holding high scores.")
86 ;; ;;;;;;;;;;;;; display options ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
88 (defvar snake-blank-options
93 (color-tty color-tty
))
94 (((glyph color-x
) [0 0 0])
95 (color-tty "black"))))
97 (defvar snake-snake-options
103 (color-tty color-tty
)
105 (((glyph color-x
) [1 1 0])
106 (color-tty "yellow"))))
108 (defvar snake-dot-options
113 (color-tty color-tty
))
114 (((glyph color-x
) [1 0 0])
117 (defvar snake-border-options
122 (((glyph color-x
) [0.5 0.5 0.5])
123 (color-tty "white"))))
125 (defvar snake-space-options
130 ;; ;;;;;;;;;;;;; constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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)
138 ;; ;;;;;;;;;;;;; variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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
)
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
)
156 ;; ;;;;;;;;;;;;; keymaps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
158 (defvar snake-mode-map
159 (make-sparse-keymap 'snake-mode-map
))
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
)
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)
170 (defvar snake-null-map
171 (make-sparse-keymap 'snake-null-map))
173 (define-key snake-null-map "n" 'snake-start-game)
175 ;; ;;;;;;;;;;;;;;;; game functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
177 (defun snake-display-options ()
178 (let ((options (make-vector 256 nil)))
179 (loop for c from 0 to 255 do
181 (cond ((= c snake-blank)
188 snake-border-options)
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)
203 (defun snake-init-buffer ()
204 (gamegrid-init-buffer snake-buffer-width
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)))))
215 (defun snake-reset-game ()
216 (gamegrid-kill-timer)
218 (setq snake-length snake-initial-length
219 snake-velocity-x snake-initial-velocity-x
220 snake-velocity-y snake-initial-velocity-y
225 (let ((x snake-initial-x)
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))
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)
246 (cond ((= c snake-dot)
249 (snake-update-score))
251 (let* ((last-cons (nthcdr (- snake-length 2)
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)
261 (setcdr last-cons nil))))
262 (gamegrid-set-cell x y snake-snake)
263 (setq snake-positions
264 (cons (vector x y) snake-positions))))))
266 (defun snake-move-left ()
267 "Makes the snake move left"
269 (unless (= snake-velocity-x 1)
270 (setq snake-velocity-x -1
271 snake-velocity-y 0)))
273 (defun snake-move-right ()
274 "Makes the snake move right"
276 (unless (= snake-velocity-x -1)
277 (setq snake-velocity-x 1
278 snake-velocity-y 0)))
280 (defun snake-move-up ()
281 "Makes the snake move up"
283 (unless (= snake-velocity-y 1)
284 (setq snake-velocity-x 0
285 snake-velocity-y -1)))
287 (defun snake-move-down ()
288 "Makes the snake move down"
290 (unless (= snake-velocity-y -1)
291 (setq snake-velocity-x 0
292 snake-velocity-y 1)))
294 (defun snake-end-game ()
295 "Terminates the current game"
297 (gamegrid-kill-timer)
298 (use-local-map snake-null-map)
299 (gamegrid-add-score snake-score-file snake-score))
301 (defun snake-start-game ()
302 "Starts a new game of Snake"
305 (use-local-map snake-mode-map)
306 (gamegrid-start-timer snake-tick-period 'snake-update-game))
308 (defun snake-pause-game ()
309 "Pauses (or resumes) the current game"
311 (setq snake-paused (not snake-paused))
312 (message (and snake-paused "Game paused (press p to resume)")))
314 (defun snake-active-p ()
315 (eq (current-local-map) snake-mode-map))
317 (put 'snake-mode 'mode-class 'special)
320 "A mode for playing Snake.
322 snake-mode keybindings:
325 (kill-all-local-variables)
327 (make-local-hook 'kill-buffer-hook)
328 (add-hook 'kill-buffer-hook 'gamegrid-kill-timer nil t)
330 (use-local-map snake-null-map)
332 (setq major-mode 'snake-mode)
333 (setq mode-name "Snake")
335 (setq mode-popup-menu
337 ["Start new game" snake-start-game]
338 ["End game" snake-end-game
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)]))
345 (setq gamegrid-use-glyphs snake-use-glyphs)
346 (setq gamegrid-use-color snake-use-color)
348 (gamegrid-init (snake-display-options))
350 (run-hooks 'snake-mode-hook))
354 "Play the Snake game.
355 Move the snake around without colliding with its tail or with the border.
357 Eating dots causes the snake to get longer.
359 snake-mode keybindings:
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
372 (switch-to-buffer snake-buffer-name)
373 (gamegrid-kill-timer)
379 ;;; snake.el ends here