Mercurial > emacs
annotate lisp/play/blackbox.el @ 1241:de92360b091b
(timer-process-sentinel): Don't set timer-scratch.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Mon, 28 Sep 1992 12:41:39 +0000 |
parents | 213978acbc1e |
children | 507f64624555 |
rev | line source |
---|---|
662
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
473
diff
changeset
|
1 ;;; blackbox.el --- blackbox game in Emacs Lisp |
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
473
diff
changeset
|
2 |
845 | 3 ;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc. |
4 | |
801
e9e34745ae3b
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
727
diff
changeset
|
5 ;; Author: F. Thomas May <uw-nsr!uw-warp!tom@beaver.cs.washington.edu> |
e9e34745ae3b
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
727
diff
changeset
|
6 ;; Adapted-By: ESR |
e9e34745ae3b
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
727
diff
changeset
|
7 ;; Keywords: games |
e9e34745ae3b
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
727
diff
changeset
|
8 |
473 | 9 ;; This file is part of GNU Emacs. |
10 | |
11 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 ;; it under the terms of the GNU General Public License as published by | |
727 | 13 ;; the Free Software Foundation; either version 2, or (at your option) |
473 | 14 ;; any later version. |
15 | |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
22 ;; along with GNU Emacs; see the file COPYING. If not, write to | |
23 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
24 | |
801
e9e34745ae3b
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
727
diff
changeset
|
25 ;;; Commentary: |
e9e34745ae3b
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
727
diff
changeset
|
26 |
473 | 27 ; by F. Thomas May <uw-nsr!uw-warp!tom@beaver.cs.washington.edu> |
28 ; doc comment by Root Boy Jim <rbj@dsys.icst.nbs.gov>, 27 Apr 89 | |
801
e9e34745ae3b
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
727
diff
changeset
|
29 ; interface improvements by ESR, Dec 5 1991. |
473 | 30 |
31 ; The object of the game is to find four hidden balls by shooting rays | |
32 ; into the black box. There are four possibilities: 1) the ray will | |
33 ; pass thru the box undisturbed, 2) it will hit a ball and be absorbed, | |
34 ; 3) it will be deflected and exit the box, or 4) be deflected immediately, | |
35 ; not even being allowed entry into the box. | |
36 ; | |
37 ; The strange part is the method of deflection. It seems that rays will | |
38 ; not pass next to a ball, and change direction at right angles to avoid it. | |
39 ; | |
40 ; R 3 | |
41 ; 1 - - - - - - - - 1 | |
42 ; - - - - - - - - | |
43 ; - O - - - - - - 3 | |
44 ; 2 - - - - O - O - | |
45 ; 4 - - - - - - - - | |
46 ; 5 - - - - - - - - 5 | |
47 ; - - - - - - - - R | |
48 ; H - - - - - - - O | |
49 ; 2 H 4 H | |
50 ; | |
51 ; Rays which enter and exit are numbered. You can see that rays 1 & 5 pass | |
52 ; thru the box undisturbed. Ray 2 is deflected by the northwesternmost | |
53 ; ball. Likewise rays 3 and 4. Rays which hit balls and are absorbed are | |
54 ; marked with H. The bottom of the left and the right of the bottom hit | |
55 ; the southeastern ball directly. Rays may also hit balls after being | |
56 ; reflected. Consider the H on the bottom next to the 4. It bounces off | |
57 ; the NW-ern most ball and hits the central ball. A ray shot from above | |
58 ; the right side 5 would hit the SE-ern most ball. The R beneath the 5 | |
59 ; is because the ball is returned instantly. It is not allowed into | |
60 ; the box if it would reflect immediately. The R on the top is a more | |
61 ; leisurely return. Both central balls would tend to deflect it east | |
62 ; or west, but it cannot go either way, so it just retreats. | |
63 ; | |
64 ; At the end of the game, if you've placed guesses for as many balls as | |
65 ; there are in the box, the true board position will be revealed. Each | |
66 ; `x' is an incorrect guess of yours; `o' is the true location of a ball. | |
67 | |
801
e9e34745ae3b
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
727
diff
changeset
|
68 ;;; Code: |
e9e34745ae3b
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
727
diff
changeset
|
69 |
473 | 70 (defvar blackbox-mode-map nil "") |
71 | |
72 (if blackbox-mode-map | |
73 () | |
74 (setq blackbox-mode-map (make-keymap)) | |
75 (suppress-keymap blackbox-mode-map t) | |
76 (define-key blackbox-mode-map "\C-f" 'bb-right) | |
77 (define-key blackbox-mode-map "\C-b" 'bb-left) | |
78 (define-key blackbox-mode-map "\C-p" 'bb-up) | |
79 (define-key blackbox-mode-map "\C-n" 'bb-down) | |
80 (define-key blackbox-mode-map "\C-e" 'bb-eol) | |
81 (define-key blackbox-mode-map "\C-a" 'bb-bol) | |
82 (define-key blackbox-mode-map " " 'bb-romp) | |
826 | 83 (define-key blackbox-mode-map [insert] 'bb-romp) |
473 | 84 (define-key blackbox-mode-map "\C-m" 'bb-done) |
826 | 85 (define-key blackbox-mode-map [kp-enter] 'bb-done) |
473 | 86 |
87 ;; This is a kluge. What we really want is a general | |
88 ;; feature for reminding terminal keys to the functions | |
826 | 89 ;; corresponding to them in local maps. |
90 (mapcar (function | |
91 (lambda (funk) | |
92 (mapcar (function | |
93 (lambda (key) | |
94 (define-key blackbox-mode-map key funk))) | |
95 (where-is-internal funk)))) | |
96 '(previous-line next-line backward-character forward-character))) | |
473 | 97 |
98 ;; Blackbox mode is suitable only for specially formatted data. | |
99 (put 'blackbox-mode 'mode-class 'special) | |
100 | |
101 (defun blackbox-mode () | |
102 "Major mode for playing blackbox. To learn how to play blackbox, | |
103 see the documentation for function `blackbox'. | |
104 | |
105 The usual mnemonic keys move the cursor around the box. | |
106 \\<blackbox-mode-map>\\[bb-bol] and \\[bb-eol] move to the beginning and end of line, respectively. | |
107 | |
108 \\[bb-romp] -- send in a ray from point, or toggle a ball at point | |
109 \\[bb-done] -- end game and get score | |
110 " | |
111 (interactive) | |
112 (kill-all-local-variables) | |
113 (use-local-map blackbox-mode-map) | |
114 (setq truncate-lines t) | |
115 (setq major-mode 'blackbox-mode) | |
116 (setq mode-name "Blackbox")) | |
117 | |
727 | 118 ;;;###autoload |
473 | 119 (defun blackbox (num) |
120 "Play blackbox. Optional prefix argument is the number of balls; | |
121 the default is 4. | |
122 | |
123 What is blackbox? | |
124 | |
125 Blackbox is a game of hide and seek played on an 8 by 8 grid (the | |
126 Blackbox). Your opponent (Emacs, in this case) has hidden several | |
127 balls (usually 4) within this box. By shooting rays into the box and | |
128 observing where they emerge it is possible to deduce the positions of | |
129 the hidden balls. The fewer rays you use to find the balls, the lower | |
130 your score. | |
131 | |
132 Overview of play: | |
133 | |
826 | 134 \\<blackbox-mode-map>\ |
135 To play blackbox, type \\[blackbox]. An optional prefix argument | |
136 specifies the number of balls to be hidden in the box; the default is | |
137 four. | |
473 | 138 |
139 The cursor can be moved around the box with the standard cursor | |
140 movement keys. | |
141 | |
142 To shoot a ray, move the cursor to the edge of the box and press SPC. | |
143 The result will be determined and the playfield updated. | |
144 | |
145 You may place or remove balls in the box by moving the cursor into the | |
826 | 146 box and pressing \\[bb-romp]. |
473 | 147 |
148 When you think the configuration of balls you have placed is correct, | |
826 | 149 press \\[bb-done]. You will be informed whether you are correct or |
150 not, and be given your score. Your score is the number of letters and | |
151 numbers around the outside of the box plus five for each incorrectly | |
152 placed ball. If you placed any balls incorrectly, they will be | |
153 indicated with `x', and their actual positions indicated with `o'. | |
473 | 154 |
155 Details: | |
156 | |
157 There are three possible outcomes for each ray you send into the box: | |
158 | |
159 Detour: the ray is deflected and emerges somewhere other than | |
160 where you sent it in. On the playfield, detours are | |
161 denoted by matching pairs of numbers -- one where the | |
162 ray went in, and the other where it came out. | |
163 | |
164 Reflection: the ray is reflected and emerges in the same place | |
165 it was sent in. On the playfield, reflections are | |
166 denoted by the letter `R'. | |
167 | |
168 Hit: the ray strikes a ball directly and is absorbed. It does | |
169 not emerge from the box. On the playfield, hits are | |
170 denoted by the letter `H'. | |
171 | |
172 The rules for how balls deflect rays are simple and are best shown by | |
173 example. | |
174 | |
175 As a ray approaches a ball it is deflected ninety degrees. Rays can | |
176 be deflected multiple times. In the diagrams below, the dashes | |
177 represent empty box locations and the letter `O' represents a ball. | |
178 The entrance and exit points of each ray are marked with numbers as | |
179 described under \"Detour\" above. Note that the entrance and exit | |
180 points are always interchangeable. `*' denotes the path taken by the | |
181 ray. | |
182 | |
183 Note carefully the relative positions of the ball and the ninety | |
184 degree deflection it causes. | |
185 | |
186 1 | |
187 - * - - - - - - - - - - - - - - - - - - - - - - | |
188 - * - - - - - - - - - - - - - - - - - - - - - - | |
189 1 * * - - - - - - - - - - - - - - - O - - - - O - | |
190 - - O - - - - - - - O - - - - - - - * * * * - - | |
191 - - - - - - - - - - - * * * * * 2 3 * * * - - * - - | |
192 - - - - - - - - - - - * - - - - - - - O - * - - | |
193 - - - - - - - - - - - * - - - - - - - - * * - - | |
194 - - - - - - - - - - - * - - - - - - - - * - O - | |
195 2 3 | |
196 | |
197 As mentioned above, a reflection occurs when a ray emerges from the same point | |
198 it was sent in. This can happen in several ways: | |
199 | |
200 | |
201 - - - - - - - - - - - - - - - - - - - - - - - - | |
202 - - - - O - - - - - O - O - - - - - - - - - - - | |
203 R * * * * - - - - - - - * - - - - O - - - - - - - | |
204 - - - - O - - - - - - * - - - - R - - - - - - - - | |
205 - - - - - - - - - - - * - - - - - - - - - - - - | |
206 - - - - - - - - - - - * - - - - - - - - - - - - | |
207 - - - - - - - - R * * * * - - - - - - - - - - - - | |
208 - - - - - - - - - - - - O - - - - - - - - - - - | |
209 | |
210 In the first example, the ray is deflected downwards by the upper | |
211 ball, then left by the lower ball, and finally retraces its path to | |
212 its point of origin. The second example is similar. The third | |
213 example is a bit anomalous but can be rationalized by realizing the | |
214 ray never gets a chance to get into the box. Alternatively, the ray | |
215 can be thought of as being deflected downwards and immediately | |
216 emerging from the box. | |
217 | |
218 A hit occurs when a ray runs straight into a ball: | |
219 | |
220 - - - - - - - - - - - - - - - - - - - - - - - - | |
221 - - - - - - - - - - - - - - - - - - - - O - - - | |
222 - - - - - - - - - - - - O - - - H * * * * - - - - | |
223 - - - - - - - - H * * * * O - - - - - - * - - - - | |
224 - - - - - - - - - - - - O - - - - - - O - - - - | |
225 H * * * O - - - - - - - - - - - - - - - - - - - - | |
226 - - - - - - - - - - - - - - - - - - - - - - - - | |
227 - - - - - - - - - - - - - - - - - - - - - - - - | |
228 | |
229 Be sure to compare the second example of a hit with the first example of | |
230 a reflection." | |
231 (interactive "P") | |
232 (switch-to-buffer "*Blackbox*") | |
233 (blackbox-mode) | |
234 (setq buffer-read-only t) | |
235 (buffer-disable-undo (current-buffer)) | |
236 (setq bb-board (bb-init-board (or num 4))) | |
237 (setq bb-balls-placed nil) | |
238 (setq bb-x -1) | |
239 (setq bb-y -1) | |
240 (setq bb-score 0) | |
241 (setq bb-detour-count 0) | |
242 (bb-insert-board) | |
243 (bb-goto (cons bb-x bb-y))) | |
244 | |
245 (defun bb-init-board (num-balls) | |
246 (random t) | |
247 (let (board pos) | |
248 (while (>= (setq num-balls (1- num-balls)) 0) | |
249 (while | |
250 (progn | |
251 (setq pos (cons (random 8) (random 8))) | |
252 (bb-member pos board))) | |
253 (setq board (cons pos board))) | |
254 board)) | |
255 | |
256 (defun bb-insert-board () | |
257 (let (i (buffer-read-only nil)) | |
258 (erase-buffer) | |
259 (insert " \n") | |
260 (setq i 8) | |
261 (while (>= (setq i (1- i)) 0) | |
262 (insert " - - - - - - - - \n")) | |
263 (insert " \n") | |
264 (insert (format "\nThere are %d balls in the box" (length bb-board))) | |
265 )) | |
266 | |
267 (defun bb-right () | |
268 (interactive) | |
269 (if (= bb-x 8) | |
270 () | |
271 (forward-char 2) | |
272 (setq bb-x (1+ bb-x)))) | |
273 | |
274 (defun bb-left () | |
275 (interactive) | |
276 (if (= bb-x -1) | |
277 () | |
278 (backward-char 2) | |
279 (setq bb-x (1- bb-x)))) | |
280 | |
281 (defun bb-up () | |
282 (interactive) | |
283 (if (= bb-y -1) | |
284 () | |
285 (previous-line 1) | |
286 (setq bb-y (1- bb-y)))) | |
287 | |
288 (defun bb-down () | |
289 (interactive) | |
290 (if (= bb-y 8) | |
291 () | |
292 (next-line 1) | |
293 (setq bb-y (1+ bb-y)))) | |
294 | |
295 (defun bb-eol () | |
296 (interactive) | |
297 (setq bb-x 8) | |
298 (bb-goto (cons bb-x bb-y))) | |
299 | |
300 (defun bb-bol () | |
301 (interactive) | |
302 (setq bb-x -1) | |
303 (bb-goto (cons bb-x bb-y))) | |
304 | |
305 (defun bb-romp () | |
306 (interactive) | |
307 (cond | |
308 ((and | |
309 (or (= bb-x -1) (= bb-x 8)) | |
310 (or (= bb-y -1) (= bb-y 8)))) | |
311 ((bb-outside-box bb-x bb-y) | |
312 (bb-trace-ray bb-x bb-y)) | |
313 (t | |
314 (bb-place-ball bb-x bb-y)))) | |
315 | |
316 (defun bb-place-ball (x y) | |
317 (let ((coord (cons x y))) | |
318 (cond | |
319 ((bb-member coord bb-balls-placed) | |
320 (setq bb-balls-placed (bb-delete coord bb-balls-placed)) | |
321 (bb-update-board "-")) | |
322 (t | |
323 (setq bb-balls-placed (cons coord bb-balls-placed)) | |
324 (bb-update-board "O"))))) | |
325 | |
326 (defun bb-trace-ray (x y) | |
327 (let ((result (bb-trace-ray-2 | |
328 t | |
329 x | |
330 (cond | |
331 ((= x -1) 1) | |
332 ((= x 8) -1) | |
333 (t 0)) | |
334 y | |
335 (cond | |
336 ((= y -1) 1) | |
337 ((= y 8) -1) | |
338 (t 0))))) | |
339 (cond | |
340 ((eq result 'hit) | |
341 (bb-update-board "H") | |
342 (setq bb-score (1+ bb-score))) | |
343 ((equal result (cons x y)) | |
344 (bb-update-board "R") | |
345 (setq bb-score (1+ bb-score))) | |
346 (t | |
347 (setq bb-detour-count (1+ bb-detour-count)) | |
348 (bb-update-board (format "%d" bb-detour-count)) | |
349 (save-excursion | |
350 (bb-goto result) | |
351 (bb-update-board (format "%d" bb-detour-count))) | |
352 (setq bb-score (+ bb-score 2)))))) | |
353 | |
354 (defun bb-trace-ray-2 (first x dx y dy) | |
355 (cond | |
356 ((and (not first) | |
357 (bb-outside-box x y)) | |
358 (cons x y)) | |
359 ((bb-member (cons (+ x dx) (+ y dy)) bb-board) | |
360 'hit) | |
361 ((bb-member (cons (+ x dx dy) (+ y dy dx)) bb-board) | |
362 (bb-trace-ray-2 nil x (- dy) y (- dx))) | |
363 ((bb-member (cons (+ x dx (- dy)) (+ y dy (- dx))) bb-board) | |
364 (bb-trace-ray-2 nil x dy y dx)) | |
365 (t | |
366 (bb-trace-ray-2 nil (+ x dx) dx (+ y dy) dy)))) | |
367 | |
368 (defun bb-done () | |
369 "Finish the game and report score." | |
370 (interactive) | |
371 (let (bogus-balls) | |
372 (cond | |
373 ((not (= (length bb-balls-placed) (length bb-board))) | |
374 (message "There %s %d hidden ball%s; you have placed %d." | |
375 (if (= (length bb-board) 1) "is" "are") | |
376 (length bb-board) | |
377 (if (= (length bb-board) 1) "" "s") | |
378 (length bb-balls-placed))) | |
379 (t | |
380 (setq bogus-balls (bb-show-bogus-balls bb-balls-placed bb-board)) | |
381 (if (= bogus-balls 0) | |
382 (message "Right! Your score is %d." bb-score) | |
383 (message "Oops! You missed %d ball%s. Your score is %d." | |
384 bogus-balls | |
385 (if (= bogus-balls 1) "" "s") | |
386 (+ bb-score (* 5 bogus-balls)))) | |
387 (bb-goto '(-1 . -1)))))) | |
388 | |
389 (defun bb-show-bogus-balls (balls-placed board) | |
390 (bb-show-bogus-balls-2 balls-placed board "x") | |
391 (bb-show-bogus-balls-2 board balls-placed "o")) | |
392 | |
393 (defun bb-show-bogus-balls-2 (list-1 list-2 c) | |
394 (cond | |
395 ((null list-1) | |
396 0) | |
397 ((bb-member (car list-1) list-2) | |
398 (bb-show-bogus-balls-2 (cdr list-1) list-2 c)) | |
399 (t | |
400 (bb-goto (car list-1)) | |
401 (bb-update-board c) | |
402 (1+ (bb-show-bogus-balls-2 (cdr list-1) list-2 c))))) | |
403 | |
826 | 404 (defun bb-outside-box (x y) |
405 (or (= x -1) (= x 8) (= y -1) (= y 8))) | |
473 | 406 |
407 (defun bb-goto (pos) | |
408 (goto-char (+ (* (car pos) 2) (* (cdr pos) 22) 26))) | |
409 | |
410 (defun bb-update-board (c) | |
411 (let ((buffer-read-only nil)) | |
412 (backward-char (1- (length c))) | |
413 (delete-char (length c)) | |
414 (insert c) | |
415 (backward-char 1))) | |
416 | |
417 (defun bb-member (elt list) | |
418 "Returns non-nil if ELT is an element of LIST." | |
419 (eval (cons 'or (mapcar (function (lambda (x) (equal x elt))) list)))) | |
420 | |
421 (defun bb-delete (item list) | |
422 "Deletes ITEM from LIST and returns a copy." | |
423 (cond | |
424 ((equal item (car list)) (cdr list)) | |
425 (t (cons (car list) (bb-delete item (cdr list)))))) | |
662
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
473
diff
changeset
|
426 |
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
473
diff
changeset
|
427 ;;; blackbox.el ends here |