cgit.sxemacs.org Git - packages/blob - xemacs-packages/misc-games/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 XEmacs.
  10
  11 ;; XEmacs is free software; you can redistribute it and/or modify it
  12 ;; 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 ;; XEmacs is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  23 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  24 ;; 02111-1307, USA.
  25
  26 ;;; Synched up with: FSF 19.34.
  27
  28 ;;; Commentary:
  29
  30 ;; by F. Thomas May <uw-nsr!uw-warp!tom@beaver.cs.washington.edu>
  31 ;; doc comment by Root Boy Jim <rbj@dsys.icst.nbs.gov>, 27 Apr 89
  32 ;; interface improvements by ESR, Dec 5 1991.
  33
  34 ;; The object of the game is to find four hidden balls by shooting rays
  35 ;; into the black box.  There are four possibilities: 1) the ray will
  36 ;; pass thru the box undisturbed, 2) it will hit a ball and be absorbed,
  37 ;; 3) it will be deflected and exit the box, or 4) be deflected immediately,
  38 ;; not even being allowed entry into the box.
  39
  40 ;; The strange part is the method of deflection.  It seems that rays will
  41 ;; not pass next to a ball, and change direction at right angles to avoid it.
  42 ;;
  43 ;;                           R   3
  44 ;;               1 - - - - - - - - 1
  45 ;;                 - - - - - - - -
  46 ;;                 - O - - - - - - 3
  47 ;;               2 - - - - O - O -
  48 ;;               4 - - - - - - - -
  49 ;;               5 - - - - - - - - 5
  50 ;;                 - - - - - - - - R
  51 ;;               H - - - - - - - O
  52 ;;                 2   H 4       H
  53 ;;
  54 ;; Rays which enter and exit are numbered.  You can see that rays 1 & 5 pass
  55 ;; thru the box undisturbed. Ray 2 is deflected by the northwesternmost
  56 ;; ball.  Likewise rays 3 and 4. Rays which hit balls and are absorbed are
  57 ;; marked with H.  The bottom of the left and the right of the bottom hit
  58 ;; the southeastern ball directly.  Rays may also hit balls after being
  59 ;; reflected. Consider the H on the bottom next to the 4.  It bounces off
  60 ;; the NW-ern most ball and hits the central ball.  A ray shot from above
  61 ;; the right side 5 would hit the SE-ern most ball.  The R beneath the 5
  62 ;; is because the ball is returned instantly.  It is not allowed into
  63 ;; the box if it would reflect immediately.  The R on the top is a more
  64 ;; leisurely return.  Both central balls would tend to deflect it east
  65 ;; or west, but it cannot go either way, so it just retreats.
  66
  67 ;; At the end of the game, if you've placed guesses for as many balls as
  68 ;; there are in the box, the true board position will be revealed.  Each
  69 ;; `x' is an incorrect guess of yours;; `o' is the true location of a ball.
  70
  71 ;;; Code:
  72
  73 (defvar blackbox-mode-map nil "")
  74
  75 (if blackbox-mode-map
  76     ()
  77   (setq blackbox-mode-map (make-keymap))
  78   (suppress-keymap blackbox-mode-map t)
  79   (define-key blackbox-mode-map "\C-f" 'bb-right)
  80   (define-key blackbox-mode-map [right] 'bb-right)
  81   (define-key blackbox-mode-map "\C-b" 'bb-left)
  82   (define-key blackbox-mode-map [left] 'bb-left)
  83   (define-key blackbox-mode-map "\C-p" 'bb-up)
  84   (define-key blackbox-mode-map [up] 'bb-up)
  85   (define-key blackbox-mode-map "\C-n" 'bb-down)
  86   (define-key blackbox-mode-map [down] 'bb-down)
  87   (define-key blackbox-mode-map "\C-e" 'bb-eol)
  88   (define-key blackbox-mode-map "\C-a" 'bb-bol)
  89   (define-key blackbox-mode-map " " 'bb-romp)
  90   (define-key blackbox-mode-map [insert] 'bb-romp)
  91   (define-key blackbox-mode-map "\C-m" 'bb-done)
  92   (define-key blackbox-mode-map [kp-enter] 'bb-done))
  93
  94 ;; Blackbox mode is suitable only for specially formatted data.
  95 (put 'blackbox-mode 'mode-class 'special)
  96
  97 (defvar bb-board)
  98 (defvar bb-balls-placed)
  99 (defvar bb-x)
 100 (defvar bb-y)
 101 (defvar bb-score)
 102 (defvar bb-detour-count)
 103
 104 (defun blackbox-mode ()
 105   "Major mode for playing blackbox.  To learn how to play blackbox,
 106 see the documentation for function `blackbox'.
 107
 108 The usual mnemonic keys move the cursor around the box.
 109 \\<blackbox-mode-map>\\[bb-bol] and \\[bb-eol] move to the beginning and end of line, respectively.
 110
 111 \\[bb-romp] -- send in a ray from point, or toggle a ball at point
 112 \\[bb-done] -- end game and get score
 113 "
 114   (interactive)
 115   (kill-all-local-variables)
 116   (use-local-map blackbox-mode-map)
 117   (setq truncate-lines t)
 118   (setq major-mode 'blackbox-mode)
 119   (setq mode-name "Blackbox"))
 120
 121 ;;;###autoload
 122 (defun blackbox (num)
 123   "Play blackbox.  Optional prefix argument is the number of balls;
 124 the default is 4.
 125
 126 What is blackbox?
 127
 128 Blackbox is a game of hide and seek played on an 8 by 8 grid (the
 129 Blackbox).  Your opponent (Emacs, in this case) has hidden several
 130 balls (usually 4) within this box.  By shooting rays into the box and
 131 observing where they emerge it is possible to deduce the positions of
 132 the hidden balls.  The fewer rays you use to find the balls, the lower
 133 your score.
 134
 135 Overview of play:
 136
 137 \\<blackbox-mode-map>\
 138 To play blackbox, type \\[blackbox].  An optional prefix argument
 139 specifies the number of balls to be hidden in the box; the default is
 140 four.
 141
 142 The cursor can be moved around the box with the standard cursor
 143 movement keys.
 144
 145 To shoot a ray, move the cursor to the edge of the box and press SPC.
 146 The result will be determined and the playfield updated.
 147
 148 You may place or remove balls in the box by moving the cursor into the
 149 box and pressing \\[bb-romp].
 150
 151 When you think the configuration of balls you have placed is correct,
 152 press \\[bb-done].  You will be informed whether you are correct or
 153 not, and be given your score.  Your score is the number of letters and
 154 numbers around the outside of the box plus five for each incorrectly
 155 placed ball.  If you placed any balls incorrectly, they will be
 156 indicated with `x', and their actual positions indicated with `o'.
 157
 158 Details:
 159
 160 There are three possible outcomes for each ray you send into the box:
 161
 162         Detour: the ray is deflected and emerges somewhere other than
 163                 where you sent it in.  On the playfield, detours are
 164                 denoted by matching pairs of numbers -- one where the
 165                 ray went in, and the other where it came out.
 166
 167         Reflection: the ray is reflected and emerges in the same place
 168                 it was sent in.  On the playfield, reflections are
 169                 denoted by the letter `R'.
 170
 171         Hit:    the ray strikes a ball directly and is absorbed.  It does
 172                 not emerge from the box.  On the playfield, hits are
 173                 denoted by the letter `H'.
 174
 175 The rules for how balls deflect rays are simple and are best shown by
 176 example.
 177
 178 As a ray approaches a ball it is deflected ninety degrees.  Rays can
 179 be deflected multiple times.  In the diagrams below, the dashes
 180 represent empty box locations and the letter `O' represents a ball.
 181 The entrance and exit points of each ray are marked with numbers as
 182 described under \"Detour\" above.  Note that the entrance and exit
 183 points are always interchangeable.  `*' denotes the path taken by the
 184 ray.
 185
 186 Note carefully the relative positions of the ball and the ninety
 187 degree deflection it causes.
 188
 189     1
 190   - * - - - - - -         - - - - - - - -         - - - - - - - -
 191   - * - - - - - -         - - - - - - - -         - - - - - - - -
 192 1 * * - - - - - -         - - - - - - - -         - O - - - - O -
 193   - - O - - - - -         - - O - - - - -         - - * * * * - -
 194   - - - - - - - -         - - - * * * * * 2     3 * * * - - * - -
 195   - - - - - - - -         - - - * - - - -         - - - O - * - -
 196   - - - - - - - -         - - - * - - - -         - - - - * * - -
 197   - - - - - - - -         - - - * - - - -         - - - - * - O -
 198                                 2                         3
 199
 200 As mentioned above, a reflection occurs when a ray emerges from the same point
 201 it was sent in.  This can happen in several ways:
 202
 203
 204   - - - - - - - -         - - - - - - - -          - - - - - - - -
 205   - - - - O - - -         - - O - O - - -          - - - - - - - -
 206 R * * * * - - - -         - - - * - - - -          O - - - - - - -
 207   - - - - O - - -         - - - * - - - -        R - - - - - - - -
 208   - - - - - - - -         - - - * - - - -          - - - - - - - -
 209   - - - - - - - -         - - - * - - - -          - - - - - - - -
 210   - - - - - - - -       R * * * * - - - -          - - - - - - - -
 211   - - - - - - - -         - - - - O - - -          - - - - - - - -
 212
 213 In the first example, the ray is deflected downwards by the upper
 214 ball, then left by the lower ball, and finally retraces its path to
 215 its point of origin.  The second example is similar.  The third
 216 example is a bit anomalous but can be rationalized by realizing the
 217 ray never gets a chance to get into the box.  Alternatively, the ray
 218 can be thought of as being deflected downwards and immediately
 219 emerging from the box.
 220
 221 A hit occurs when a ray runs straight into a ball:
 222
 223   - - - - - - - -         - - - - - - - -          - - - - - - - -
 224   - - - - - - - -         - - - - - - - -          - - - - O - - -
 225   - - - - - - - -         - - - - O - - -        H * * * * - - - -
 226   - - - - - - - -       H * * * * O - - -          - - - * - - - -
 227   - - - - - - - -         - - - - O - - -          - - - O - - - -
 228 H * * * O - - - -         - - - - - - - -          - - - - - - - -
 229   - - - - - - - -         - - - - - - - -          - - - - - - - -
 230   - - - - - - - -         - - - - - - - -          - - - - - - - -
 231
 232 Be sure to compare the second example of a hit with the first example of
 233 a reflection."
 234   (interactive "P")
 235   (switch-to-buffer "*Blackbox*")
 236   (blackbox-mode)
 237   (setq buffer-read-only t)
 238   (buffer-disable-undo (current-buffer))
 239   ;; XEmacs makes some local variables here and FSF doesn't.
 240   (make-local-variable 'bb-board)
 241   (setq bb-board (bb-init-board (or num 4)))
 242   (make-local-variable 'bb-balls-placed)
 243   (setq bb-balls-placed nil)
 244   (make-local-variable 'bb-x)
 245   (setq bb-x -1)
 246   (make-local-variable 'bb-y)
 247   (setq bb-y -1)
 248   (make-local-variable 'bb-score)
 249   (setq bb-score 0)
 250   (make-local-variable 'bb-detour-count)
 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   (random t)
 257   (let (board pos)
 258     (while (>= (setq num-balls (1- num-balls)) 0)
 259       (while
 260           (progn
 261             (setq pos (cons (random 8) (random 8)))
 262             (bb-member pos board)))
 263       (setq board (cons pos board)))
 264     board))
 265
 266 (defun bb-insert-board ()
 267   (let (i (buffer-read-only nil))
 268     (erase-buffer)
 269     (insert "                     \n")
 270     (setq i 8)
 271     (while (>= (setq i (1- i)) 0)
 272       (insert "   - - - - - - - -   \n"))
 273     (insert "                     \n")
 274     (insert (format "\nThere are %d balls in the box" (length bb-board)))
 275     ))
 276
 277 (defun bb-right ()
 278   (interactive)
 279   (if (= bb-x 8)
 280       ()
 281     (forward-char 2)
 282     (setq bb-x (1+ bb-x))))
 283
 284 (defun bb-left ()
 285   (interactive)
 286   (if (= bb-x -1)
 287       ()
 288     (backward-char 2)
 289     (setq bb-x (1- bb-x))))
 290
 291 (defun bb-up ()
 292   (interactive)
 293   (if (= bb-y -1)
 294       ()
 295     (previous-line 1)
 296     (setq bb-y (1- bb-y))))
 297
 298 (defun bb-down ()
 299   (interactive)
 300   (if (= bb-y 8)
 301       ()
 302     (next-line 1)
 303     (setq bb-y (1+ bb-y))))
 304
 305 (defun bb-eol ()
 306   (interactive)
 307   (setq bb-x 8)
 308   (bb-goto (cons bb-x bb-y)))
 309
 310 (defun bb-bol ()
 311   (interactive)
 312   (setq bb-x -1)
 313   (bb-goto (cons bb-x bb-y)))
 314
 315 (defun bb-romp ()
 316   (interactive)
 317   (cond
 318    ((and
 319      (or (= bb-x -1) (= bb-x 8))
 320      (or (= bb-y -1) (= bb-y 8))))
 321    ((bb-outside-box bb-x bb-y)
 322     (bb-trace-ray bb-x bb-y))
 323    (t
 324     (bb-place-ball bb-x bb-y))))
 325
 326 (defun bb-place-ball (x y)
 327   (let ((coord (cons x y)))
 328     (cond
 329      ((bb-member coord bb-balls-placed)
 330       (setq bb-balls-placed (bb-delete coord bb-balls-placed))
 331       (bb-update-board "-"))
 332      (t
 333       (setq bb-balls-placed (cons coord bb-balls-placed))
 334       (bb-update-board "O")))))
 335
 336 (defun bb-trace-ray (x y)
 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 "H")
 352       (setq bb-score (1+ bb-score)))
 353      ((equal result (cons x y))
 354       (bb-update-board "R")
 355       (setq bb-score (1+ bb-score)))
 356      (t
 357       (setq bb-detour-count (1+ bb-detour-count))
 358       (bb-update-board (format "%d" bb-detour-count))
 359       (save-excursion
 360         (bb-goto result)
 361         (bb-update-board (format "%d" bb-detour-count)))
 362       (setq bb-score (+ bb-score 2))))))
 363
 364 (defun bb-trace-ray-2 (first x dx y dy)
 365   (cond
 366    ((and (not first)
 367          (bb-outside-box x y))
 368     (cons x y))
 369    ((bb-member (cons (+ x dx) (+ y dy)) bb-board)
 370     'hit)
 371    ((bb-member (cons (+ x dx dy) (+ y dy dx)) bb-board)
 372     (bb-trace-ray-2 nil x (- dy) y (- dx)))
 373    ((bb-member (cons (+ x dx (- dy)) (+ y dy (- dx))) bb-board)
 374     (bb-trace-ray-2 nil x dy y dx))
 375    (t
 376     (bb-trace-ray-2 nil (+ x dx) dx (+ y dy) dy))))
 377
 378 (defun bb-done ()
 379   "Finish the game and report score."
 380   (interactive)
 381   (let (bogus-balls)
 382     (cond
 383      ((not (= (length bb-balls-placed) (length bb-board)))
 384       (message "There %s %d hidden ball%s; you have placed %d."
 385                (if (= (length bb-board) 1) "is" "are")
 386                (length bb-board)
 387                (if (= (length bb-board) 1) "" "s")
 388                (length bb-balls-placed)))
 389      (t
 390       (setq bogus-balls (bb-show-bogus-balls bb-balls-placed bb-board))
 391       (if (= bogus-balls 0)
 392           (message "Right!  Your score is %d." bb-score)
 393         (message "Oops!  You missed %d ball%s.  Your score is %d."
 394                  bogus-balls
 395                  (if (= bogus-balls 1) "" "s")
 396                  (+ bb-score (* 5 bogus-balls))))
 397       (bb-goto '(-1 . -1))))))
 398
 399 (defun bb-show-bogus-balls (balls-placed board)
 400   (bb-show-bogus-balls-2 balls-placed board "x")
 401   (bb-show-bogus-balls-2 board balls-placed "o"))
 402
 403 (defun bb-show-bogus-balls-2 (list-1 list-2 c)
 404   (cond
 405    ((null list-1)
 406     0)
 407    ((bb-member (car list-1) list-2)
 408     (bb-show-bogus-balls-2 (cdr list-1) list-2 c))
 409    (t
 410     (bb-goto (car list-1))
 411     (bb-update-board c)
 412     (1+ (bb-show-bogus-balls-2 (cdr list-1) list-2 c)))))
 413
 414 (defun bb-outside-box (x y)
 415   (or (= x -1) (= x 8) (= y -1) (= y 8)))
 416
 417 (defun bb-goto (pos)
 418   (goto-char (+ (* (car pos) 2) (* (cdr pos) 22) 26)))
 419
 420 (defun bb-update-board (c)
 421   (let ((buffer-read-only nil))
 422     (backward-char (1- (length c)))
 423     (delete-char (length c))
 424     (insert c)
 425     (backward-char 1)))
 426
 427 (defun bb-member (elt list)
 428   "Returns non-nil if ELT is an element of LIST."
 429   (eval (cons 'or (mapcar (function (lambda (x) (equal x elt))) list))))
 430
 431 (defun bb-delete (item list)
 432   "Deletes ITEM from LIST and returns a copy."
 433   (cond
 434    ((equal item (car list)) (cdr list))
 435    (t (cons (car list) (bb-delete item (cdr list))))))
 436
 437 ;;; blackbox.el ends here