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