2021-04-21 17:33:13 +00:00
|
|
|
;;; snek.el --- no step on snek game
|
|
|
|
|
|
|
|
;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc.
|
|
|
|
;; Copyright 2021 Case Duckworth
|
|
|
|
|
|
|
|
;; Author: Case Duckworth <acdw@acdw.net>
|
|
|
|
;; Created: 2021-04-21
|
|
|
|
;; Keywords: games
|
|
|
|
|
|
|
|
;; This file is NOT part of GNU Emacs.
|
|
|
|
|
|
|
|
;; This software 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 3 of the License, or
|
|
|
|
;; (at your option) any later version.
|
|
|
|
|
|
|
|
;; This software 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 no step on snek. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
|
|
|
|
;; This is a rip-off of the snake.el that comes with GNU Emacs for the Lisp
|
|
|
|
;; Game Jam 2021. I'm not sure if I'll be able to finish it by the end (I'm
|
|
|
|
;; starting like, 4 days in?), but I'll see what I can do.
|
|
|
|
|
|
|
|
;; So this is the snake game we all know and love, with a TWIST. The TWIST is
|
|
|
|
;; that, instead of playing as the snake, you play as a self-aware apple who's
|
|
|
|
;; trying to save your apple brethren from the hungry snake. If you step on
|
|
|
|
;; the snake, or land in his path, you die. Otherwise, you get a point for
|
|
|
|
;; every apple you save.
|
|
|
|
|
|
|
|
;;; Code:
|
|
|
|
|
|
|
|
(eval-when-compile (require 'cl-lib))
|
|
|
|
|
|
|
|
(require 'gamegrid)
|
|
|
|
|
|
|
|
;; ;;;;;;;;;;;;; customization variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
|
|
(defvar snek-use-glyphs-flag t
|
|
|
|
"Non-nil means use glyphs when available.")
|
|
|
|
|
|
|
|
(defvar snek-use-color-flag t
|
|
|
|
"Non-nil means use color when available.")
|
|
|
|
|
|
|
|
(defvar snek-buffer-name "*No step on snek!*"
|
|
|
|
"Name used for No step on snek buffer.")
|
|
|
|
|
|
|
|
(defvar snek-buffer-width 30
|
|
|
|
"Width of used portion of buffer.")
|
|
|
|
|
|
|
|
(defvar snek-buffer-height 22
|
|
|
|
"Height of used portion of buffer.")
|
|
|
|
|
|
|
|
(defvar snek-width 30
|
|
|
|
"Width of playing area.")
|
|
|
|
|
|
|
|
(defvar snek-height 20
|
|
|
|
"Height of playing area.")
|
|
|
|
|
|
|
|
(defvar snek-initial-length 5
|
|
|
|
"Initial length of snek.")
|
|
|
|
|
|
|
|
(defvar snek-initial-x 10
|
|
|
|
"Initial X position of snek.")
|
|
|
|
|
|
|
|
(defvar snek-initial-y 10
|
|
|
|
"Initial Y position of snek.")
|
|
|
|
|
|
|
|
(defvar snek-initial-velocity-x 1
|
|
|
|
"Initial X velocity of snek.")
|
|
|
|
|
|
|
|
(defvar snek-initial-velocity-y 0
|
|
|
|
"Initial Y velocity of snek.")
|
|
|
|
|
|
|
|
(defvar snek-player-initial-x 4
|
|
|
|
"Initial X position of player.")
|
|
|
|
|
|
|
|
(defvar snek-player-initial-y 4
|
|
|
|
"Initial Y position of player.")
|
|
|
|
|
|
|
|
(defvar snek-tick-period 0.2
|
|
|
|
"The default time taken for the snek to advance one square.")
|
|
|
|
|
|
|
|
(defvar snek-mode-hook nil
|
|
|
|
"Hook run upon starting Snek.")
|
|
|
|
|
|
|
|
(defvar snek-score-x 0
|
|
|
|
"X position of score.")
|
|
|
|
|
|
|
|
(defvar snek-score-y snek-height
|
|
|
|
"Y position of score.")
|
|
|
|
|
|
|
|
;; It is not safe to put this in /tmp.
|
|
|
|
;; Someone could make a symlink in /tmp
|
|
|
|
;; pointing to a file you don't want to clobber.
|
|
|
|
(defvar snek-score-file "snek-scores"
|
|
|
|
"File for holding high scores.")
|
|
|
|
|
|
|
|
;; ;;;;;;;;;;;;; display options ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
|
|
(defvar snek-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 snek-snek-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 snek-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 snek-player-options
|
|
|
|
'(((glyph colorize)
|
|
|
|
(t ?\@))
|
|
|
|
((color-x color-x)
|
|
|
|
(mono-x grid-x)
|
|
|
|
(color-tty color-tty))
|
2021-04-21 17:58:07 +00:00
|
|
|
(((glyph color-x) [0 1 0])
|
2021-04-21 17:33:13 +00:00
|
|
|
(color-tty "green"))))
|
|
|
|
|
|
|
|
(defvar snek-border-options
|
|
|
|
'(((glyph colorize)
|
|
|
|
(t ?\+))
|
|
|
|
((color-x color-x)
|
|
|
|
(mono-x grid-x)
|
|
|
|
(color-tty color-tty))
|
|
|
|
(((glyph color-x) [0.5 0.5 0.5])
|
|
|
|
(color-tty "white"))))
|
|
|
|
|
|
|
|
(defvar snek-space-options
|
|
|
|
'(((t ?\040))
|
|
|
|
nil
|
|
|
|
nil))
|
|
|
|
|
|
|
|
;; ;;;;;;;;;;;;; constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
|
|
(defconst snek-blank 0)
|
|
|
|
(defconst snek-snek 1)
|
|
|
|
(defconst snek-dot 2)
|
|
|
|
(defconst snek-border 3)
|
|
|
|
(defconst snek-space 4)
|
|
|
|
(defconst snek-player 5)
|
|
|
|
|
|
|
|
;; ;;;;;;;;;;;;; variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
|
|
(defvar snek-length 0)
|
|
|
|
(defvar snek-velocity-x 1)
|
|
|
|
(defvar snek-velocity-y 0)
|
|
|
|
(defvar snek-positions nil)
|
|
|
|
(defvar snek-score 0)
|
|
|
|
(defvar snek-paused nil)
|
|
|
|
(defvar snek-moved-p nil)
|
|
|
|
(defvar snek-velocity-queue nil
|
|
|
|
"This queue stores the velocities requested too quickly by user.
|
|
|
|
They will take effect one at a time at each clock-interval.
|
|
|
|
This is necessary for proper behavior.
|
|
|
|
|
|
|
|
For instance, if you are moving right, you press up and then left, you
|
|
|
|
want the snek to move up just once before starting to move left. If
|
|
|
|
we implemented all your keystrokes immediately, the snek would
|
|
|
|
effectively never move up. Thus, we need to move it up for one turn
|
|
|
|
and then start moving it leftwards.")
|
|
|
|
|
|
|
|
|
|
|
|
(make-variable-buffer-local 'snek-length)
|
|
|
|
(make-variable-buffer-local 'snek-velocity-x)
|
|
|
|
(make-variable-buffer-local 'snek-velocity-y)
|
|
|
|
(make-variable-buffer-local 'snek-positions)
|
|
|
|
(make-variable-buffer-local 'snek-score)
|
|
|
|
(make-variable-buffer-local 'snek-paused)
|
|
|
|
(make-variable-buffer-local 'snek-moved-p)
|
|
|
|
(make-variable-buffer-local 'snek-velocity-queue)
|
|
|
|
|
|
|
|
;; ;;;;;;;;;;;;; keymaps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
|
|
(defvar snek-mode-map
|
|
|
|
(let ((map (make-sparse-keymap 'snek-mode-map)))
|
|
|
|
|
|
|
|
(define-key map "n" 'snek-start-game)
|
|
|
|
(define-key map "q" 'snek-end-game)
|
|
|
|
(define-key map "p" 'snek-pause-game)
|
|
|
|
|
|
|
|
(define-key map [left] 'player-move-left)
|
|
|
|
(define-key map [right] 'player-move-right)
|
|
|
|
(define-key map [up] 'player-move-up)
|
|
|
|
(define-key map [down] 'player-move-down)
|
|
|
|
|
|
|
|
(define-key map "\C-b" 'player-move-left)
|
|
|
|
(define-key map "\C-f" 'player-move-right)
|
|
|
|
(define-key map "\C-p" 'player-move-up)
|
|
|
|
(define-key map "\C-n" 'player-move-down)
|
|
|
|
map)
|
|
|
|
"Keymap for Snek games.")
|
|
|
|
|
|
|
|
(defvar snek-null-map
|
|
|
|
(let ((map (make-sparse-keymap 'snek-null-map)))
|
|
|
|
(define-key map "n" 'snek-start-game)
|
|
|
|
map)
|
|
|
|
"Keymap for finished Snek games.")
|
|
|
|
|
|
|
|
(defconst snek--menu-def
|
|
|
|
'("Snek"
|
|
|
|
["Start new game" snek-start-game
|
|
|
|
:help "Start a new Snek game"]
|
|
|
|
["End game" snek-end-game
|
|
|
|
:active (snek-active-p)
|
|
|
|
:help "End the current Snek game"]
|
|
|
|
;; FIXME: Pause and resume from the menu currently doesn't work
|
|
|
|
;; very well and is therefore disabled. The game continues
|
|
|
|
;; running while navigating the menu. See also
|
|
|
|
;; `tetris--menu-def' which has the same problem.
|
|
|
|
;; ["Pause" snek-pause-game
|
|
|
|
;; :active (and (snek-active-p) (not snek-paused))
|
|
|
|
;; :help "Pause running Snek game"]
|
|
|
|
;; ["Resume" snek-pause-game
|
|
|
|
;; :active (and (snek-active-p) snek-paused)
|
|
|
|
;; :help "Resume paused Snek game"]
|
|
|
|
)
|
|
|
|
"Menu for `snek'. Used to initialize menus.")
|
|
|
|
|
|
|
|
(easy-menu-define
|
|
|
|
snek-mode-menu snek-mode-map
|
|
|
|
"Menu for running Snek games."
|
|
|
|
snek--menu-def)
|
|
|
|
|
|
|
|
(easy-menu-define
|
|
|
|
snek-null-menu snek-null-map
|
|
|
|
"Menu for finished Snek games."
|
|
|
|
snek--menu-def)
|
|
|
|
|
|
|
|
;; ;;;;;;;;;;;;;;;; game functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
|
|
|
(defun snek-display-options ()
|
|
|
|
(let ((options (make-vector 256 nil)))
|
|
|
|
(dotimes (c 256)
|
|
|
|
(aset options c
|
|
|
|
(cond ((= c snek-blank)
|
|
|
|
snek-blank-options)
|
|
|
|
((= c snek-snek)
|
|
|
|
snek-snek-options)
|
|
|
|
((= c snek-dot)
|
|
|
|
snek-dot-options)
|
|
|
|
((= c snek-border)
|
|
|
|
snek-border-options)
|
|
|
|
((= c snek-space)
|
|
|
|
snek-space-options)
|
2021-04-21 17:58:07 +00:00
|
|
|
((= c snek-player)
|
|
|
|
snek-player-options)
|
2021-04-21 17:33:13 +00:00
|
|
|
(t
|
|
|
|
'(nil nil nil)))))
|
|
|
|
options))
|
|
|
|
|
|
|
|
(defun snek-update-score ()
|
|
|
|
(let* ((string (format "Score: %05d" snek-score))
|
|
|
|
(len (length string)))
|
|
|
|
(dotimes (x len)
|
|
|
|
(gamegrid-set-cell (+ snek-score-x x)
|
|
|
|
snek-score-y
|
|
|
|
(aref string x)))))
|
|
|
|
|
|
|
|
(defun snek-init-buffer ()
|
|
|
|
(gamegrid-init-buffer snek-buffer-width
|
|
|
|
snek-buffer-height
|
|
|
|
snek-space)
|
|
|
|
(let ((buffer-read-only nil))
|
|
|
|
(dotimes (y snek-height)
|
|
|
|
(dotimes (x snek-width)
|
|
|
|
(gamegrid-set-cell x y snek-border)))
|
|
|
|
(cl-loop for y from 1 to (- snek-height 2) do
|
|
|
|
(cl-loop for x from 1 to (- snek-width 2) do
|
|
|
|
(gamegrid-set-cell x y snek-blank)))))
|
|
|
|
|
|
|
|
(defun snek-reset-game ()
|
|
|
|
(gamegrid-kill-timer)
|
|
|
|
(snek-init-buffer)
|
|
|
|
(setq snek-length snek-initial-length
|
|
|
|
snek-velocity-x snek-initial-velocity-x
|
|
|
|
snek-velocity-y snek-initial-velocity-y
|
|
|
|
snek-positions nil
|
|
|
|
snek-score 0
|
|
|
|
snek-paused nil
|
|
|
|
snek-moved-p nil
|
|
|
|
snek-velocity-queue nil)
|
|
|
|
(let ((x snek-initial-x)
|
|
|
|
(y snek-initial-y))
|
|
|
|
(dotimes (i snek-length)
|
|
|
|
(gamegrid-set-cell x y snek-snek)
|
|
|
|
(setq snek-positions (cons (vector x y) snek-positions))
|
|
|
|
(cl-incf x snek-velocity-x)
|
|
|
|
(cl-incf y snek-velocity-y)))
|
|
|
|
(snek-update-score))
|
|
|
|
|
|
|
|
(defun snek-set-dot ()
|
|
|
|
(let ((x (random snek-width))
|
|
|
|
(y (random snek-height)))
|
|
|
|
(while (not (= (gamegrid-get-cell x y) snek-blank))
|
|
|
|
(setq x (random snek-width))
|
|
|
|
(setq y (random snek-height)))
|
|
|
|
(gamegrid-set-cell x y snek-dot)))
|
|
|
|
|
|
|
|
(defun snek-update-game (snek-buffer)
|
|
|
|
"Called on each clock tick.
|
|
|
|
Advances the snek one square, testing for collision.
|
|
|
|
Argument SNEK-BUFFER is the name of the buffer."
|
|
|
|
(when (and (not snek-paused)
|
|
|
|
(eq (current-buffer) snek-buffer))
|
|
|
|
(snek-update-velocity)
|
|
|
|
(let* ((pos (car snek-positions))
|
|
|
|
(x (+ (aref pos 0) snek-velocity-x))
|
|
|
|
(y (+ (aref pos 1) snek-velocity-y))
|
|
|
|
(c (gamegrid-get-cell x y)))
|
|
|
|
(if (or (= c snek-border)
|
|
|
|
(= c snek-snek))
|
|
|
|
(snek-end-game)
|
|
|
|
(cond ((= c snek-dot)
|
|
|
|
(cl-incf snek-length)
|
|
|
|
(cl-incf snek-score)
|
|
|
|
(snek-update-score)
|
|
|
|
(snek-set-dot))
|
|
|
|
(t
|
|
|
|
(let* ((last-cons (nthcdr (- snek-length 2)
|
|
|
|
snek-positions))
|
|
|
|
(tail-pos (cadr last-cons))
|
|
|
|
(x0 (aref tail-pos 0))
|
|
|
|
(y0 (aref tail-pos 1)))
|
|
|
|
(gamegrid-set-cell x0 y0 snek-blank)
|
|
|
|
(setcdr last-cons nil))))
|
|
|
|
(gamegrid-set-cell x y snek-snek)
|
|
|
|
(setq snek-positions
|
|
|
|
(cons (vector x y) snek-positions))
|
|
|
|
(setq snek-moved-p nil)))))
|
|
|
|
|
|
|
|
(defun snek-update-velocity ()
|
|
|
|
(unless snek-moved-p
|
|
|
|
(if snek-velocity-queue
|
|
|
|
(let ((new-vel (car (last snek-velocity-queue))))
|
|
|
|
(setq snek-velocity-x (car new-vel)
|
|
|
|
snek-velocity-y (cadr new-vel))
|
|
|
|
(setq snek-velocity-queue
|
|
|
|
(nreverse (cdr (nreverse snek-velocity-queue))))))
|
|
|
|
(setq snek-moved-p t)))
|
|
|
|
|
|
|
|
(defun snek-final-x-velocity ()
|
|
|
|
(or (caar snek-velocity-queue)
|
|
|
|
snek-velocity-x))
|
|
|
|
|
|
|
|
(defun snek-final-y-velocity ()
|
|
|
|
(or (cadr (car snek-velocity-queue))
|
|
|
|
snek-velocity-y))
|
|
|
|
|
|
|
|
(defun snek-move-left ()
|
|
|
|
"Make the snek move left."
|
|
|
|
(interactive)
|
|
|
|
(when (zerop (snek-final-x-velocity))
|
|
|
|
(push '(-1 0) snek-velocity-queue)))
|
|
|
|
|
|
|
|
(defun snek-move-right ()
|
|
|
|
"Make the snek move right."
|
|
|
|
(interactive)
|
|
|
|
(when (zerop (snek-final-x-velocity))
|
|
|
|
(push '(1 0) snek-velocity-queue)))
|
|
|
|
|
|
|
|
(defun snek-move-up ()
|
|
|
|
"Make the snek move up."
|
|
|
|
(interactive)
|
|
|
|
(when (zerop (snek-final-y-velocity))
|
|
|
|
(push '(0 -1) snek-velocity-queue)))
|
|
|
|
|
|
|
|
(defun snek-move-down ()
|
|
|
|
"Make the snek move down."
|
|
|
|
(interactive)
|
|
|
|
(when (zerop (snek-final-y-velocity))
|
|
|
|
(push '(0 1) snek-velocity-queue)))
|
|
|
|
|
2021-04-21 17:58:07 +00:00
|
|
|
(defun player-move-left ()
|
|
|
|
"Make the player move left."
|
|
|
|
(interactive)
|
|
|
|
)
|
|
|
|
|
|
|
|
(defun player-move-right ()
|
|
|
|
"Make the player move right."
|
|
|
|
(interactive)
|
|
|
|
)
|
|
|
|
|
|
|
|
(defun player-move-up ()
|
|
|
|
"Make the player move up."
|
|
|
|
(interactive)
|
|
|
|
)
|
|
|
|
|
|
|
|
(defun player-move-down ()
|
|
|
|
"Make the player move down."
|
|
|
|
(interactive)
|
|
|
|
)
|
|
|
|
|
2021-04-21 17:33:13 +00:00
|
|
|
(defun snek-end-game ()
|
|
|
|
"Terminate the current game."
|
|
|
|
(interactive)
|
|
|
|
(gamegrid-kill-timer)
|
|
|
|
(use-local-map snek-null-map)
|
|
|
|
(gamegrid-add-score snek-score-file snek-score))
|
|
|
|
|
|
|
|
(defun snek-start-game ()
|
|
|
|
"Start a new game of Snek."
|
|
|
|
(interactive)
|
|
|
|
(snek-reset-game)
|
|
|
|
(snek-set-dot)
|
|
|
|
(use-local-map snek-mode-map)
|
|
|
|
(gamegrid-start-timer snek-tick-period 'snek-update-game))
|
|
|
|
|
|
|
|
(defun snek-pause-game ()
|
|
|
|
"Pause (or resume) the current game."
|
|
|
|
(interactive)
|
|
|
|
(setq snek-paused (not snek-paused))
|
|
|
|
(message (and snek-paused "Game paused (press p to resume)")))
|
|
|
|
|
|
|
|
(defun snek-active-p ()
|
|
|
|
(eq (current-local-map) snek-mode-map))
|
|
|
|
|
|
|
|
(put 'snek-mode 'mode-class 'special)
|
|
|
|
|
|
|
|
(define-derived-mode snek-mode special-mode "Snek"
|
|
|
|
"A mode for playing Snek."
|
|
|
|
|
|
|
|
(add-hook 'kill-buffer-hook 'gamegrid-kill-timer nil t)
|
|
|
|
|
|
|
|
(use-local-map snek-null-map)
|
|
|
|
|
|
|
|
(setq gamegrid-use-glyphs snek-use-glyphs-flag)
|
|
|
|
(setq gamegrid-use-color snek-use-color-flag)
|
|
|
|
|
|
|
|
(gamegrid-init (snek-display-options)))
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
(defun snek ()
|
|
|
|
"Play the Snek game.
|
|
|
|
Move the snek around without colliding with its tail or with the border.
|
|
|
|
|
|
|
|
Eating dots causes the snek to get longer.
|
|
|
|
|
|
|
|
Snek mode keybindings:
|
|
|
|
\\<snek-mode-map>
|
|
|
|
\\[snek-start-game] Starts a new game of Snek
|
|
|
|
\\[snek-end-game] Terminates the current game
|
|
|
|
\\[snek-pause-game] Pauses (or resumes) the current game
|
|
|
|
\\[snek-move-left] Makes the snek move left
|
|
|
|
\\[snek-move-right] Makes the snek move right
|
|
|
|
\\[snek-move-up] Makes the snek move up
|
|
|
|
\\[snek-move-down] Makes the snek move down"
|
|
|
|
(interactive)
|
|
|
|
|
|
|
|
(switch-to-buffer snek-buffer-name)
|
|
|
|
(gamegrid-kill-timer)
|
|
|
|
(snek-mode)
|
|
|
|
(snek-start-game))
|
|
|
|
|
|
|
|
(provide 'snek)
|
|
|
|
|
|
|
|
;;; snek.el ends here
|