;;; snake.el -- Implementation of Snake for Emacs.;; Copyright (C) 1998 Free Software Foundation, Inc.;; Author: Glynn Clements <glynn@sensei.co.uk>;; Version: 1.02;; Created: 1997-09-10;; Keywords: games;; This file is part of XEmacs.;; XEmacs 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 of the License, or;; (at your option) any later version.;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA;; 02111-1307, USA.;;; Synched up with: Not synched.;;; Commentary:;; Modified: 1998-05-28;; Added popup menu;; Modified: 1998-06-23, copyright assigned to FSF;; URL: ftp://sensei.co.uk/misc/elisp-games.tar.gz;; Tested with XEmacs 20.3/4/5 and Emacs 19.34(eval-when-compile(require'cl))(require'gamegrid);; ;;;;;;;;;;;;; customization variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;(defvarsnake-use-glyphst"Non-nil means use glyphs when available")(defvarsnake-use-colort"Non-nil means use color when available")(defvarsnake-buffer-name"*Snake*""Name used for Snake buffer")(defvarsnake-buffer-width30"Width of used portion of buffer")(defvarsnake-buffer-height22"Height of used portion of buffer")(defvarsnake-width30"Width of playing area")(defvarsnake-height20"Height of playing area")(defvarsnake-initial-length5"Initial length of snake")(defvarsnake-initial-x10"Initial X position of snake")(defvarsnake-initial-y10"Initial Y position of snake")(defvarsnake-initial-velocity-x1"Initial X velocity of snake")(defvarsnake-initial-velocity-y0"Initial Y velocity of snake")(defvarsnake-tick-period0.2"The default time taken for the snake to advance one square")(defvarsnake-mode-hooknil"Hook run upon starting Snake")(defvarsnake-score-x0"X position of score")(defvarsnake-score-ysnake-height"Y position of score")(defvarsnake-score-file"/tmp/snake-scores""File for holding high scores");; ;;;;;;;;;;;;; display options ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;(defvarsnake-blank-options'(((glyphcolorize)(t?\040))((color-xcolor-x)(mono-xgrid-x)(color-ttycolor-tty))(((glyphcolor-x)[000])(color-tty"black"))))(defvarsnake-snake-options'(((glyphcolorize)(emacs-tty?O)(t?\040))((color-xcolor-x)(mono-xmono-x)(color-ttycolor-tty)(mono-ttymono-tty))(((glyphcolor-x)[110])(color-tty"yellow"))))(defvarsnake-dot-options'(((glyphcolorize)(t?\*))((color-xcolor-x)(mono-xgrid-x)(color-ttycolor-tty))(((glyphcolor-x)[100])(color-tty"red"))))(defvarsnake-border-options'(((glyphcolorize)(t?\+))((color-xcolor-x)(mono-xgrid-x))(((glyphcolor-x)[0.50.50.5])(color-tty"white"))))(defvarsnake-space-options'(((t?\040))nilnil));; ;;;;;;;;;;;;; constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;(defconstsnake-blank0)(defconstsnake-snake1)(defconstsnake-dot2)(defconstsnake-border3)(defconstsnake-space4);; ;;;;;;;;;;;;; variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;(defvarsnake-length0)(defvarsnake-velocity-x1)(defvarsnake-velocity-y0)(defvarsnake-positionsnil)(defvarsnake-cycle0)(defvarsnake-score0)(defvarsnake-pausednil)(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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;(defvarsnake-mode-map(make-sparse-keymap'snake-mode-map))(define-keysnake-mode-map"n"'snake-start-game)(define-keysnake-mode-map"q"'snake-end-game)(define-keysnake-mode-map"p"'snake-pause-game)(define-keysnake-mode-map[left]'snake-move-left)(define-keysnake-mode-map[right]'snake-move-right)(define-keysnake-mode-map[up]'snake-move-up)(define-keysnake-mode-map[down]'snake-move-down)(defvarsnake-null-map(make-sparse-keymap'snake-null-map))(define-keysnake-null-map"n"'snake-start-game);; ;;;;;;;;;;;;;;;; game functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;(defunsnake-display-options()(let((options(make-vector256nil)))(loopforcfrom0to255do(asetoptionsc(cond((=csnake-blank)snake-blank-options)((=csnake-snake)snake-snake-options)((=csnake-dot)snake-dot-options)((=csnake-border)snake-border-options)((=csnake-space)snake-space-options)(t'(nilnilnil)))))options))(defunsnake-update-score()(let*((string(format"Score: %05d"snake-score))(len(lengthstring)))(loopforxfrom0to(1-len)do(gamegrid-set-cell(+snake-score-xx)snake-score-y(arefstringx)))))(defunsnake-init-buffer()(gamegrid-init-buffersnake-buffer-widthsnake-buffer-heightsnake-space)(let((buffer-read-onlynil))(loopforyfrom0to(1-snake-height)do(loopforxfrom0to(1-snake-width)do(gamegrid-set-cellxysnake-border)))(loopforyfrom1to(-snake-height2)do(loopforxfrom1to(-snake-width2)do(gamegrid-set-cellxysnake-blank)))))(defunsnake-reset-game()(gamegrid-kill-timer)(snake-init-buffer)(setqsnake-lengthsnake-initial-lengthsnake-velocity-xsnake-initial-velocity-xsnake-velocity-ysnake-initial-velocity-ysnake-positionsnilsnake-cycle1snake-score0snake-pausednil)(let((xsnake-initial-x)(ysnake-initial-y))(dotimes(isnake-length)(gamegrid-set-cellxysnake-snake)(setqsnake-positions(cons(vectorxy)snake-positions))(incfxsnake-velocity-x)(incfysnake-velocity-y)))(snake-update-score))(defunsnake-update-game(snake-buffer)"Called on each clock tick.Advances the snake one square, testing for collision."(if(and(notsnake-paused)(eq(current-buffer)snake-buffer))(let*((pos(carsnake-positions))(x(+(arefpos0)snake-velocity-x))(y(+(arefpos1)snake-velocity-y))(c(gamegrid-get-cellxy)))(if(or(=csnake-border)(=csnake-snake))(snake-end-game)(cond((=csnake-dot)(incfsnake-length)(incfsnake-score)(snake-update-score))(t(let*((last-cons(nthcdr(-snake-length2)snake-positions))(tail-pos(cadrlast-cons))(x0(areftail-pos0))(y0(areftail-pos1)))(gamegrid-set-cellx0y0(if(=(%snake-cycle5)0)snake-dotsnake-blank))(incfsnake-cycle)(setcdrlast-consnil))))(gamegrid-set-cellxysnake-snake)(setqsnake-positions(cons(vectorxy)snake-positions))))))(defunsnake-move-left()"Makes the snake move left"(interactive)(unless(=snake-velocity-x1)(setqsnake-velocity-x-1snake-velocity-y0)))(defunsnake-move-right()"Makes the snake move right"(interactive)(unless(=snake-velocity-x-1)(setqsnake-velocity-x1snake-velocity-y0)))(defunsnake-move-up()"Makes the snake move up"(interactive)(unless(=snake-velocity-y1)(setqsnake-velocity-x0snake-velocity-y-1)))(defunsnake-move-down()"Makes the snake move down"(interactive)(unless(=snake-velocity-y-1)(setqsnake-velocity-x0snake-velocity-y1)))(defunsnake-end-game()"Terminates the current game"(interactive)(gamegrid-kill-timer)(use-local-mapsnake-null-map)(gamegrid-add-scoresnake-score-filesnake-score))(defunsnake-start-game()"Starts a new game of Snake"(interactive)(snake-reset-game)(use-local-mapsnake-mode-map)(gamegrid-start-timersnake-tick-period'snake-update-game))(defunsnake-pause-game()"Pauses (or resumes) the current game"(interactive)(setqsnake-paused(notsnake-paused))(message(andsnake-paused"Game paused (press p to resume)")))(defunsnake-active-p()(eq(current-local-map)snake-mode-map))(put'snake-mode'mode-class'special)(defunsnake-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-timernilt)(use-local-mapsnake-null-map)(setqmajor-mode'snake-mode)(setqmode-name"Snake")(setqmode-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)(notsnake-paused))]["Resume"snake-pause-game(and(snake-active-p)snake-paused)]))(setqgamegrid-use-glyphssnake-use-glyphs)(setqgamegrid-use-colorsnake-use-color)(gamegrid-init(snake-display-options))(run-hooks'snake-mode-hook));;;###autoload(defunsnake()"SnakeMove the snake around without colliding with its tail or with theborder.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-buffersnake-buffer-name)(gamegrid-kill-timer)(snake-mode)(snake-start-game))(provide'snake);;; snake.el ends here