1;;; blackbox.el --- blackbox game in Emacs Lisp 2 3;; Copyright (C) 1985-1987, 1992, 2001-2021 Free Software Foundation, 4;; 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 3 of the License, or 15;; (at your option) 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. If not, see <https://www.gnu.org/licenses/>. 24 25;;; Commentary: 26 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. 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 68;;; Code: 69 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 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. 92(defun blackbox-redefine-key (map oldfun newfun) 93 "Redefine keys that run the function OLDFUN to run NEWFUN instead." 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 'left-char 'bb-left) 102 (blackbox-redefine-key map 'forward-char 'bb-right) 103 (blackbox-redefine-key map 'right-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 "q" 'bury-buffer) 110 (define-key map [insert] 'bb-romp) 111 (define-key map [return] 'bb-done) 112 (blackbox-redefine-key map 'newline 'bb-done) 113 map)) 114 115;; Blackbox mode is suitable only for specially formatted data. 116 117(define-derived-mode blackbox-mode special-mode "Blackbox" 118 "Major mode for playing blackbox. 119To learn how to play blackbox, see the documentation for function `blackbox'. 120 121The usual mnemonic keys move the cursor around the box. 122\\<blackbox-mode-map>\\[bb-bol] and \\[bb-eol] move to the beginning and end of line, respectively. 123 124\\[bb-romp] -- send in a ray from point, or toggle a ball at point 125\\[bb-done] -- end game and get score" 126 (setq truncate-lines t)) 127 128;;;###autoload 129(defun blackbox (num) 130 "Play blackbox. 131Optional prefix argument is the number of balls; the default is 4. 132 133What is blackbox? 134 135Blackbox is a game of hide and seek played on an 8 by 8 grid (the 136Blackbox). Your opponent (Emacs, in this case) has hidden several 137balls (usually 4) within this box. By shooting rays into the box and 138observing where they emerge it is possible to deduce the positions of 139the hidden balls. The fewer rays you use to find the balls, the lower 140your score. 141 142Overview of play: 143 144\\<blackbox-mode-map>\ 145To play blackbox, type \\[blackbox]. An optional prefix argument 146specifies the number of balls to be hidden in the box; the default is 147four. 148 149The cursor can be moved around the box with the standard cursor 150movement keys. 151 152To shoot a ray, move the cursor to the edge of the box and press SPC. 153The result will be determined and the playfield updated. 154 155You may place or remove balls in the box by moving the cursor into the 156box and pressing \\[bb-romp]. 157 158When you think the configuration of balls you have placed is correct, 159press \\[bb-done]. You will be informed whether you are correct or 160not, and be given your score. Your score is the number of letters and 161numbers around the outside of the box plus five for each incorrectly 162placed ball. If you placed any balls incorrectly, they will be 163indicated with `x', and their actual positions indicated with `o'. 164 165Details: 166 167There are three possible outcomes for each ray you send into the box: 168 169 Detour: the ray is deflected and emerges somewhere other than 170 where you sent it in. On the playfield, detours are 171 denoted by matching pairs of numbers -- one where the 172 ray went in, and the other where it came out. 173 174 Reflection: the ray is reflected and emerges in the same place 175 it was sent in. On the playfield, reflections are 176 denoted by the letter `R'. 177 178 Hit: the ray strikes a ball directly and is absorbed. It does 179 not emerge from the box. On the playfield, hits are 180 denoted by the letter `H'. 181 182The rules for how balls deflect rays are simple and are best shown by 183example. 184 185As a ray approaches a ball it is deflected ninety degrees. Rays can 186be deflected multiple times. In the diagrams below, the dashes 187represent empty box locations and the letter `O' represents a ball. 188The entrance and exit points of each ray are marked with numbers as 189described under \"Detour\" above. Note that the entrance and exit 190points are always interchangeable. `*' denotes the path taken by the 191ray. 192 193Note carefully the relative positions of the ball and the ninety 194degree deflection it causes. 195 196 1 197 - * - - - - - - - - - - - - - - - - - - - - - - 198 - * - - - - - - - - - - - - - - - - - - - - - - 1991 * * - - - - - - - - - - - - - - - O - - - - O - 200 - - O - - - - - - - O - - - - - - - * * * * - - 201 - - - - - - - - - - - * * * * * 2 3 * * * - - * - - 202 - - - - - - - - - - - * - - - - - - - O - * - - 203 - - - - - - - - - - - * - - - - - - - - * * - - 204 - - - - - - - - - - - * - - - - - - - - * - O - 205 2 3 206 207As mentioned above, a reflection occurs when a ray emerges from the same point 208it was sent in. This can happen in several ways: 209 210 211 - - - - - - - - - - - - - - - - - - - - - - - - 212 - - - - O - - - - - O - O - - - - - - - - - - - 213R * * * * - - - - - - - * - - - - O - - - - - - - 214 - - - - O - - - - - - * - - - - R - - - - - - - - 215 - - - - - - - - - - - * - - - - - - - - - - - - 216 - - - - - - - - - - - * - - - - - - - - - - - - 217 - - - - - - - - R * * * * - - - - - - - - - - - - 218 - - - - - - - - - - - - O - - - - - - - - - - - 219 220In the first example, the ray is deflected downwards by the upper 221ball, then left by the lower ball, and finally retraces its path to 222its point of origin. The second example is similar. The third 223example is a bit anomalous but can be rationalized by realizing the 224ray never gets a chance to get into the box. Alternatively, the ray 225can be thought of as being deflected downwards and immediately 226emerging from the box. 227 228A hit occurs when a ray runs straight into a ball: 229 230 - - - - - - - - - - - - - - - - - - - - - - - - 231 - - - - - - - - - - - - - - - - - - - - O - - - 232 - - - - - - - - - - - - O - - - H * * * * - - - - 233 - - - - - - - - H * * * * O - - - - - - * - - - - 234 - - - - - - - - - - - - O - - - - - - O - - - - 235H * * * O - - - - - - - - - - - - - - - - - - - - 236 - - - - - - - - - - - - - - - - - - - - - - - - 237 - - - - - - - - - - - - - - - - - - - - - - - - 238 239Be sure to compare the second example of a hit with the first example of 240a reflection." 241 (interactive "P") 242 (switch-to-buffer "*Blackbox*") 243 (blackbox-mode) 244 (setq buffer-read-only t) 245 (buffer-disable-undo (current-buffer)) 246 (setq bb-board (bb-init-board (or num 4))) 247 (setq bb-balls-placed nil) 248 (setq bb-x -1) 249 (setq bb-y -1) 250 (setq bb-score 0) 251 (setq bb-detour-count 0) 252 (bb-insert-board) 253 (bb-goto (cons bb-x bb-y))) 254 255(defun bb-init-board (num-balls) 256 (let (board pos) 257 (while (>= (setq num-balls (1- num-balls)) 0) 258 (while 259 (progn 260 (setq pos (cons (random 8) (random 8))) 261 (member pos board))) 262 (setq board (cons pos board))) 263 board)) 264 265(defun bb-insert-board () 266 (let (i (buffer-read-only nil)) 267 (erase-buffer) 268 (insert " \n") 269 (setq i 8) 270 (while (>= (setq i (1- i)) 0) 271 (insert " - - - - - - - - \n")) 272 (insert " \n") 273 (insert (format "\nThere are %d balls in the box" (length bb-board))) 274 )) 275 276(defun bb-right (count) 277 (interactive "p") 278 (while (and (> count 0) (< bb-x 8)) 279 (forward-char 2) 280 (setq bb-x (1+ bb-x)) 281 (setq count (1- count)))) 282 283(defun bb-left (count) 284 (interactive "p") 285 (while (and (> count 0) (> bb-x -1)) 286 (backward-char 2) 287 (setq bb-x (1- bb-x)) 288 (setq count (1- count)))) 289 290(defun bb-up (count) 291 (interactive "p") 292 (while (and (> count 0) (> bb-y -1)) 293 (with-no-warnings (previous-line)) 294 (setq bb-y (1- bb-y)) 295 (setq count (1- count)))) 296 297(defun bb-down (count) 298 (interactive "p") 299 (while (and (> count 0) (< bb-y 8)) 300 (with-no-warnings (next-line)) 301 (setq bb-y (1+ bb-y)) 302 (setq count (1- count)))) 303 304(defun bb-eol () 305 (interactive) 306 (setq bb-x 8) 307 (bb-goto (cons bb-x bb-y))) 308 309(defun bb-bol () 310 (interactive) 311 (setq bb-x -1) 312 (bb-goto (cons bb-x bb-y))) 313 314(defun bb-romp () 315 (interactive) 316 (cond 317 ((and 318 (or (= bb-x -1) (= bb-x 8)) 319 (or (= bb-y -1) (= bb-y 8)))) 320 ((bb-outside-box bb-x bb-y) 321 (bb-trace-ray bb-x bb-y)) 322 (t 323 (bb-place-ball bb-x bb-y)))) 324 325(defun bb-place-ball (x y) 326 (let ((coord (cons x y))) 327 (cond 328 ((member coord bb-balls-placed) 329 (setq bb-balls-placed (delete coord bb-balls-placed)) 330 (bb-update-board "-")) 331 (t 332 (setq bb-balls-placed (cons coord bb-balls-placed)) 333 (bb-update-board (propertize "O" 'help-echo "Placed ball")))))) 334 335(defun bb-trace-ray (x y) 336 (when (= (following-char) 32) 337 (let ((result (bb-trace-ray-2 338 t 339 x 340 (cond 341 ((= x -1) 1) 342 ((= x 8) -1) 343 (t 0)) 344 y 345 (cond 346 ((= y -1) 1) 347 ((= y 8) -1) 348 (t 0))))) 349 (cond 350 ((eq result 'hit) 351 (bb-update-board (propertize "H" 'help-echo "Hit")) 352 (setq bb-score (1+ bb-score))) 353 ((equal result (cons x y)) 354 (bb-update-board (propertize "R" 'help-echo "Reflection")) 355 (setq bb-score (1+ bb-score))) 356 (t 357 (setq bb-detour-count (1+ bb-detour-count)) 358 (bb-update-board (propertize (format "%d" bb-detour-count) 359 'help-echo "Detour")) 360 (save-excursion 361 (bb-goto result) 362 (bb-update-board (propertize (format "%d" bb-detour-count) 363 'help-echo "Detour"))) 364 (setq bb-score (+ bb-score 2))))))) 365 366(defun bb-trace-ray-2 (first x dx y dy) 367 (cond 368 ((and (not first) 369 (bb-outside-box x y)) 370 (cons x y)) 371 ((member (cons (+ x dx) (+ y dy)) bb-board) 372 'hit) 373 ((member (cons (+ x dx dy) (+ y dy dx)) bb-board) 374 (bb-trace-ray-2 nil x (- dy) y (- dx))) 375 ((member (cons (+ x dx (- dy)) (+ y dy (- dx))) bb-board) 376 (bb-trace-ray-2 nil x dy y dx)) 377 (t 378 (bb-trace-ray-2 nil (+ x dx) dx (+ y dy) dy)))) 379 380(defun bb-done () 381 "Finish the game and report score." 382 (interactive) 383 (let (bogus-balls) 384 (cond 385 ((not (= (length bb-balls-placed) (length bb-board))) 386 (message "There %s %d hidden ball%s; you have placed %d." 387 (if (= (length bb-board) 1) "is" "are") 388 (length bb-board) 389 (if (= (length bb-board) 1) "" "s") 390 (length bb-balls-placed))) 391 (t 392 (setq bogus-balls (bb-show-bogus-balls bb-balls-placed bb-board)) 393 (if (= bogus-balls 0) 394 (message "Right! Your score is %d." bb-score) 395 (message "Oops! You missed %d ball%s. Your score is %d." 396 bogus-balls 397 (if (= bogus-balls 1) "" "s") 398 (+ bb-score (* 5 bogus-balls)))) 399 (bb-goto '(-1 . -1)))))) 400 401(defun bb-show-bogus-balls (balls-placed board) 402 (bb-show-bogus-balls-2 balls-placed board "x") 403 (bb-show-bogus-balls-2 board balls-placed "o")) 404 405(defun bb-show-bogus-balls-2 (list-1 list-2 c) 406 (cond 407 ((null list-1) 408 0) 409 ((member (car list-1) list-2) 410 (bb-show-bogus-balls-2 (cdr list-1) list-2 c)) 411 (t 412 (bb-goto (car list-1)) 413 (bb-update-board c) 414 (1+ (bb-show-bogus-balls-2 (cdr list-1) list-2 c))))) 415 416(defun bb-outside-box (x y) 417 (or (= x -1) (= x 8) (= y -1) (= y 8))) 418 419(defun bb-goto (pos) 420 (goto-char (+ (* (car pos) 2) (* (cdr pos) 22) 26))) 421 422(defun bb-update-board (c) 423 (let ((buffer-read-only nil)) 424 (backward-char (1- (length c))) 425 (delete-char (length c)) 426 (insert c) 427 (backward-char 1))) 428 429(provide 'blackbox) 430 431;;; blackbox.el ends here 432