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