lisp/play/blackbox.el

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