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