[bpt/emacs.git] / lisp / play / snake.el

;;; snake.el --- implementation of Snake for Emacs

;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005,
;;   2006, 2007, 2008 Free Software Foundation, Inc.

;; Author: Glynn Clements <glynn@sensei.co.uk>
;; Created: 1997-09-10
;; Keywords: games

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;;; Code:

(eval-when-compile
  (require 'cl))

(require 'gamegrid)

;; ;;;;;;;;;;;;; customization variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar snake-use-glyphs-flag t
  "Non-nil means use glyphs when available.")

(defvar snake-use-color-flag t
  "Non-nil means use color when available.")

(defvar snake-buffer-name "*Snake*"
  "Name used for Snake buffer.")

(defvar snake-buffer-width 30
  "Width of used portion of buffer.")

(defvar snake-buffer-height 22
  "Height of used portion of buffer.")

(defvar snake-width 30
  "Width of playing area.")

(defvar snake-height 20
  "Height of playing area.")

(defvar snake-initial-length 5
  "Initial length of snake.")

(defvar snake-initial-x 10
  "Initial X position of snake.")

(defvar snake-initial-y 10
  "Initial Y position of snake.")

(defvar snake-initial-velocity-x 1
  "Initial X velocity of snake.")

(defvar snake-initial-velocity-y 0
  "Initial Y velocity of snake.")

(defvar snake-tick-period 0.2
  "The default time taken for the snake to advance one square.")

(defvar snake-mode-hook nil
  "Hook run upon starting Snake.")

(defvar snake-score-x 0
  "X position of score.")

(defvar snake-score-y snake-height
  "Y position of score.")

;; It is not safe to put this in /tmp.
;; Someone could make a symlink in /tmp
;; pointing to a file you don't want to clobber.
(defvar snake-score-file "snake-scores"
  "File for holding high scores.")

;; ;;;;;;;;;;;;; display options ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar snake-blank-options
  '(((glyph colorize)
     (t ?\040))
    ((color-x color-x)
     (mono-x grid-x)
     (color-tty color-tty))
    (((glyph color-x) [0 0 0])
     (color-tty "black"))))

(defvar snake-snake-options
  '(((glyph colorize)
     (emacs-tty ?O)
     (t ?\040))
    ((color-x color-x)
     (mono-x mono-x)
     (color-tty color-tty)
     (mono-tty mono-tty))
    (((glyph color-x) [1 1 0])
     (color-tty "yellow"))))

(defvar snake-dot-options
  '(((glyph colorize)
     (t ?\*))
    ((color-x color-x)
     (mono-x grid-x)
     (color-tty color-tty))
    (((glyph color-x) [1 0 0])
     (color-tty "red"))))

(defvar snake-border-options
  '(((glyph colorize)
     (t ?\+))
    ((color-x color-x)
     (mono-x grid-x)
     (color-tty color-tty))
    (((glyph color-x) [0.5 0.5 0.5])
     (color-tty "white"))))

(defvar snake-space-options
  '(((t ?\040))
    nil
    nil))

;; ;;;;;;;;;;;;; constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defconst snake-blank	0)
(defconst snake-snake	1)
(defconst snake-dot	2)
(defconst snake-border	3)
(defconst snake-space	4)

