* src/xdisp.c (select_frame_for_redisplay, ensure_selected_frame): Remove.
[emacs.git] / lisp / play / snake.el
bloba3480d0b0fa266cedfb14ce4d5b87d7eed01e7b5
1 ;;; snake.el --- implementation of Snake for Emacs
3 ;; Copyright (C) 1997, 2001-2012 Free Software Foundation, Inc.
5 ;; Author: Glynn Clements <glynn@sensei.co.uk>
6 ;; Created: 1997-09-10
7 ;; Keywords: games
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 3 of the License, or
14 ;; (at your option) any later version.
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. If not, see <http://www.gnu.org/licenses/>.
24 ;;; Commentary:
26 ;;; Code:
28 (eval-when-compile (require 'cl-lib))
30 (require 'gamegrid)
32 ;; ;;;;;;;;;;;;; customization variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
34 (defvar snake-use-glyphs-flag t
35 "Non-nil means use glyphs when available.")
37 (defvar snake-use-color-flag t
38 "Non-nil means use color when available.")
40 (defvar snake-buffer-name "*Snake*"
41 "Name used for Snake buffer.")
43 (defvar snake-buffer-width 30
44 "Width of used portion of buffer.")
46 (defvar snake-buffer-height 22
47 "Height of used portion of buffer.")
49 (defvar snake-width 30
50 "Width of playing area.")
52 (defvar snake-height 20
53 "Height of playing area.")
55 (defvar snake-initial-length 5
56 "Initial length of snake.")
58 (defvar snake-initial-x 10
59 "Initial X position of snake.")
61 (defvar snake-initial-y 10
62 "Initial Y position of snake.")
64 (defvar snake-initial-velocity-x 1
65 "Initial X velocity of snake.")
67 (defvar snake-initial-velocity-y 0
68 "Initial Y velocity of snake.")
70 (defvar snake-tick-period 0.2
71 "The default time taken for the snake to advance one square.")
73 (defvar snake-mode-hook nil
74 "Hook run upon starting Snake.")
76 (defvar snake-score-x 0
77 "X position of score.")
79 (defvar snake-score-y snake-height
80 "Y position of score.")
82 ;; It is not safe to put this in /tmp.
83 ;; Someone could make a symlink in /tmp
84 ;; pointing to a file you don't want to clobber.
85 (defvar snake-score-file "snake-scores"
86 "File for holding high scores.")
88 ;; ;;;;;;;;;;;;; display options ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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"))))
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"))))
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"))))
119 (defvar snake-border-options
120 '(((glyph colorize)
121 (t ?\+))
122 ((color-x color-x)
123 (mono-x grid-x)
124 (color-tty color-tty))
125 (((glyph color-x) [0.5 0.5 0.5])
126 (color-tty "white"))))
128 (defvar snake-space-options
129 '(((t ?\040))
131 nil))
133 ;; ;;;;;;;;;;;;; constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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)
141 ;; ;;;;;;;;;;;;; variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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)
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.
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.")
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)
170 (make-variable-buffer-local 'snake-moved-p)
171 (make-variable-buffer-local 'snake-velocity-queue)
173 ;; ;;;;;;;;;;;;; keymaps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
175 (defvar snake-mode-map
176 (let ((map (make-sparse-keymap 'snake-mode-map)))
178 (define-key map "n" 'snake-start-game)
179 (define-key map "q" 'snake-end-game)
180 (define-key map "p" 'snake-pause-game)
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))
188 (defvar snake-null-map
189 (let ((map (make-sparse-keymap 'snake-null-map)))
190 (define-key map "n" 'snake-start-game)
191 map))
193 ;; ;;;;;;;;;;;;;;;; game functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
195 (defun snake-display-options ()
196 (let ((options (make-vector 256 nil)))
197 (dotimes (c 256)
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)
210 '(nil nil nil)))))
211 options))
213 (defun snake-update-score ()
214 (let* ((string (format "Score: %05d" snake-score))
215 (len (length string)))
216 (dotimes (x len)
217 (gamegrid-set-cell (+ snake-score-x x)
218 snake-score-y
219 (aref string x)))))
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))
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)))))
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
242 snake-paused nil
243 snake-moved-p nil
244 snake-velocity-queue nil)
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))
250 (cl-incf x snake-velocity-x)
251 (cl-incf y snake-velocity-y)))
252 (snake-update-score))
254 (defun snake-update-game (snake-buffer)
255 "Called on each clock tick.
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)
269 (cl-incf snake-length)
270 (cl-incf snake-score)
271 (snake-update-score))
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))
282 (cl-incf snake-cycle)
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)))))
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)))
299 (defun snake-final-x-velocity ()
300 (or (caar snake-velocity-queue)
301 snake-velocity-x))
303 (defun snake-final-y-velocity ()
304 (or (cadr (car snake-velocity-queue))
305 snake-velocity-y))
307 (defun snake-move-left ()
308 "Make the snake move left."
309 (interactive)
310 (when (zerop (snake-final-x-velocity))
311 (push '(-1 0) snake-velocity-queue)))
313 (defun snake-move-right ()
314 "Make the snake move right."
315 (interactive)
316 (when (zerop (snake-final-x-velocity))
317 (push '(1 0) snake-velocity-queue)))
319 (defun snake-move-up ()
320 "Make the snake move up."
321 (interactive)
322 (when (zerop (snake-final-y-velocity))
323 (push '(0 -1) snake-velocity-queue)))
325 (defun snake-move-down ()
326 "Make the snake move down."
327 (interactive)
328 (when (zerop (snake-final-y-velocity))
329 (push '(0 1) snake-velocity-queue)))
331 (defun snake-end-game ()
332 "Terminate the current game."
333 (interactive)
334 (gamegrid-kill-timer)
335 (use-local-map snake-null-map)
336 (gamegrid-add-score snake-score-file snake-score))
338 (defun snake-start-game ()
339 "Start a new game of Snake."
340 (interactive)
341 (snake-reset-game)
342 (use-local-map snake-mode-map)
343 (gamegrid-start-timer snake-tick-period 'snake-update-game))
345 (defun snake-pause-game ()
346 "Pause (or resume) the current game."
347 (interactive)
348 (setq snake-paused (not snake-paused))
349 (message (and snake-paused "Game paused (press p to resume)")))
351 (defun snake-active-p ()
352 (eq (current-local-map) snake-mode-map))
354 (put 'snake-mode 'mode-class 'special)
356 (defun snake-mode ()
357 "A mode for playing Snake.
359 Snake mode keybindings:
360 \\{snake-mode-map}
362 (kill-all-local-variables)
364 (add-hook 'kill-buffer-hook 'gamegrid-kill-timer nil t)
366 (use-local-map snake-null-map)
368 (setq major-mode 'snake-mode)
369 (setq mode-name "Snake")
371 (unless (featurep 'emacs)
372 (setq mode-popup-menu
373 '("Snake Commands"
374 ["Start new game" snake-start-game]
375 ["End game" snake-end-game
376 (snake-active-p)]
377 ["Pause" snake-pause-game
378 (and (snake-active-p) (not snake-paused))]
379 ["Resume" snake-pause-game
380 (and (snake-active-p) snake-paused)])))
382 (setq gamegrid-use-glyphs snake-use-glyphs-flag)
383 (setq gamegrid-use-color snake-use-color-flag)
385 (gamegrid-init (snake-display-options))
387 (run-mode-hooks 'snake-mode-hook))
389 ;;;###autoload
390 (defun snake ()
391 "Play the Snake game.
392 Move the snake around without colliding with its tail or with the border.
394 Eating dots causes the snake to get longer.
396 Snake mode keybindings:
397 \\<snake-mode-map>
398 \\[snake-start-game] Starts a new game of Snake
399 \\[snake-end-game] Terminates the current game
400 \\[snake-pause-game] Pauses (or resumes) the current game
401 \\[snake-move-left] Makes the snake move left
402 \\[snake-move-right] Makes the snake move right
403 \\[snake-move-up] Makes the snake move up
404 \\[snake-move-down] Makes the snake move down"
405 (interactive)
407 (switch-to-buffer snake-buffer-name)
408 (gamegrid-kill-timer)
409 (snake-mode)
410 (snake-start-game))
412 (provide 'snake)
414 ;;; snake.el ends here