1;;; blackbox.el --- blackbox game in Emacs Lisp 2 3;; Copyright (C) 1985, 1986, 1987, 1992, 2001, 2002, 2003, 2004, 4;; 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: F. Thomas May <uw-nsr!uw-warp!tom@beaver.cs.washington.edu> 7;; Adapted-By: ESR 8;; Keywords: games 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 14;; the Free Software Foundation; either version 2, or (at your option) 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 the 24;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 25;; Boston, MA 02110-1301, USA. 26 27;;; Commentary: 28 29;; by F. Thomas May <uw-nsr!uw-warp!tom@beaver.cs.washington.edu> 30;; doc comment by Root Boy Jim <rbj@dsys.icst.nbs.gov>, 27 Apr 89 31;; interface improvements by ESR, Dec 5 1991. 32 33;; The object of the game is to find four hidden balls by shooting rays 34;; into the black box. There are four possibilities: 1) the ray will 35;; pass thru the box undisturbed, 2) it will hit a ball and be absorbed, 36;; 3) it will be deflected and exit the box, or 4) be deflected immediately, 37;; not even being allowed entry into the box. 38;; 39;; The strange part is the method of deflection. It seems that rays will 40;; not pass next to a ball, and change direction at right angles to avoid it. 41;; 42;; R 3 43;; 1 - - - - - - - - 1 44;; - - - - - - - - 45;; - O - - - - - - 3 46;; 2 - - - - O - O - 47;; 4 - - - - - - - - 48;; 5 - - - - - - - - 5 49;; - - - - - - - - R 50;; H - - - - - - - O 51;; 2 H 4 H 52;; 53;; Rays which enter and exit are numbered. You can see that rays 1 & 5 pass 54;; thru the box undisturbed. Ray 2 is deflected by the northwesternmost 55;; ball. Likewise rays 3 and 4. Rays which hit balls and are absorbed are 56;; marked with H. The bottom of the left and the right of the bottom hit 57;; the southeastern ball directly. Rays may also hit balls after being 58;; reflected. Consider the H on the bottom next to the 4. It bounces off 59;; the NW-ern most ball and hits the central ball. A ray shot from above 60;; the right side 5 would hit the SE-ern most ball. The R beneath the 5 61;; is because the ball is returned instantly. It is not allowed into 62;; the box if it would reflect immediately. The R on the top is a more 63;; leisurely return. Both central balls would tend to deflect it east 64;; or west, but it cannot go either way, so it just retreats. 65;; 66;; At the end of the game, if you've placed guesses for as many balls as 67;; there are in the box, the true board position will be revealed. Each 68;; `x' is an incorrect guess of yours; `o' is the true location of a ball. 69 70;;; Code: 71 72(defvar bb-board nil 73 "Blackbox board.") 74 75(defvar bb-x -1 76 "Current x-position.") 77 78(defvar bb-y -1 79 "Current y-position.") 80 81(defvar bb-score 0 82 "Current score.") 83 84(defvar bb-detour-count 0 85 "Number of detours.") 86 87(defvar bb-balls-placed nil 88 "List of already placed balls.") 89 90;; This is used below to remap existing bindings for cursor motion to 91;; blackbox-specific bindings in blackbox-mode-map. This is so that 92;; users who prefer non-default key bindings for cursor motion don't 93;; lose that when they play Blackbox. 94(defun blackbox-redefine-key (map oldfun newfun) 95 "Redefine keys that run the function OLDFUN to run NEWFUN instead." 96 (define-key map (vector 'remap oldfun) newfun)) 97 98 99(defvar blackbox-mode-map 100 (let ((map (make-keymap))) 101 (suppress-keymap map t) 102 (blackbox-redefine-key map 'backward-char 'bb-left) 103 (blackbox-redefine-key map 'forward-char 'bb-right) 104 (blackbox-redefine-key map 'previous-line 'bb-up) 105 (blackbox-redefine-key map 'next-line 'bb-down) 106 (blackbox-redefine-key map 'move-end-of-line 'bb-eol) 107 (blackbox-redefine-key map 'move-beginning-of-line 'bb-bol) 108 (define-key map " " 'bb-romp) 109 (define-key map [insert] 'bb-romp) 110 (blackbox-redefine-key map 'newline 'bb-done) 111 map)) 112 113;; Blackbox mode is suitable only for specially formatted data. 114(put 'blackbox-mode 'mode-class 'special) 115 116(defun blackbox-mode () 117 "Major mode for playing blackbox. 118To learn how to play blackbox, see the documentation for function `blackbox'. 119 120The 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 124\\[bb-done] -- end game and get score" 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) 130 (setq mode-name "Blackbox") 131 (run-mode-hooks 'blackbox-mode-hook)) 132 133;;;###autoload 134(defun blackbox (num) 135 "Play blackbox. 136Optional prefix argument is the number of balls; the default is 4. 137 138What is blackbox? 139 140Blackbox is a game of hide and seek played on an 8 by 8 grid (the 141Blackbox). Your opponent (Emacs, in this case) has hidden several 142balls (usually 4) within this box. By shooting rays into the box and 143observing where they emerge it is possible to deduce the positions of 144the hidden balls. The fewer rays you use to find the balls, the lower 145your score. 146 147Overview of play: 148 149\\<blackbox-mode-map>\ 150To play blackbox, type \\[blackbox]. An optional prefix argument 151specifies the number of balls to be hidden in the box; the default is 152four. 153 154The cursor can be moved around the box with the standard cursor 155movement keys. 156 157To shoot a ray, move the cursor to the edge of the box and press SPC. 158The result will be determined and the playfield updated. 159 160You may place or remove balls in the box by moving the cursor into the 161box and pressing \\[bb-romp]. 162 163When you think the configuration of balls you have placed is correct, 164press \\[bb-done]. You will be informed whether you are correct or 165not, and be given your score. Your score is the number of letters and 166numbers around the outside of the box plus five for each incorrectly 167placed ball. If you placed any balls incorrectly, they will be 168indicated with `x', and their actual positions indicated with `o'. 169 170Details: 171 172There 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 187The rules for how balls deflect rays are simple and are best shown by 188example. 189 190As a ray approaches a ball it is deflected ninety degrees. Rays can 191be deflected multiple times. In the diagrams below, the dashes 192represent empty box locations and the letter `O' represents a ball. 193The entrance and exit points of each ray are marked with numbers as 194described under \"Detour\" above. Note that the entrance and exit 195points are always interchangeable. `*' denotes the path taken by the 196ray. 197 198Note carefully the relative positions of the ball and the ninety 199degree deflection it causes. 200 201 1 202 - * - - - - - - - - - - - - - - - - - - - - - - 203 - * - - - - - - - - - - - - - - - - - - - - - - 2041 * * - - - - - - - - - - - - - - - O - - - - O - 205 - - O - - - - - - - O - - - - - - - * * * * - - 206 - - - - - - - - - - - * * * * * 2 3 * * * - - * - - 207 - - - - - - - - - - - * - - - - - - - O - * - - 208 - - - - - - - - - - - * - - - - - - - - * * - - 209 - - - - - - - - - - - * - - - - - - - - * - O - 210 2 3 211 212As mentioned above, a reflection occurs when a ray emerges from the same point 213it was sent in. This can happen in several ways: 214 215 216 - - - - - - - - - - - - - - - - - - - - - - - - 217 - - - - O - - - - - O - O - - - - - - - - - - - 218R * * * * - - - - - - - * - - - - O - - - - - - - 219 - - - - O - - - - - - * - - - - R - - - - - - - - 220 - - - - - - - - - - - * - - - - - - - - - - - - 221 - - - - - - - - - - - * - - - - - - - - - - - - 222 - - - - - - - - R * * * * - - - - - - - - - - - - 223 - - - - - - - - - - - - O - - - - - - - - - - - 224 225In the first example, the ray is deflected downwards by the upper 226ball, then left by the lower ball, and finally retraces its path to 227its point of origin. The second example is similar. The third 228example is a bit anomalous but can be rationalized by realizing the 229ray never gets a chance to get into the box. Alternatively, the ray 230can be thought of as being deflected downwards and immediately 231emerging from the box. 232 233A hit occurs when a ray runs straight into a ball: 234 235 - - - - - - - - - - - - - - - - - - - - - - - - 236 - - - - - - - - - - - - - - - - - - - - O - - - 237 - - - - - - - - - - - - O - - - H * * * * - - - - 238 - - - - - - - - H * * * * O - - - - - - * - - - - 239 - - - - - - - - - - - - O - - - - - - O - - - - 240H * * * O - - - - - - - - - - - - - - - - - - - - 241 - - - - - - - - - - - - - - - - - - - - - - - - 242 - - - - - - - - - - - - - - - - - - - - - - - - 243 244Be sure to compare the second example of a hit with the first example of 245a 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))) 267 (member pos board))) 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 282(defun bb-right (count) 283 (interactive "p") 284 (while (and (> count 0) (< bb-x 8)) 285 (forward-char 2) 286 (setq bb-x (1+ bb-x)) 287 (setq count (1- count)))) 288 289(defun bb-left (count) 290 (interactive "p") 291 (while (and (> count 0) (> bb-x -1)) 292 (backward-char 2) 293 (setq bb-x (1- bb-x)) 294 (setq count (1- count)))) 295 296(defun bb-up (count) 297 (interactive "p") 298 (while (and (> count 0) (> bb-y -1)) 299 (previous-line 1) 300 (setq bb-y (1- bb-y)) 301 (setq count (1- count)))) 302 303(defun bb-down (count) 304 (interactive "p") 305 (while (and (> count 0) (< bb-y 8)) 306 (next-line 1) 307 (setq bb-y (1+ bb-y)) 308 (setq count (1- count)))) 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 334 ((member coord bb-balls-placed) 335 (setq bb-balls-placed (delete coord bb-balls-placed)) 336 (bb-update-board "-")) 337 (t 338 (setq bb-balls-placed (cons coord bb-balls-placed)) 339 (bb-update-board (propertize "O" 'help-echo "Placed ball")))))) 340 341(defun bb-trace-ray (x y) 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))))))) 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)) 377 ((member (cons (+ x dx) (+ y dy)) bb-board) 378 'hit) 379 ((member (cons (+ x dx dy) (+ y dy dx)) bb-board) 380 (bb-trace-ray-2 nil x (- dy) y (- dx))) 381 ((member (cons (+ x dx (- dy)) (+ y dy (- dx))) bb-board) 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) 415 ((member (car list-1) list-2) 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 422(defun bb-outside-box (x y) 423 (or (= x -1) (= x 8) (= y -1) (= y 8))) 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))) 434 435(provide 'blackbox) 436 437;; arch-tag: 6c474c62-5617-4b10-9b44-ac430168c0e2 438;;; blackbox.el ends here 439