comparison lisp/play/snake.el @ 43464:dc17128932c4

(snake-velocity-queue, snake-update-velocity) (snake-final-x-velocity, snake-final-y-velocity): New variable and functions. Store user's keypresses into a queue and pop from the queue each subsequent turn. (snake-update-game, snake-move-left) (snake-move-right, snake-move-up, snake-move-down, snake-active-p) (snake-start-game): Use that queue. (snake-use-glyphs-flag): Renamed from snake-use-glyphs. (snake-use-color-flag): Likewise. (snake-mode): Rename uses of those variables.

43463:9fbf31526ff4

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

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

(put 'snake-mode 'mode-class 'special)

(defun snake-mode ()
  "A mode for playing Snake.

snake-mode keybindings:
   \\{snake-mode-map}
"
  (kill-all-local-variables)

  (add-hook 'kill-buffer-hook 'gamegrid-kill-timer nil t)

	  ["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))

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

43464:dc17128932c4

(require 'gamegrid)

;; ;;;;;;;;;;;;; customization variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar snake-use-glyphs-flag t
  "Non-nil means use glyphs when available.")

(defvar snake-use-color-flag t
  "Non-nil means use color when available.")

(defvar snake-buffer-name "*Snake*"
  "Name used for Snake buffer.")

(defvar snake-velocity-y 0)
(defvar snake-positions nil)
(defvar snake-cycle 0)
(defvar snake-score 0)
(defvar snake-paused nil)
(defvar snake-moved-p nil)
(defvar snake-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 snake to move up just once before starting to move left.  If
we implemented all your keystrokes immediately, the snake 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 '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)
(make-variable-buffer-local 'snake-moved-p)
(make-variable-buffer-local 'snake-velocity-queue)

;; ;;;;;;;;;;;;; keymaps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar snake-mode-map
  (make-sparse-keymap 'snake-mode-map))

	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
	snake-moved-p           nil
	snake-velocity-queue    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 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.
Argument SNAKE-BUFFER is the name of the buffer."
  (when (and (not snake-paused)
	     (eq (current-buffer) snake-buffer))
    (snake-update-velocity)
    (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))
	  (setq snake-moved-p nil)))))

(defun snake-update-velocity ()
  (unless snake-moved-p
    (if snake-velocity-queue
	(let ((new-vel (car (last snake-velocity-queue))))
	  (setq snake-velocity-x (car new-vel)
		snake-velocity-y (cadr new-vel))
	  (setq snake-velocity-queue
		(nreverse (cdr (nreverse snake-velocity-queue))))))
    (setq snake-moved-p t)))

(defun snake-final-x-velocity ()
  (or (caar snake-velocity-queue)
      snake-velocity-x))

(defun snake-final-y-velocity ()
  (or (cadr (car snake-velocity-queue))
      snake-velocity-y))

(defun snake-move-left ()
  "Make the snake move left."
  (interactive)
  (when (zerop (snake-final-x-velocity))
    (push '(-1 0) snake-velocity-queue)))

(defun snake-move-right ()
  "Make the snake move right."
  (interactive)
  (when (zerop (snake-final-x-velocity))
    (push '(1 0) snake-velocity-queue)))

(defun snake-move-up ()
  "Make the snake move up."
  (interactive)
  (when (zerop (snake-final-y-velocity))
    (push '(0 -1) snake-velocity-queue)))

(defun snake-move-down ()
  "Make the snake move down."
  (interactive)
  (when (zerop (snake-final-y-velocity))
    (push '(0 1) snake-velocity-queue)))

(defun snake-end-game ()
  "Terminate 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 ()
  "Start 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 ()
  "Pause (or resume) the current game."
  (interactive)
  (setq snake-paused (not snake-paused))
  (message (and snake-paused "Game paused (press p to resume)")))

(defun snake-active-p ()

(put 'snake-mode 'mode-class 'special)

(defun snake-mode ()
  "A mode for playing Snake.

Snake mode keybindings:
   \\{snake-mode-map}
"
  (kill-all-local-variables)

  (add-hook 'kill-buffer-hook 'gamegrid-kill-timer nil t)

	  ["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-flag)
  (setq gamegrid-use-color snake-use-color-flag)

  (gamegrid-init (snake-display-options))

  (run-hooks 'snake-mode-hook))

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