Commit | Line | Data |
---|---|---|
c0274f38 ER |
1 | ;;; blackbox.el --- blackbox game in Emacs Lisp |
2 | ||
5fd6d89f | 3 | ;; Copyright (C) 1985, 1986, 1987, 1992, 2001, 2002, 2003, 2004, |
5df4f04c | 4 | ;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. |
9750e079 | 5 | |
5de9bdab | 6 | ;; Author: F. Thomas May <uw-nsr!uw-warp!tom@beaver.cs.washington.edu> |
5de9bdab ER |
7 | ;; Adapted-By: ESR |
8 | ;; Keywords: games | |
9 | ||
0231f2dc JB |
10 | ;; This file is part of GNU Emacs. |
11 | ||
b1fc2b50 | 12 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
0231f2dc | 13 | ;; it under the terms of the GNU General Public License as published by |
b1fc2b50 GM |
14 | ;; the Free Software Foundation, either version 3 of the License, or |
15 | ;; (at your option) any later version. | |
0231f2dc JB |
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 | |
b1fc2b50 | 23 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
0231f2dc | 24 | |
5de9bdab ER |
25 | ;;; Commentary: |
26 | ||
b578f267 EN |
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 | |
29 | ;; interface improvements by ESR, Dec 5 1991. | |
0231f2dc | 30 | |
b578f267 EN |
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. | |
a1506d29 | 36 | ;; |
b578f267 EN |
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. | |
a1506d29 JB |
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 | ;; | |
b578f267 | 51 | ;; Rays which enter and exit are numbered. You can see that rays 1 & 5 pass |
47b5f6d6 | 52 | ;; thru the box undisturbed. Ray 2 is deflected by the northwesternmost |
b578f267 EN |
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 | |
47b5f6d6 | 56 | ;; reflected. Consider the H on the bottom next to the 4. It bounces off |
b578f267 EN |
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. | |
0231f2dc | 67 | |
5de9bdab ER |
68 | ;;; Code: |
69 | ||
49b83be9 PJ |
70 | (defvar bb-board nil |
71 | "Blackbox board.") | |
72 | ||
73 | (defvar bb-x -1 | |
74 | "Current x-position.") | |
75 | ||
76 | (defvar bb-y -1 | |
77 | "Current y-position.") | |
78 | ||
79 | (defvar bb-score 0 | |
80 | "Current score.") | |
81 | ||
82 | (defvar bb-detour-count 0 | |
83 | "Number of detours.") | |
84 | ||
85 | (defvar bb-balls-placed nil | |
86 | "List of already placed balls.") | |
87 | ||
35b1f2e9 EZ |
88 | ;; This is used below to remap existing bindings for cursor motion to |
89 | ;; blackbox-specific bindings in blackbox-mode-map. This is so that | |
90 | ;; users who prefer non-default key bindings for cursor motion don't | |
91 | ;; lose that when they play Blackbox. | |
47b5f6d6 | 92 | (defun blackbox-redefine-key (map oldfun newfun) |
35b1f2e9 | 93 | "Redefine keys that run the function OLDFUN to run NEWFUN instead." |
47b5f6d6 SM |
94 | (define-key map (vector 'remap oldfun) newfun)) |
95 | ||
96 | ||
97 | (defvar blackbox-mode-map | |
98 | (let ((map (make-keymap))) | |
99 | (suppress-keymap map t) | |
100 | (blackbox-redefine-key map 'backward-char 'bb-left) | |
101 | (blackbox-redefine-key map 'forward-char 'bb-right) | |
102 | (blackbox-redefine-key map 'previous-line 'bb-up) | |
103 | (blackbox-redefine-key map 'next-line 'bb-down) | |
104 | (blackbox-redefine-key map 'move-end-of-line 'bb-eol) | |
105 | (blackbox-redefine-key map 'move-beginning-of-line 'bb-bol) | |
106 | (define-key map " " 'bb-romp) | |
c14bb1fb | 107 | (define-key map "q" 'bury-buffer) |
47b5f6d6 | 108 | (define-key map [insert] 'bb-romp) |
c14bb1fb | 109 | (define-key map [return] 'bb-done) |
47b5f6d6 SM |
110 | (blackbox-redefine-key map 'newline 'bb-done) |
111 | map)) | |
0231f2dc JB |
112 | |
113 | ;; Blackbox mode is suitable only for specially formatted data. | |
114 | (put 'blackbox-mode 'mode-class 'special) | |
115 | ||
116 | (defun blackbox-mode () | |
6d8b258a PJ |
117 | "Major mode for playing blackbox. |
118 | To learn how to play blackbox, see the documentation for function `blackbox'. | |
0231f2dc JB |
119 | |
120 | The usual mnemonic keys move the cursor around the box. | |
121 | \\<blackbox-mode-map>\\[bb-bol] and \\[bb-eol] move to the beginning and end of line, respectively. | |
122 | ||
123 | \\[bb-romp] -- send in a ray from point, or toggle a ball at point | |
09e99870 | 124 | \\[bb-done] -- end game and get score" |
0231f2dc JB |
125 | (interactive) |
126 | (kill-all-local-variables) | |
127 | (use-local-map blackbox-mode-map) | |
128 | (setq truncate-lines t) | |
129 | (setq major-mode 'blackbox-mode) | |
09e99870 LK |
130 | (setq mode-name "Blackbox") |
131 | (run-mode-hooks 'blackbox-mode-hook)) | |
0231f2dc | 132 | |
daa37602 | 133 | ;;;###autoload |
0231f2dc | 134 | (defun blackbox (num) |
6d8b258a PJ |
135 | "Play blackbox. |
136 | Optional prefix argument is the number of balls; the default is 4. | |
0231f2dc JB |
137 | |
138 | What is blackbox? | |
139 | ||
140 | Blackbox is a game of hide and seek played on an 8 by 8 grid (the | |
141 | Blackbox). Your opponent (Emacs, in this case) has hidden several | |
142 | balls (usually 4) within this box. By shooting rays into the box and | |
143 | observing where they emerge it is possible to deduce the positions of | |
144 | the hidden balls. The fewer rays you use to find the balls, the lower | |
145 | your score. | |
146 | ||
147 | Overview of play: | |
148 | ||
151bdc83 JB |
149 | \\<blackbox-mode-map>\ |
150 | To play blackbox, type \\[blackbox]. An optional prefix argument | |
151 | specifies the number of balls to be hidden in the box; the default is | |
152 | four. | |
0231f2dc JB |
153 | |
154 | The cursor can be moved around the box with the standard cursor | |
155 | movement keys. | |
156 | ||
157 | To shoot a ray, move the cursor to the edge of the box and press SPC. | |
158 | The result will be determined and the playfield updated. | |
159 | ||
160 | You may place or remove balls in the box by moving the cursor into the | |
151bdc83 | 161 | box and pressing \\[bb-romp]. |
0231f2dc JB |
162 | |
163 | When you think the configuration of balls you have placed is correct, | |
151bdc83 JB |
164 | press \\[bb-done]. You will be informed whether you are correct or |
165 | not, and be given your score. Your score is the number of letters and | |
166 | numbers around the outside of the box plus five for each incorrectly | |
167 | placed ball. If you placed any balls incorrectly, they will be | |
168 | indicated with `x', and their actual positions indicated with `o'. | |
0231f2dc JB |
169 | |
170 | Details: | |
171 | ||
172 | There are three possible outcomes for each ray you send into the box: | |
173 | ||
174 | Detour: the ray is deflected and emerges somewhere other than | |
175 | where you sent it in. On the playfield, detours are | |
176 | denoted by matching pairs of numbers -- one where the | |
177 | ray went in, and the other where it came out. | |
178 | ||
179 | Reflection: the ray is reflected and emerges in the same place | |
180 | it was sent in. On the playfield, reflections are | |
181 | denoted by the letter `R'. | |
182 | ||
183 | Hit: the ray strikes a ball directly and is absorbed. It does | |
184 | not emerge from the box. On the playfield, hits are | |
185 | denoted by the letter `H'. | |
186 | ||
187 | The rules for how balls deflect rays are simple and are best shown by | |
188 | example. | |
189 | ||
190 | As a ray approaches a ball it is deflected ninety degrees. Rays can | |
191 | be deflected multiple times. In the diagrams below, the dashes | |
192 | represent empty box locations and the letter `O' represents a ball. | |
193 | The entrance and exit points of each ray are marked with numbers as | |
194 | described under \"Detour\" above. Note that the entrance and exit | |
195 | points are always interchangeable. `*' denotes the path taken by the | |
196 | ray. | |
197 | ||
198 | Note carefully the relative positions of the ball and the ninety | |
199 | degree deflection it causes. | |
200 | ||
a1506d29 JB |
201 | 1 |
202 | - * - - - - - - - - - - - - - - - - - - - - - - | |
203 | - * - - - - - - - - - - - - - - - - - - - - - - | |
204 | 1 * * - - - - - - - - - - - - - - - O - - - - O - | |
0231f2dc JB |
205 | - - O - - - - - - - O - - - - - - - * * * * - - |
206 | - - - - - - - - - - - * * * * * 2 3 * * * - - * - - | |
a1506d29 JB |
207 | - - - - - - - - - - - * - - - - - - - O - * - - |
208 | - - - - - - - - - - - * - - - - - - - - * * - - | |
209 | - - - - - - - - - - - * - - - - - - - - * - O - | |
0231f2dc JB |
210 | 2 3 |
211 | ||
212 | As mentioned above, a reflection occurs when a ray emerges from the same point | |
213 | it was sent in. This can happen in several ways: | |
214 | ||
a1506d29 | 215 | |
0231f2dc JB |
216 | - - - - - - - - - - - - - - - - - - - - - - - - |
217 | - - - - O - - - - - O - O - - - - - - - - - - - | |
218 | R * * * * - - - - - - - * - - - - O - - - - - - - | |
219 | - - - - O - - - - - - * - - - - R - - - - - - - - | |
220 | - - - - - - - - - - - * - - - - - - - - - - - - | |
221 | - - - - - - - - - - - * - - - - - - - - - - - - | |
222 | - - - - - - - - R * * * * - - - - - - - - - - - - | |
223 | - - - - - - - - - - - - O - - - - - - - - - - - | |
224 | ||
225 | In the first example, the ray is deflected downwards by the upper | |
226 | ball, then left by the lower ball, and finally retraces its path to | |
227 | its point of origin. The second example is similar. The third | |
228 | example is a bit anomalous but can be rationalized by realizing the | |
229 | ray never gets a chance to get into the box. Alternatively, the ray | |
230 | can be thought of as being deflected downwards and immediately | |
231 | emerging from the box. | |
232 | ||
233 | A hit occurs when a ray runs straight into a ball: | |
234 | ||
235 | - - - - - - - - - - - - - - - - - - - - - - - - | |
236 | - - - - - - - - - - - - - - - - - - - - O - - - | |
237 | - - - - - - - - - - - - O - - - H * * * * - - - - | |
238 | - - - - - - - - H * * * * O - - - - - - * - - - - | |
239 | - - - - - - - - - - - - O - - - - - - O - - - - | |
240 | H * * * O - - - - - - - - - - - - - - - - - - - - | |
241 | - - - - - - - - - - - - - - - - - - - - - - - - | |
242 | - - - - - - - - - - - - - - - - - - - - - - - - | |
243 | ||
244 | Be sure to compare the second example of a hit with the first example of | |
245 | a reflection." | |
246 | (interactive "P") | |
247 | (switch-to-buffer "*Blackbox*") | |
248 | (blackbox-mode) | |
249 | (setq buffer-read-only t) | |
250 | (buffer-disable-undo (current-buffer)) | |
251 | (setq bb-board (bb-init-board (or num 4))) | |
252 | (setq bb-balls-placed nil) | |
253 | (setq bb-x -1) | |
254 | (setq bb-y -1) | |
255 | (setq bb-score 0) | |
256 | (setq bb-detour-count 0) | |
257 | (bb-insert-board) | |
258 | (bb-goto (cons bb-x bb-y))) | |
259 | ||
260 | (defun bb-init-board (num-balls) | |
261 | (random t) | |
262 | (let (board pos) | |
263 | (while (>= (setq num-balls (1- num-balls)) 0) | |
264 | (while | |
265 | (progn | |
266 | (setq pos (cons (random 8) (random 8))) | |
49b83be9 | 267 | (member pos board))) |
0231f2dc JB |
268 | (setq board (cons pos board))) |
269 | board)) | |
270 | ||
271 | (defun bb-insert-board () | |
272 | (let (i (buffer-read-only nil)) | |
273 | (erase-buffer) | |
274 | (insert " \n") | |
275 | (setq i 8) | |
276 | (while (>= (setq i (1- i)) 0) | |
277 | (insert " - - - - - - - - \n")) | |
278 | (insert " \n") | |
279 | (insert (format "\nThere are %d balls in the box" (length bb-board))) | |
280 | )) | |
281 | ||
4bd2c013 RS |
282 | (defun bb-right (count) |
283 | (interactive "p") | |
284 | (while (and (> count 0) (< bb-x 8)) | |
0231f2dc | 285 | (forward-char 2) |
4bd2c013 RS |
286 | (setq bb-x (1+ bb-x)) |
287 | (setq count (1- count)))) | |
0231f2dc | 288 | |
4bd2c013 RS |
289 | (defun bb-left (count) |
290 | (interactive "p") | |
291 | (while (and (> count 0) (> bb-x -1)) | |
0231f2dc | 292 | (backward-char 2) |
4bd2c013 RS |
293 | (setq bb-x (1- bb-x)) |
294 | (setq count (1- count)))) | |
0231f2dc | 295 | |
4bd2c013 RS |
296 | (defun bb-up (count) |
297 | (interactive "p") | |
298 | (while (and (> count 0) (> bb-y -1)) | |
395bbcd3 | 299 | (with-no-warnings (previous-line)) |
4bd2c013 RS |
300 | (setq bb-y (1- bb-y)) |
301 | (setq count (1- count)))) | |
0231f2dc | 302 | |
4bd2c013 RS |
303 | (defun bb-down (count) |
304 | (interactive "p") | |
305 | (while (and (> count 0) (< bb-y 8)) | |
395bbcd3 | 306 | (with-no-warnings (next-line)) |
4bd2c013 RS |
307 | (setq bb-y (1+ bb-y)) |
308 | (setq count (1- count)))) | |
0231f2dc JB |
309 | |
310 | (defun bb-eol () | |
311 | (interactive) | |
312 | (setq bb-x 8) | |
313 | (bb-goto (cons bb-x bb-y))) | |
314 | ||
315 | (defun bb-bol () | |
316 | (interactive) | |
317 | (setq bb-x -1) | |
318 | (bb-goto (cons bb-x bb-y))) | |
319 | ||
320 | (defun bb-romp () | |
321 | (interactive) | |
322 | (cond | |
323 | ((and | |
324 | (or (= bb-x -1) (= bb-x 8)) | |
325 | (or (= bb-y -1) (= bb-y 8)))) | |
326 | ((bb-outside-box bb-x bb-y) | |
327 | (bb-trace-ray bb-x bb-y)) | |
328 | (t | |
329 | (bb-place-ball bb-x bb-y)))) | |
330 | ||
331 | (defun bb-place-ball (x y) | |
332 | (let ((coord (cons x y))) | |
333 | (cond | |
49b83be9 PJ |
334 | ((member coord bb-balls-placed) |
335 | (setq bb-balls-placed (delete coord bb-balls-placed)) | |
0231f2dc JB |
336 | (bb-update-board "-")) |
337 | (t | |
338 | (setq bb-balls-placed (cons coord bb-balls-placed)) | |
49b83be9 | 339 | (bb-update-board (propertize "O" 'help-echo "Placed ball")))))) |
0231f2dc JB |
340 | |
341 | (defun bb-trace-ray (x y) | |
18a6a207 TTN |
342 | (when (= (following-char) 32) |
343 | (let ((result (bb-trace-ray-2 | |
344 | t | |
345 | x | |
346 | (cond | |
347 | ((= x -1) 1) | |
348 | ((= x 8) -1) | |
349 | (t 0)) | |
350 | y | |
351 | (cond | |
352 | ((= y -1) 1) | |
353 | ((= y 8) -1) | |
354 | (t 0))))) | |
355 | (cond | |
356 | ((eq result 'hit) | |
357 | (bb-update-board (propertize "H" 'help-echo "Hit")) | |
358 | (setq bb-score (1+ bb-score))) | |
359 | ((equal result (cons x y)) | |
360 | (bb-update-board (propertize "R" 'help-echo "Reflection")) | |
361 | (setq bb-score (1+ bb-score))) | |
362 | (t | |
363 | (setq bb-detour-count (1+ bb-detour-count)) | |
364 | (bb-update-board (propertize (format "%d" bb-detour-count) | |
365 | 'help-echo "Detour")) | |
366 | (save-excursion | |
367 | (bb-goto result) | |
368 | (bb-update-board (propertize (format "%d" bb-detour-count) | |
369 | 'help-echo "Detour"))) | |
370 | (setq bb-score (+ bb-score 2))))))) | |
0231f2dc JB |
371 | |
372 | (defun bb-trace-ray-2 (first x dx y dy) | |
373 | (cond | |
374 | ((and (not first) | |
375 | (bb-outside-box x y)) | |
376 | (cons x y)) | |
49b83be9 | 377 | ((member (cons (+ x dx) (+ y dy)) bb-board) |
0231f2dc | 378 | 'hit) |
49b83be9 | 379 | ((member (cons (+ x dx dy) (+ y dy dx)) bb-board) |
0231f2dc | 380 | (bb-trace-ray-2 nil x (- dy) y (- dx))) |
49b83be9 | 381 | ((member (cons (+ x dx (- dy)) (+ y dy (- dx))) bb-board) |
0231f2dc JB |
382 | (bb-trace-ray-2 nil x dy y dx)) |
383 | (t | |
384 | (bb-trace-ray-2 nil (+ x dx) dx (+ y dy) dy)))) | |
385 | ||
386 | (defun bb-done () | |
387 | "Finish the game and report score." | |
388 | (interactive) | |
389 | (let (bogus-balls) | |
390 | (cond | |
391 | ((not (= (length bb-balls-placed) (length bb-board))) | |
392 | (message "There %s %d hidden ball%s; you have placed %d." | |
393 | (if (= (length bb-board) 1) "is" "are") | |
394 | (length bb-board) | |
395 | (if (= (length bb-board) 1) "" "s") | |
396 | (length bb-balls-placed))) | |
397 | (t | |
398 | (setq bogus-balls (bb-show-bogus-balls bb-balls-placed bb-board)) | |
399 | (if (= bogus-balls 0) | |
400 | (message "Right! Your score is %d." bb-score) | |
401 | (message "Oops! You missed %d ball%s. Your score is %d." | |
402 | bogus-balls | |
403 | (if (= bogus-balls 1) "" "s") | |
404 | (+ bb-score (* 5 bogus-balls)))) | |
405 | (bb-goto '(-1 . -1)))))) | |
406 | ||
407 | (defun bb-show-bogus-balls (balls-placed board) | |
408 | (bb-show-bogus-balls-2 balls-placed board "x") | |
409 | (bb-show-bogus-balls-2 board balls-placed "o")) | |
410 | ||
411 | (defun bb-show-bogus-balls-2 (list-1 list-2 c) | |
412 | (cond | |
413 | ((null list-1) | |
414 | 0) | |
49b83be9 | 415 | ((member (car list-1) list-2) |
0231f2dc JB |
416 | (bb-show-bogus-balls-2 (cdr list-1) list-2 c)) |
417 | (t | |
418 | (bb-goto (car list-1)) | |
419 | (bb-update-board c) | |
420 | (1+ (bb-show-bogus-balls-2 (cdr list-1) list-2 c))))) | |
421 | ||
151bdc83 JB |
422 | (defun bb-outside-box (x y) |
423 | (or (= x -1) (= x 8) (= y -1) (= y 8))) | |
0231f2dc JB |
424 | |
425 | (defun bb-goto (pos) | |
426 | (goto-char (+ (* (car pos) 2) (* (cdr pos) 22) 26))) | |
427 | ||
428 | (defun bb-update-board (c) | |
429 | (let ((buffer-read-only nil)) | |
430 | (backward-char (1- (length c))) | |
431 | (delete-char (length c)) | |
432 | (insert c) | |
433 | (backward-char 1))) | |
a1506d29 | 434 | |
896546cd RS |
435 | (provide 'blackbox) |
436 | ||
47b5f6d6 | 437 | ;; arch-tag: 6c474c62-5617-4b10-9b44-ac430168c0e2 |
c0274f38 | 438 | ;;; blackbox.el ends here |