lisp/play/blackbox.el

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