;; ;;;;;;;;;;;;; variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar snake-length 0)
(defvar snake-velocity-x 1)
(defvar snake-velocity-y 0)
(defvar snake-positions nil)
(defvar snake-cycle 0)
(defvar snake-score 0)
(defvar snake-paused nil)
(defvar snake-moved-p nil)
(defvar snake-velocity-queue nil
  "This queue stores the velocities requested too quickly by user.
They will take effect one at a time at each clock-interval.
This is necessary for proper behavior.

For instance, if you are moving right, you press up and then left, you
want the snake to move up just once before starting to move left.  If
we implemented all your keystrokes immediately, the snake would
effectively never move up.  Thus, we need to move it up for one turn
and then start moving it leftwards.")


(make-variable-buffer-local 'snake-length)
(make-variable-buffer-local 'snake-velocity-x)
(make-variable-buffer-local 'snake-velocity-y)
(make-variable-buffer-local 'snake-positions)
(make-variable-buffer-local 'snake-cycle)
(make-variable-buffer-local 'snake-score)
(make-variable-buffer-local 'snake-paused)
(make-variable-buffer-local 'snake-moved-p)
(make-variable-buffer-local 'snake-velocity-queue)

;; ;;;;;;;;;;;;; keymaps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar snake-mode-map
  (make-sparse-keymap 'snake-mode-map))

(define-key snake-mode-map "n"		'snake-start-game)
(define-key snake-mode-map "q"		'snake-end-game)
(define-key snake-mode-map "p"		'snake-pause-game)

(define-key snake-mode-map [left]	'snake-move-left)
(define-key snake-mode-map [right]	'snake-move-right)
(define-key snake-mode-map [up]		'snake-move-up)
(define-key snake-mode-map [down]	'snake-move-down)

(defvar snake-null-map
  (make-sparse-keymap 'snake-null-map))

(define-key snake-null-map "n"		'snake-start-game)

;; ;;;;;;;;;;;;;;;; game functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun snake-display-options ()
  (let ((options (make-vector 256 nil)))
    (loop for c from 0 to 255 do
      (aset options c
	    (cond ((= c snake-blank)
		   snake-blank-options)
                  ((= c snake-snake)
		   snake-snake-options)
                  ((= c snake-dot)
		   snake-dot-options)
                  ((= c snake-border)
		   snake-border-options)
                  ((= c snake-space)
		   snake-space-options)
                  (t
		   '(nil nil nil)))))
    options))

(defun snake-update-score ()
  (let* ((string (format "Score:  %05d" snake-score))
	 (len (length string)))
    (loop for x from 0 to (1- len) do
      (gamegrid-set-cell (+ snake-score-x x)
			 snake-score-y
			 (aref string x)))))

(defun snake-init-buffer ()
  (gamegrid-init-buffer snake-buffer-width
			snake-buffer-height
			snake-space)
  (let ((buffer-read-only nil))
    (loop for y from 0 to (1- snake-height) do
	  (loop for x from 0 to (1- snake-width) do
		(gamegrid-set-cell x y snake-border)))
    (loop for y from 1 to (- snake-height 2) do
	  (loop for x from 1 to (- snake-width 2) do
		(gamegrid-set-cell x y snake-blank)))))

(defun snake-reset-game ()
  (gamegrid-kill-timer)
  (snake-init-buffer)
  (setq snake-length		snake-initial-length
	snake-velocity-x	snake-initial-velocity-x
	snake-velocity-y	snake-initial-velocity-y
	snake-positions		nil
	snake-cycle		1
	snake-score		0
	snake-paused		nil
	snake-moved-p           nil
	snake-velocity-queue    nil)
  (let ((x snake-initial-x)
	(y snake-initial-y))
    (dotimes (i snake-length)
      (gamegrid-set-cell x y snake-snake)
      (setq snake-positions (cons (vector x y) snake-positions))
      (incf x snake-velocity-x)
      (incf y snake-velocity-y)))
  (snake-update-score))

(defun snake-update-game (snake-buffer)
  "Called on each clock tick.
Advances the snake one square, testing for collision.
Argument SNAKE-BUFFER is the name of the buffer."
  (when (and (not snake-paused)
	     (eq (current-buffer) snake-buffer))
    (snake-update-velocity)
    (let* ((pos (car snake-positions))
	   (x (+ (aref pos 0) snake-velocity-x))
	   (y (+ (aref pos 1) snake-velocity-y))
	   (c (gamegrid-get-cell x y)))
      (if (or (= c snake-border)
	      (= c snake-snake))
	  (snake-end-game)
	(cond ((= c snake-dot)
	       (incf snake-length)
	       (incf snake-score)
	       (snake-update-score))
	      (t
	       (let* ((last-cons (nthcdr (- snake-length 2)
					 snake-positions))
		      (tail-pos (cadr last-cons))
		      (x0 (aref tail-pos 0))
		      (y0 (aref tail-pos 1)))
		 (gamegrid-set-cell x0 y0
				    (if (= (% snake-cycle 5) 0)
					snake-dot
				      snake-blank))
		 (incf snake-cycle)
		 (setcdr last-cons nil))))
	(gamegrid-set-cell x y snake-snake)
	(setq snake-positions
	      (cons (vector x y) snake-positions))
	  (setq snake-moved-p nil)))))

(defun snake-update-velocity ()
  (unless snake-moved-p
    (if snake-velocity-queue
	(let ((new-vel (car (last snake-velocity-queue))))
	  (setq snake-velocity-x (car new-vel)
		snake-velocity-y (cadr new-vel))
	  (setq snake-velocity-queue
		(nreverse (cdr (nreverse snake-velocity-queue))))))
    (setq snake-moved-p t)))

(defun snake-final-x-velocity ()
  (or (caar snake-velocity-queue)
      snake-velocity-x))

(defun snake-final-y-velocity ()
  (or (cadr (car snake-velocity-queue))
      snake-velocity-y))

(defun snake-move-left ()
  "Make the snake move left."
  (interactive)
  (when (zerop (snake-final-x-velocity))
    (push '(-1 0) snake-velocity-queue)))

(defun snake-move-right ()
  "Make the snake move right."
  (interactive)
  (when (zerop (snake-final-x-velocity))
    (push '(1 0) snake-velocity-queue)))

(defun snake-move-up ()
  "Make the snake move up."
  (interactive)
  (when (zerop (snake-final-y-velocity))
    (push '(0 -1) snake-velocity-queue)))

(defun snake-move-down ()
  "Make the snake move down."
  (interactive)
  (when (zerop (snake-final-y-velocity))
    (push '(0 1) snake-velocity-queue)))

(defun snake-end-game ()
  "Terminate the current game."
  (interactive)
  (gamegrid-kill-timer)
  (use-local-map snake-null-map)
  (gamegrid-add-score snake-score-file snake-score))

(defun snake-start-game ()
  "Start a new game of Snake."
  (interactive)
  (snake-reset-game)
  (use-local-map snake-mode-map)
  (gamegrid-start-timer snake-tick-period 'snake-update-game))

(defun snake-pause-game ()
  "Pause (or resume) the current game."
  (interactive)
  (setq snake-paused (not snake-paused))
  (message (and snake-paused "Game paused (press p to resume)")))

(defun snake-active-p ()
  (eq (current-local-map) snake-mode-map))

(put 'snake-mode 'mode-class 'special)

(defun snake-mode ()
  "A mode for playing Snake.

Snake mode keybindings:
   \\{snake-mode-map}
"
  (kill-all-local-variables)

  (add-hook 'kill-buffer-hook 'gamegrid-kill-timer nil t)

  (use-local-map snake-null-map)

  (setq major-mode 'snake-mode)
  (setq mode-name "Snake")

  (unless (featurep 'emacs)
    (setq mode-popup-menu
	  '("Snake Commands"
	    ["Start new game"	snake-start-game]
	    ["End game"		snake-end-game
	     (snake-active-p)]
	    ["Pause"		snake-pause-game
	     (and (snake-active-p) (not snake-paused))]
	    ["Resume"		snake-pause-game
	     (and (snake-active-p) snake-paused)])))

  (setq gamegrid-use-glyphs snake-use-glyphs-flag)
  (setq gamegrid-use-color snake-use-color-flag)

  (gamegrid-init (snake-display-options))

  (run-mode-hooks 'snake-mode-hook))

;;;###autoload
(defun snake ()
  "Play the Snake game.
Move the snake around without colliding with its tail or with the border.

Eating dots causes the snake to get longer.

Snake mode keybindings:
   \\<snake-mode-map>
\\[snake-start-game]	Starts a new game of Snake
\\[snake-end-game]	Terminates the current game
\\[snake-pause-game]	Pauses (or resumes) the current game
\\[snake-move-left]	Makes the snake move left
\\[snake-move-right]	Makes the snake move right
\\[snake-move-up]	Makes the snake move up
\\[snake-move-down]	Makes the snake move down"
  (interactive)

  (switch-to-buffer snake-buffer-name)
  (gamegrid-kill-timer)
  (snake-mode)
  (snake-start-game))

(provide 'snake)

;; arch-tag: 512ffc92-cfac-4287-9a4e-92890701a5c8
;;; snake.el ends here
Commit	Line	Data
6e44da43	1	;;; snake.el --- implementation of Snake for Emacs
0bbf74a8	2
f2e3589a	3	;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005,
2f043267	4	;; 2006, 2007, 2008 Free Software Foundation, Inc.
0bbf74a8 RS	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
5a9dffec	14	;; the Free Software Foundation; either version 3, or (at your option)
0bbf74a8 RS	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
3a35cf56 LK	24	;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
3a35cf56 LK	25	;; Boston, MA 02110-1301, USA.
0bbf74a8 RS	26
	27	;;; Commentary:
	28
6e44da43 PJ	29	;;; Code:
6e44da43 PJ	30
0bbf74a8 RS	31	(eval-when-compile
	32	(require 'cl))
	33
	34	(require 'gamegrid)
	35
	36	;; ;;;;;;;;;;;;; customization variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	37
5bcfaa07	38	(defvar snake-use-glyphs-flag t
0bbf74a8 RS	39	"Non-nil means use glyphs when available.")
0bbf74a8 RS	40
5bcfaa07	41	(defvar snake-use-color-flag t
0bbf74a8 RS	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
35ce93eb	86	;; It is not safe to put this in /tmp.
adcce7d5	87	;; Someone could make a symlink in /tmp
35ce93eb	88	;; pointing to a file you don't want to clobber.
e6eb4750	89	(defvar snake-score-file "snake-scores"
0bbf74a8 RS	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)
c2f8b57c FP	127	(mono-x grid-x)
c2f8b57c FP	128	(color-tty color-tty))
0bbf74a8 RS	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)
5bcfaa07 RS	154	(defvar snake-moved-p nil)
	155	(defvar snake-velocity-queue nil
	156	"This queue stores the velocities requested too quickly by user.
	157	They will take effect one at a time at each clock-interval.
	158	This is necessary for proper behavior.
	159
	160	For instance, if you are moving right, you press up and then left, you
	161	want the snake to move up just once before starting to move left. If
	162	we implemented all your keystrokes immediately, the snake would
	163	effectively never move up. Thus, we need to move it up for one turn
	164	and then start moving it leftwards.")
	165
0bbf74a8 RS	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)
5bcfaa07 RS	174	(make-variable-buffer-local 'snake-moved-p)
5bcfaa07 RS	175	(make-variable-buffer-local 'snake-velocity-queue)
0bbf74a8 RS	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
5bcfaa07 RS	245	snake-paused nil
	246	snake-moved-p nil
	247	snake-velocity-queue nil)
0bbf74a8 RS	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.
5bcfaa07 RS	259	Advances the snake one square, testing for collision.
	260	Argument 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))
0bbf74a8 RS	309
0bbf74a8 RS	310	(defun snake-move-left ()
5bcfaa07	311	"Make the snake move left."
0bbf74a8	312	(interactive)
5bcfaa07 RS	313	(when (zerop (snake-final-x-velocity))
5bcfaa07 RS	314	(push '(-1 0) snake-velocity-queue)))
0bbf74a8 RS	315
0bbf74a8 RS	316	(defun snake-move-right ()
5bcfaa07	317	"Make the snake move right."
0bbf74a8	318	(interactive)
5bcfaa07 RS	319	(when (zerop (snake-final-x-velocity))
5bcfaa07 RS	320	(push '(1 0) snake-velocity-queue)))
0bbf74a8 RS	321
0bbf74a8 RS	322	(defun snake-move-up ()
5bcfaa07	323	"Make the snake move up."
0bbf74a8	324	(interactive)
5bcfaa07 RS	325	(when (zerop (snake-final-y-velocity))
5bcfaa07 RS	326	(push '(0 -1) snake-velocity-queue)))
0bbf74a8 RS	327
0bbf74a8 RS	328	(defun snake-move-down ()
5bcfaa07	329	"Make the snake move down."
0bbf74a8	330	(interactive)
5bcfaa07 RS	331	(when (zerop (snake-final-y-velocity))
5bcfaa07 RS	332	(push '(0 1) snake-velocity-queue)))
0bbf74a8 RS	333
0bbf74a8 RS	334	(defun snake-end-game ()
5bcfaa07	335	"Terminate the current game."
0bbf74a8 RS	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 ()
5bcfaa07	342	"Start a new game of Snake."
0bbf74a8 RS	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 ()
5bcfaa07	349	"Pause (or resume) the current game."
0bbf74a8 RS	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
5bcfaa07	362	Snake mode keybindings:
0bbf74a8 RS	363	\\{snake-mode-map}
	364	"
	365	(kill-all-local-variables)
	366
0bbf74a8 RS	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
2f4fbe7a RS	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)])))
0bbf74a8	384
5bcfaa07 RS	385	(setq gamegrid-use-glyphs snake-use-glyphs-flag)
5bcfaa07 RS	386	(setq gamegrid-use-color snake-use-color-flag)
0bbf74a8 RS	387
	388	(gamegrid-init (snake-display-options))
	389
c83c9654	390	(run-mode-hooks 'snake-mode-hook))
0bbf74a8 RS	391
	392	;;;###autoload
	393	(defun snake ()
	394	"Play the Snake game.
	395	Move the snake around without colliding with its tail or with the border.
	396
	397	Eating dots causes the snake to get longer.
	398
5bcfaa07	399	Snake mode keybindings:
0bbf74a8 RS	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
5bcfaa07	407	\\[snake-move-down] Makes the snake move down"
0bbf74a8 RS	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
cbee283d	417	;; arch-tag: 512ffc92-cfac-4287-9a4e-92890701a5c8
0bbf74a8	418	;;; snake.el ends here