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