no-step-on-snek/no-step-on-snek.el

;;; 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))
    (((glyph color-x) [0 1 0])
     (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)
                  ((= c snek-player)
                   snek-player-options)
                  (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)))

(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)
  )

(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