annotate lisp/play/snake.el @ 67955:6f397fdf1671

*** empty log message ***
author Eli Zaretskii <eliz@gnu.org>
date Sat, 31 Dec 2005 11:47:05 +0000
parents 34bd8e434dd7
children 836785857446 edf295560b5a
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
38425
c6e12c6b1498 Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents: 22489
diff changeset
1 ;;; snake.el --- implementation of Snake for Emacs
22488
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2
64701
34bd8e434dd7 Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 64391
diff changeset
3 ;; Copyright (C) 1997, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
22488
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
4
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
5 ;; Author: Glynn Clements <glynn@sensei.co.uk>
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
6 ;; Created: 1997-09-10
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
7 ;; Keywords: games
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
8
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
9 ;; This file is part of GNU Emacs.
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
10
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
12 ;; it under the terms of the GNU General Public License as published by
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
13 ;; the Free Software Foundation; either version 2, or (at your option)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
14 ;; any later version.
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
15
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
16 ;; GNU Emacs is distributed in the hope that it will be useful,
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
19 ;; GNU General Public License for more details.
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
20
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
21 ;; You should have received a copy of the GNU General Public License
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
64085
18a818a2ee7c Update FSF's address.
Lute Kamstra <lute@gnu.org>
parents: 62770
diff changeset
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
18a818a2ee7c Update FSF's address.
Lute Kamstra <lute@gnu.org>
parents: 62770
diff changeset
24 ;; Boston, MA 02110-1301, USA.
22488
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
25
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
26 ;;; Commentary:
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
27
38425
c6e12c6b1498 Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents: 22489
diff changeset
28 ;;; Code:
c6e12c6b1498 Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents: 22489
diff changeset
29
22488
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
30 (eval-when-compile
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
31 (require 'cl))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
32
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
33 (require 'gamegrid)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
34
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
35 ;; ;;;;;;;;;;;;; customization variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
36
43464
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
37 (defvar snake-use-glyphs-flag t
22488
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
38 "Non-nil means use glyphs when available.")
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
39
43464
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
40 (defvar snake-use-color-flag t
22488
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
41 "Non-nil means use color when available.")
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
42
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
43 (defvar snake-buffer-name "*Snake*"
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
44 "Name used for Snake buffer.")
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
45
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
46 (defvar snake-buffer-width 30
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
47 "Width of used portion of buffer.")
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
48
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
49 (defvar snake-buffer-height 22
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
50 "Height of used portion of buffer.")
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
51
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
52 (defvar snake-width 30
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
53 "Width of playing area.")
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
54
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
55 (defvar snake-height 20
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
56 "Height of playing area.")
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
57
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
58 (defvar snake-initial-length 5
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
59 "Initial length of snake.")
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
60
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
61 (defvar snake-initial-x 10
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
62 "Initial X position of snake.")
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
63
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
64 (defvar snake-initial-y 10
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
65 "Initial Y position of snake.")
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
66
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
67 (defvar snake-initial-velocity-x 1
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
68 "Initial X velocity of snake.")
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
69
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
70 (defvar snake-initial-velocity-y 0
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
71 "Initial Y velocity of snake.")
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
72
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
73 (defvar snake-tick-period 0.2
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
74 "The default time taken for the snake to advance one square.")
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
75
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
76 (defvar snake-mode-hook nil
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
77 "Hook run upon starting Snake.")
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
78
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
79 (defvar snake-score-x 0
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
80 "X position of score.")
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
81
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
82 (defvar snake-score-y snake-height
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
83 "Y position of score.")
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
84
43650
93a9551db080 (snake-score-file): Put in home dir, not in /tmp.
Richard M. Stallman <rms@gnu.org>
parents: 43464
diff changeset
85 ;; It is not safe to put this in /tmp.
43655
1ae60187a39d fixed parens in the last patch
Sam Steingold <sds@gnu.org>
parents: 43650
diff changeset
86 ;; Someone could make a symlink in /tmp
43650
93a9551db080 (snake-score-file): Put in home dir, not in /tmp.
Richard M. Stallman <rms@gnu.org>
parents: 43464
diff changeset
87 ;; pointing to a file you don't want to clobber.
44484
d47ceb68ccc8 (snake-score-file): Default to just "snake-scores".
Colin Walters <walters@gnu.org>
parents: 43655
diff changeset
88 (defvar snake-score-file "snake-scores"
22488
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
89 "File for holding high scores.")
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
90
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
91 ;; ;;;;;;;;;;;;; display options ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
92
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
93 (defvar snake-blank-options
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
94 '(((glyph colorize)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
95 (t ?\040))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
96 ((color-x color-x)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
97 (mono-x grid-x)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
98 (color-tty color-tty))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
99 (((glyph color-x) [0 0 0])
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
100 (color-tty "black"))))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
101
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
102 (defvar snake-snake-options
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
103 '(((glyph colorize)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
104 (emacs-tty ?O)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
105 (t ?\040))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
106 ((color-x color-x)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
107 (mono-x mono-x)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
108 (color-tty color-tty)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
109 (mono-tty mono-tty))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
110 (((glyph color-x) [1 1 0])
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
111 (color-tty "yellow"))))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
112
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
113 (defvar snake-dot-options
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
114 '(((glyph colorize)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
115 (t ?\*))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
116 ((color-x color-x)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
117 (mono-x grid-x)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
118 (color-tty color-tty))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
119 (((glyph color-x) [1 0 0])
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
120 (color-tty "red"))))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
121
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
122 (defvar snake-border-options
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
123 '(((glyph colorize)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
124 (t ?\+))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
125 ((color-x color-x)
47460
2b50b378bb16 (snake-border-options): Use color on tty if available.
Francesco Potortì <pot@gnu.org>
parents: 44484
diff changeset
126 (mono-x grid-x)
2b50b378bb16 (snake-border-options): Use color on tty if available.
Francesco Potortì <pot@gnu.org>
parents: 44484
diff changeset
127 (color-tty color-tty))
22488
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
128 (((glyph color-x) [0.5 0.5 0.5])
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
129 (color-tty "white"))))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
130
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
131 (defvar snake-space-options
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
132 '(((t ?\040))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
133 nil
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
134 nil))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
135
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
136 ;; ;;;;;;;;;;;;; constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
137
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
138 (defconst snake-blank 0)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
139 (defconst snake-snake 1)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
140 (defconst snake-dot 2)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
141 (defconst snake-border 3)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
142 (defconst snake-space 4)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
143
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
144 ;; ;;;;;;;;;;;;; variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
145
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
146 (defvar snake-length 0)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
147 (defvar snake-velocity-x 1)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
148 (defvar snake-velocity-y 0)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
149 (defvar snake-positions nil)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
150 (defvar snake-cycle 0)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
151 (defvar snake-score 0)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
152 (defvar snake-paused nil)
43464
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
153 (defvar snake-moved-p nil)
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
154 (defvar snake-velocity-queue nil
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
155 "This queue stores the velocities requested too quickly by user.
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
156 They will take effect one at a time at each clock-interval.
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
157 This is necessary for proper behavior.
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
158
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
159 For instance, if you are moving right, you press up and then left, you
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
160 want the snake to move up just once before starting to move left. If
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
161 we implemented all your keystrokes immediately, the snake would
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
162 effectively never move up. Thus, we need to move it up for one turn
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
163 and then start moving it leftwards.")
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
164
22488
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
165
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
166 (make-variable-buffer-local 'snake-length)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
167 (make-variable-buffer-local 'snake-velocity-x)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
168 (make-variable-buffer-local 'snake-velocity-y)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
169 (make-variable-buffer-local 'snake-positions)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
170 (make-variable-buffer-local 'snake-cycle)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
171 (make-variable-buffer-local 'snake-score)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
172 (make-variable-buffer-local 'snake-paused)
43464
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
173 (make-variable-buffer-local 'snake-moved-p)
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
174 (make-variable-buffer-local 'snake-velocity-queue)
22488
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
175
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
176 ;; ;;;;;;;;;;;;; keymaps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
177
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
178 (defvar snake-mode-map
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
179 (make-sparse-keymap 'snake-mode-map))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
180
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
181 (define-key snake-mode-map "n" 'snake-start-game)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
182 (define-key snake-mode-map "q" 'snake-end-game)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
183 (define-key snake-mode-map "p" 'snake-pause-game)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
184
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
185 (define-key snake-mode-map [left] 'snake-move-left)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
186 (define-key snake-mode-map [right] 'snake-move-right)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
187 (define-key snake-mode-map [up] 'snake-move-up)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
188 (define-key snake-mode-map [down] 'snake-move-down)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
189
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
190 (defvar snake-null-map
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
191 (make-sparse-keymap 'snake-null-map))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
192
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
193 (define-key snake-null-map "n" 'snake-start-game)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
194
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
195 ;; ;;;;;;;;;;;;;;;; game functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
196
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
197 (defun snake-display-options ()
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
198 (let ((options (make-vector 256 nil)))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
199 (loop for c from 0 to 255 do
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
200 (aset options c
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
201 (cond ((= c snake-blank)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
202 snake-blank-options)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
203 ((= c snake-snake)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
204 snake-snake-options)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
205 ((= c snake-dot)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
206 snake-dot-options)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
207 ((= c snake-border)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
208 snake-border-options)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
209 ((= c snake-space)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
210 snake-space-options)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
211 (t
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
212 '(nil nil nil)))))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
213 options))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
214
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
215 (defun snake-update-score ()
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
216 (let* ((string (format "Score: %05d" snake-score))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
217 (len (length string)))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
218 (loop for x from 0 to (1- len) do
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
219 (gamegrid-set-cell (+ snake-score-x x)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
220 snake-score-y
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
221 (aref string x)))))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
222
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
223 (defun snake-init-buffer ()
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
224 (gamegrid-init-buffer snake-buffer-width
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
225 snake-buffer-height
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
226 snake-space)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
227 (let ((buffer-read-only nil))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
228 (loop for y from 0 to (1- snake-height) do
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
229 (loop for x from 0 to (1- snake-width) do
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
230 (gamegrid-set-cell x y snake-border)))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
231 (loop for y from 1 to (- snake-height 2) do
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
232 (loop for x from 1 to (- snake-width 2) do
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
233 (gamegrid-set-cell x y snake-blank)))))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
234
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
235 (defun snake-reset-game ()
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
236 (gamegrid-kill-timer)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
237 (snake-init-buffer)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
238 (setq snake-length snake-initial-length
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
239 snake-velocity-x snake-initial-velocity-x
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
240 snake-velocity-y snake-initial-velocity-y
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
241 snake-positions nil
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
242 snake-cycle 1
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
243 snake-score 0
43464
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
244 snake-paused nil
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
245 snake-moved-p nil
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
246 snake-velocity-queue nil)
22488
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
247 (let ((x snake-initial-x)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
248 (y snake-initial-y))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
249 (dotimes (i snake-length)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
250 (gamegrid-set-cell x y snake-snake)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
251 (setq snake-positions (cons (vector x y) snake-positions))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
252 (incf x snake-velocity-x)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
253 (incf y snake-velocity-y)))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
254 (snake-update-score))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
255
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
256 (defun snake-update-game (snake-buffer)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
257 "Called on each clock tick.
43464
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
258 Advances the snake one square, testing for collision.
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
259 Argument SNAKE-BUFFER is the name of the buffer."
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
260 (when (and (not snake-paused)
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
261 (eq (current-buffer) snake-buffer))
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
262 (snake-update-velocity)
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
263 (let* ((pos (car snake-positions))
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
264 (x (+ (aref pos 0) snake-velocity-x))
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
265 (y (+ (aref pos 1) snake-velocity-y))
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
266 (c (gamegrid-get-cell x y)))
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
267 (if (or (= c snake-border)
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
268 (= c snake-snake))
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
269 (snake-end-game)
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
270 (cond ((= c snake-dot)
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
271 (incf snake-length)
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
272 (incf snake-score)
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
273 (snake-update-score))
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
274 (t
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
275 (let* ((last-cons (nthcdr (- snake-length 2)
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
276 snake-positions))
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
277 (tail-pos (cadr last-cons))
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
278 (x0 (aref tail-pos 0))
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
279 (y0 (aref tail-pos 1)))
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
280 (gamegrid-set-cell x0 y0
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
281 (if (= (% snake-cycle 5) 0)
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
282 snake-dot
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
283 snake-blank))
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
284 (incf snake-cycle)
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
285 (setcdr last-cons nil))))
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
286 (gamegrid-set-cell x y snake-snake)
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
287 (setq snake-positions
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
288 (cons (vector x y) snake-positions))
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
289 (setq snake-moved-p nil)))))
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
290
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
291 (defun snake-update-velocity ()
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
292 (unless snake-moved-p
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
293 (if snake-velocity-queue
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
294 (let ((new-vel (car (last snake-velocity-queue))))
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
295 (setq snake-velocity-x (car new-vel)
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
296 snake-velocity-y (cadr new-vel))
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
297 (setq snake-velocity-queue
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
298 (nreverse (cdr (nreverse snake-velocity-queue))))))
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
299 (setq snake-moved-p t)))
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
300
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
301 (defun snake-final-x-velocity ()
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
302 (or (caar snake-velocity-queue)
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
303 snake-velocity-x))
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
304
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
305 (defun snake-final-y-velocity ()
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
306 (or (cadr (car snake-velocity-queue))
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
307 snake-velocity-y))
22488
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
308
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
309 (defun snake-move-left ()
43464
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
310 "Make the snake move left."
22488
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
311 (interactive)
43464
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
312 (when (zerop (snake-final-x-velocity))
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
313 (push '(-1 0) snake-velocity-queue)))
22488
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
314
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
315 (defun snake-move-right ()
43464
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
316 "Make the snake move right."
22488
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
317 (interactive)
43464
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
318 (when (zerop (snake-final-x-velocity))
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
319 (push '(1 0) snake-velocity-queue)))
22488
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
320
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
321 (defun snake-move-up ()
43464
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
322 "Make the snake move up."
22488
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
323 (interactive)
43464
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
324 (when (zerop (snake-final-y-velocity))
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
325 (push '(0 -1) snake-velocity-queue)))
22488
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
326
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
327 (defun snake-move-down ()
43464
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
328 "Make the snake move down."
22488
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
329 (interactive)
43464
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
330 (when (zerop (snake-final-y-velocity))
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
331 (push '(0 1) snake-velocity-queue)))
22488
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
332
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
333 (defun snake-end-game ()
43464
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
334 "Terminate the current game."
22488
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
335 (interactive)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
336 (gamegrid-kill-timer)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
337 (use-local-map snake-null-map)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
338 (gamegrid-add-score snake-score-file snake-score))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
339
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
340 (defun snake-start-game ()
43464
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
341 "Start a new game of Snake."
22488
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
342 (interactive)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
343 (snake-reset-game)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
344 (use-local-map snake-mode-map)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
345 (gamegrid-start-timer snake-tick-period 'snake-update-game))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
346
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
347 (defun snake-pause-game ()
43464
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
348 "Pause (or resume) the current game."
22488
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
349 (interactive)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
350 (setq snake-paused (not snake-paused))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
351 (message (and snake-paused "Game paused (press p to resume)")))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
352
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
353 (defun snake-active-p ()
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
354 (eq (current-local-map) snake-mode-map))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
355
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
356 (put 'snake-mode 'mode-class 'special)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
357
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
358 (defun snake-mode ()
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
359 "A mode for playing Snake.
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
360
43464
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
361 Snake mode keybindings:
22488
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
362 \\{snake-mode-map}
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
363 "
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
364 (kill-all-local-variables)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
365
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
366 (add-hook 'kill-buffer-hook 'gamegrid-kill-timer nil t)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
367
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
368 (use-local-map snake-null-map)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
369
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
370 (setq major-mode 'snake-mode)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
371 (setq mode-name "Snake")
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
372
64391
1818c2670a66 (snake-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents: 64085
diff changeset
373 (unless (featurep 'emacs)
1818c2670a66 (snake-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents: 64085
diff changeset
374 (setq mode-popup-menu
1818c2670a66 (snake-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents: 64085
diff changeset
375 '("Snake Commands"
1818c2670a66 (snake-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents: 64085
diff changeset
376 ["Start new game" snake-start-game]
1818c2670a66 (snake-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents: 64085
diff changeset
377 ["End game" snake-end-game
1818c2670a66 (snake-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents: 64085
diff changeset
378 (snake-active-p)]
1818c2670a66 (snake-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents: 64085
diff changeset
379 ["Pause" snake-pause-game
1818c2670a66 (snake-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents: 64085
diff changeset
380 (and (snake-active-p) (not snake-paused))]
1818c2670a66 (snake-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents: 64085
diff changeset
381 ["Resume" snake-pause-game
1818c2670a66 (snake-mode): Avoid warning.
Richard M. Stallman <rms@gnu.org>
parents: 64085
diff changeset
382 (and (snake-active-p) snake-paused)])))
22488
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
383
43464
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
384 (setq gamegrid-use-glyphs snake-use-glyphs-flag)
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
385 (setq gamegrid-use-color snake-use-color-flag)
22488
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
386
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
387 (gamegrid-init (snake-display-options))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
388
62770
93e71f3dcd14 * play/5x5.el (5x5-mode):
Lute Kamstra <lute@gnu.org>
parents: 62249
diff changeset
389 (run-mode-hooks 'snake-mode-hook))
22488
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
390
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
391 ;;;###autoload
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
392 (defun snake ()
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
393 "Play the Snake game.
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
394 Move the snake around without colliding with its tail or with the border.
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
395
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
396 Eating dots causes the snake to get longer.
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
397
43464
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
398 Snake mode keybindings:
22488
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
399 \\<snake-mode-map>
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
400 \\[snake-start-game] Starts a new game of Snake
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
401 \\[snake-end-game] Terminates the current game
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
402 \\[snake-pause-game] Pauses (or resumes) the current game
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
403 \\[snake-move-left] Makes the snake move left
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
404 \\[snake-move-right] Makes the snake move right
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
405 \\[snake-move-up] Makes the snake move up
43464
dc17128932c4 (snake-velocity-queue, snake-update-velocity)
Richard M. Stallman <rms@gnu.org>
parents: 41485
diff changeset
406 \\[snake-move-down] Makes the snake move down"
22488
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
407 (interactive)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
408
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
409 (switch-to-buffer snake-buffer-name)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
410 (gamegrid-kill-timer)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
411 (snake-mode)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
412 (snake-start-game))
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
413
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
414 (provide 'snake)
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
415
52401
695cf19ef79e Add arch taglines
Miles Bader <miles@gnu.org>
parents: 47460
diff changeset
416 ;;; arch-tag: 512ffc92-cfac-4287-9a4e-92890701a5c8
22488
e4d597ddd2d0 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
417 ;;; snake.el ends here