lisp/play/snake.el

   1 ;;; snake.el -- Implementation of Snake for Emacs
   2
   3 ;; Copyright (C) 1997 Free Software Foundation, Inc.
   4
   5 ;; Author: Glynn Clements <glynn@sensei.co.uk>
   6 ;; Created: 1997-09-10
   7 ;; Keywords: games
   8
   9 ;; This file is part of GNU Emacs.
  10
  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)
  14 ;; any later version.
  15
  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.
  20
  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.
  25
  26 ;;; Commentary:
  27
  28 (eval-when-compile
  29   (require 'cl))
  30
  31 (require 'gamegrid)
  32
  33 ;; ;;;;;;;;;;;;; customization variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  34
  35 (defvar snake-use-glyphs t
  36   "Non-nil means use glyphs when available.")
  37
  38 (defvar snake-use-color t
  39   "Non-nil means use color when available.")
  40
  41 (defvar snake-buffer-name "*Snake*"
  42   "Name used for Snake buffer.")
  43
  44 (defvar snake-buffer-width 30
  45   "Width of used portion of buffer.")
  46
  47 (defvar snake-buffer-height 22
  48   "Height of used portion of buffer.")
  49
  50 (defvar snake-width 30
  51   "Width of playing area.")
  52
  53 (defvar snake-height 20
  54   "Height of playing area.")
  55
  56 (defvar snake-initial-length 5
  57   "Initial length of snake.")
  58
  59 (defvar snake-initial-x 10
  60   "Initial X position of snake.")
  61
  62 (defvar snake-initial-y 10
  63   "Initial Y position of snake.")
  64
  65 (defvar snake-initial-velocity-x 1
  66   "Initial X velocity of snake.")
  67
  68 (defvar snake-initial-velocity-y 0
  69   "Initial Y velocity of snake.")
  70
  71 (defvar snake-tick-period 0.2
  72   "The default time taken for the snake to advance one square.")
  73
  74 (defvar snake-mode-hook nil
  75   "Hook run upon starting Snake.")
  76
  77 (defvar snake-score-x 0
  78   "X position of score.")
  79
  80 (defvar snake-score-y snake-height
  81   "Y position of score.")
  82
  83 (defvar snake-score-file "/tmp/snake-scores"
  84   "File for holding high scores.")
  85
  86 ;; ;;;;;;;;;;;;; display options ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  87
  88 (defvar snake-blank-options
  89   '(((glyph colorize)
  90      (t ?\040))
  91     ((color-x color-x)
  92      (mono-x grid-x)
  93      (color-tty color-tty))
  94     (((glyph color-x) [0 0 0])
  95      (color-tty "black"))))
  96
  97 (defvar snake-snake-options
  98   '(((glyph colorize)
  99      (emacs-tty ?O)
 100      (t ?\040))
 101     ((color-x color-x)
 102      (mono-x mono-x)
 103      (color-tty color-tty)
 104      (mono-tty mono-tty))
 105     (((glyph color-x) [1 1 0])
 106      (color-tty "yellow"))))
 107
 108 (defvar snake-dot-options
 109   '(((glyph colorize)
 110      (t ?\*))
 111     ((color-x color-x)
 112      (mono-x grid-x)
 113      (color-tty color-tty))
 114     (((glyph color-x) [1 0 0])
 115      (color-tty "red"))))
 116
 117 (defvar snake-border-options
 118   '(((glyph colorize)
 119      (t ?\+))
 120     ((color-x color-x)
 121      (mono-x grid-x))
 122     (((glyph color-x) [0.5 0.5 0.5])
 123      (color-tty "white"))))
 124
 125 (defvar snake-space-options
 126   '(((t ?\040))
 127     nil
 128     nil))
 129
 130 ;; ;;;;;;;;;;;;; constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 131
 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)
 137
 138 ;; ;;;;;;;;;;;;; variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 139
 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)
 147
 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)
 155
 156 ;; ;;;;;;;;;;;;; keymaps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 157
 158 (defvar snake-mode-map
 159   (make-sparse-keymap 'snake-mode-map))
 160
 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)
 164
 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)
 169
 170 (defvar snake-null-map
 171   (make-sparse-keymap 'snake-null-map))
 172
 173 (define-key snake-null-map "n"          'snake-start-game)
 174
 175 ;; ;;;;;;;;;;;;;;;; game functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 176
 177 (defun snake-display-options ()
 178   (let ((options (make-vector 256 nil)))
 179     (loop for c from 0 to 255 do
 180       (aset options c
 181             (cond ((= c snake-blank)
 182                    snake-blank-options)
 183                   ((= c snake-snake)
 184                    snake-snake-options)
 185                   ((= c snake-dot)
 186                    snake-dot-options)
 187                   ((= c snake-border)
 188                    snake-border-options)
 189                   ((= c snake-space)
 190                    snake-space-options)
 191                   (t
 192                    '(nil nil nil)))))
 193     options))
 194
 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)
 200                          snake-score-y
 201                          (aref string x)))))
 202
 203 (defun snake-init-buffer ()
 204   (gamegrid-init-buffer snake-buffer-width
 205                         snake-buffer-height
 206                         snake-space)
 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)))))
 214
 215 (defun snake-reset-game ()
 216   (gamegrid-kill-timer)
 217   (snake-init-buffer)
 218   (setq snake-length            snake-initial-length
 219         snake-velocity-x        snake-initial-velocity-x
 220         snake-velocity-y        snake-initial-velocity-y
 221         snake-positions         nil
 222         snake-cycle             1
 223         snake-score             0
 224         snake-paused            nil)
 225   (let ((x snake-initial-x)
 226         (y snake-initial-y))
 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))
 233
 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)
 244                 (= c snake-snake))
 245             (snake-end-game)
 246           (cond ((= c snake-dot)
 247                  (incf snake-length)
 248                  (incf snake-score)
 249                  (snake-update-score))
 250                 (t
 251                  (let* ((last-cons (nthcdr (- snake-length 2)
 252                                            snake-positions))
 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)
 258                                           snake-dot
 259                                         snake-blank))
 260                    (incf snake-cycle)
 261                    (setcdr last-cons nil))))
 262           (gamegrid-set-cell x y snake-snake)
 263           (setq snake-positions
 264                 (cons (vector x y) snake-positions))))))
 265
 266 (defun snake-move-left ()
 267   "Makes the snake move left"
 268   (interactive)
 269   (unless (= snake-velocity-x 1)
 270     (setq snake-velocity-x -1
 271           snake-velocity-y 0)))
 272
 273 (defun snake-move-right ()
 274   "Makes the snake move right"
 275   (interactive)
 276   (unless (= snake-velocity-x -1)
 277     (setq snake-velocity-x 1
 278           snake-velocity-y 0)))
 279
 280 (defun snake-move-up ()
 281   "Makes the snake move up"
 282   (interactive)
 283   (unless (= snake-velocity-y 1)
 284     (setq snake-velocity-x 0
 285           snake-velocity-y -1)))
 286
 287 (defun snake-move-down ()
 288   "Makes the snake move down"
 289   (interactive)
 290   (unless (= snake-velocity-y -1)
 291     (setq snake-velocity-x 0
 292           snake-velocity-y 1)))
 293
 294 (defun snake-end-game ()
 295   "Terminates the current game"
 296   (interactive)
 297   (gamegrid-kill-timer)
 298   (use-local-map snake-null-map)
 299   (gamegrid-add-score snake-score-file snake-score))
 300
 301 (defun snake-start-game ()
 302   "Starts a new game of Snake"
 303   (interactive)
 304   (snake-reset-game)
 305   (use-local-map snake-mode-map)
 306   (gamegrid-start-timer snake-tick-period 'snake-update-game))
 307
 308 (defun snake-pause-game ()
 309   "Pauses (or resumes) the current game"
 310   (interactive)
 311   (setq snake-paused (not snake-paused))
 312   (message (and snake-paused "Game paused (press p to resume)")))
 313
 314 (defun snake-active-p ()
 315   (eq (current-local-map) snake-mode-map))
 316
 317 (put 'snake-mode 'mode-class 'special)
 318
 319 (defun snake-mode ()
 320   "A mode for playing Snake.
 321
 322 snake-mode keybindings:
 323    \\{snake-mode-map}
 324 "
 325   (kill-all-local-variables)
 326
 327   (make-local-hook 'kill-buffer-hook)
 328   (add-hook 'kill-buffer-hook 'gamegrid-kill-timer nil t)
 329
 330   (use-local-map snake-null-map)
 331
 332   (setq major-mode 'snake-mode)
 333   (setq mode-name "Snake")
 334
 335   (setq mode-popup-menu
 336         '("Snake Commands"
 337           ["Start new game"     snake-start-game]
 338           ["End game"           snake-end-game
 339            (snake-active-p)]
 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)]))
 344
 345   (setq gamegrid-use-glyphs snake-use-glyphs)
 346   (setq gamegrid-use-color snake-use-color)
 347
 348   (gamegrid-init (snake-display-options))
 349
 350   (run-hooks 'snake-mode-hook))
 351
 352 ;;;###autoload
 353 (defun snake ()
 354   "Play the Snake game.
 355 Move the snake around without colliding with its tail or with the border.
 356
 357 Eating dots causes the snake to get longer.
 358
 359 snake-mode keybindings:
 360    \\<snake-mode-map>
 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
 368
 369 "
 370   (interactive)
 371
 372   (switch-to-buffer snake-buffer-name)
 373   (gamegrid-kill-timer)
 374   (snake-mode)
 375   (snake-start-game))
 376
 377 (provide 'snake)
 378
 379 ;;; snake.el ends here