diff options
| -rw-r--r-- | lisp/play/snake.el | 379 |
1 files changed, 379 insertions, 0 deletions
diff --git a/lisp/play/snake.el b/lisp/play/snake.el new file mode 100644 index 0000000000..17dcb3a23b --- /dev/null +++ b/lisp/play/snake.el @@ -0,0 +1,379 @@ +;;; snake.el -- Implementation of Snake for Emacs. + +;; Copyright (C) 1997 Free Software Foundation, Inc. + +;; Author: Glynn Clements <[email protected]> +;; 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 2, 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., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +(eval-when-compile + (require 'cl)) + +(require 'gamegrid) + +;; ;;;;;;;;;;;;; customization variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar snake-use-glyphs t + "Non-nil means use glyphs when available.") + +(defvar snake-use-color 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.") + +(defvar snake-score-file "/tmp/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)) + (((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) + +(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) + +;; ;;;;;;;;;;;;; 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) + (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." + (if (and (not snake-paused) + (eq (current-buffer) snake-buffer)) + (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)))))) + +(defun snake-move-left () + "Makes the snake move left" + (interactive) + (unless (= snake-velocity-x 1) + (setq snake-velocity-x -1 + snake-velocity-y 0))) + +(defun snake-move-right () + "Makes the snake move right" + (interactive) + (unless (= snake-velocity-x -1) + (setq snake-velocity-x 1 + snake-velocity-y 0))) + +(defun snake-move-up () + "Makes the snake move up" + (interactive) + (unless (= snake-velocity-y 1) + (setq snake-velocity-x 0 + snake-velocity-y -1))) + +(defun snake-move-down () + "Makes the snake move down" + (interactive) + (unless (= snake-velocity-y -1) + (setq snake-velocity-x 0 + snake-velocity-y 1))) + +(defun snake-end-game () + "Terminates 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 () + "Starts 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 () + "Pauses (or resumes) 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) + + (make-local-hook 'kill-buffer-hook) + (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") + + (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) + (setq gamegrid-use-color snake-use-color) + + (gamegrid-init (snake-display-options)) + + (run-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) + +;;; snake.el ends here |