[bpt/emacs.git] / lisp / play / blackbox.el

;;; blackbox.el --- blackbox game in Emacs Lisp

;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc.

;; Author: F. Thomas May <uw-nsr!uw-warp!tom@beaver.cs.washington.edu>
;; Adapted-By: ESR
;; Keywords: games

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; by F. Thomas May <uw-nsr!uw-warp!tom@beaver.cs.washington.edu>
;; doc comment by Root Boy Jim <rbj@dsys.icst.nbs.gov>, 27 Apr 89
;; interface improvements by ESR, Dec 5 1991.

;; The object of the game is to find four hidden balls by shooting rays
;; into the black box.  There are four possibilities: 1) the ray will
;; pass thru the box undisturbed, 2) it will hit a ball and be absorbed,
;; 3) it will be deflected and exit the box, or 4) be deflected immediately,
;; not even being allowed entry into the box.
;; 
;; The strange part is the method of deflection.  It seems that rays will
;; not pass next to a ball, and change direction at right angles to avoid it.
;; 
;; 		             R   3   
;; 		 1 - - - - - - - - 1 
;; 		   - - - - - - - -   
;; 		   - O - - - - - - 3 
;; 		 2 - - - - O - O -   
;; 		 4 - - - - - - - - 
;; 		 5 - - - - - - - - 5 
;; 		   - - - - - - - - R 
;; 		 H - - - - - - - O   
;; 		   2   H 4       H   
;; 
;; Rays which enter and exit are numbered.  You can see that rays 1 & 5 pass
;; thru the box undisturbed. Ray 2 is deflected by the northwesternmost
;; ball.  Likewise rays 3 and 4. Rays which hit balls and are absorbed are
;; marked with H.  The bottom of the left and the right of the bottom hit
;; the southeastern ball directly.  Rays may also hit balls after being
;; reflected. Consider the H on the bottom next to the 4.  It bounces off
;; the NW-ern most ball and hits the central ball.  A ray shot from above
;; the right side 5 would hit the SE-ern most ball.  The R beneath the 5
;; is because the ball is returned instantly.  It is not allowed into
;; the box if it would reflect immediately.  The R on the top is a more
;; leisurely return.  Both central balls would tend to deflect it east
;; or west, but it cannot go either way, so it just retreats.
;;
;; At the end of the game, if you've placed guesses for as many balls as
;; there are in the box, the true board position will be revealed.  Each
;; `x' is an incorrect guess of yours; `o' is the true location of a ball.

;;; Code:

(defvar blackbox-mode-map nil "")

(if blackbox-mode-map
    ()
  (setq blackbox-mode-map (make-keymap))
  (suppress-keymap blackbox-mode-map t)
  (define-key blackbox-mode-map "\C-f" 'bb-right)
  (define-key blackbox-mode-map [right] 'bb-right)
  (define-key blackbox-mode-map "\C-b" 'bb-left)
  (define-key blackbox-mode-map [left] 'bb-left)
  (define-key blackbox-mode-map "\C-p" 'bb-up)
  (define-key blackbox-mode-map [up] 'bb-up)
  (define-key blackbox-mode-map "\C-n" 'bb-down)
  (define-key blackbox-mode-map [down] 'bb-down)
  (define-key blackbox-mode-map "\C-e" 'bb-eol)
  (define-key blackbox-mode-map "\C-a" 'bb-bol)
  (define-key blackbox-mode-map " " 'bb-romp)
  (define-key blackbox-mode-map [insert] 'bb-romp)
  (define-key blackbox-mode-map "\C-m" 'bb-done)
  (define-key blackbox-mode-map [kp-enter] 'bb-done))

;; Blackbox mode is suitable only for specially formatted data.
(put 'blackbox-mode 'mode-class 'special)

(defun blackbox-mode ()
  "Major mode for playing blackbox.  To learn how to play blackbox,
see the documentation for function `blackbox'.

The usual mnemonic keys move the cursor around the box.
\\<blackbox-mode-map>\\[bb-bol] and \\[bb-eol] move to the beginning and end of line, respectively.

\\[bb-romp] -- send in a ray from point, or toggle a ball at point
\\[bb-done] -- end game and get score
"
  (interactive)
  (kill-all-local-variables)
  (use-local-map blackbox-mode-map)
  (setq truncate-lines t)
  (setq major-mode 'blackbox-mode)
  (setq mode-name "Blackbox"))

;;;###autoload
(defun blackbox (num)
  "Play blackbox.  Optional prefix argument is the number of balls;
the default is 4.

What is blackbox?

Blackbox is a game of hide and seek played on an 8 by 8 grid (the
Blackbox).  Your opponent (Emacs, in this case) has hidden several
balls (usually 4) within this box.  By shooting rays into the box and
observing where they emerge it is possible to deduce the positions of
the hidden balls.  The fewer rays you use to find the balls, the lower
your score.

Overview of play:

\\<blackbox-mode-map>\
To play blackbox, type \\[blackbox].  An optional prefix argument
specifies the number of balls to be hidden in the box; the default is
four.

The cursor can be moved around the box with the standard cursor
movement keys.

To shoot a ray, move the cursor to the edge of the box and press SPC.
The result will be determined and the playfield updated.

You may place or remove balls in the box by moving the cursor into the
box and pressing \\[bb-romp].

When you think the configuration of balls you have placed is correct,
press \\[bb-done].  You will be informed whether you are correct or
not, and be given your score.  Your score is the number of letters and
numbers around the outside of the box plus five for each incorrectly
placed ball.  If you placed any balls incorrectly, they will be
indicated with `x', and their actual positions indicated with `o'.

Details:

There are three possible outcomes for each ray you send into the box:

	Detour: the ray is deflected and emerges somewhere other than
		where you sent it in.  On the playfield, detours are
		denoted by matching pairs of numbers -- one where the
		ray went in, and the other where it came out.

	Reflection: the ray is reflected and emerges in the same place
		it was sent in.  On the playfield, reflections are
		denoted by the letter `R'.

	Hit:	the ray strikes a ball directly and is absorbed.  It does
		not emerge from the box.  On the playfield, hits are
		denoted by the letter `H'.

The rules for how balls deflect rays are simple and are best shown by
example.

As a ray approaches a ball it is deflected ninety degrees.  Rays can
be deflected multiple times.  In the diagrams below, the dashes
represent empty box locations and the letter `O' represents a ball.
The entrance and exit points of each ray are marked with numbers as
described under \"Detour\" above.  Note that the entrance and exit
points are always interchangeable.  `*' denotes the path taken by the
ray.

Note carefully the relative positions of the ball and the ninety
degree deflection it causes.

    1                                            
  - * - - - - - -         - - - - - - - -         - - - - - - - -       
  - * - - - - - -         - - - - - - - -         - - - - - - - -       
1 * * - - - - - -         - - - - - - - -         - O - - - - O -       
  - - O - - - - -         - - O - - - - -         - - * * * * - -
  - - - - - - - -         - - - * * * * * 2     3 * * * - - * - -
  - - - - - - - -         - - - * - - - -         - - - O - * - -      
  - - - - - - - -         - - - * - - - -         - - - - * * - -       
  - - - - - - - -         - - - * - - - -         - - - - * - O -       
                                2                         3

As mentioned above, a reflection occurs when a ray emerges from the same point
it was sent in.  This can happen in several ways:

                                                                           
  - - - - - - - -         - - - - - - - -          - - - - - - - -
  - - - - O - - -         - - O - O - - -          - - - - - - - -
R * * * * - - - -         - - - * - - - -          O - - - - - - -
  - - - - O - - -         - - - * - - - -        R - - - - - - - -
  - - - - - - - -         - - - * - - - -          - - - - - - - -
  - - - - - - - -         - - - * - - - -          - - - - - - - -
  - - - - - - - -       R * * * * - - - -          - - - - - - - -
  - - - - - - - -         - - - - O - - -          - - - - - - - -

In the first example, the ray is deflected downwards by the upper
ball, then left by the lower ball, and finally retraces its path to
its point of origin.  The second example is similar.  The third
example is a bit anomalous but can be rationalized by realizing the
ray never gets a chance to get into the box.  Alternatively, the ray
can be thought of as being deflected downwards and immediately
emerging from the box.

A hit occurs when a ray runs straight into a ball:

  - - - - - - - -         - - - - - - - -          - - - - - - - -
  - - - - - - - -         - - - - - - - -          - - - - O - - -
  - - - - - - - -         - - - - O - - -        H * * * * - - - -
  - - - - - - - -       H * * * * O - - -          - - - * - - - -
  - - - - - - - -         - - - - O - - -          - - - O - - - -
H * * * O - - - -         - - - - - - - -          - - - - - - - -
  - - - - - - - -         - - - - - - - -          - - - - - - - -
  - - - - - - - -         - - - - - - - -          - - - - - - - -

Be sure to compare the second example of a hit with the first example of
a reflection."
  (interactive "P")
  (switch-to-buffer "*Blackbox*")
  (blackbox-mode)
  (setq buffer-read-only t)
  (buffer-disable-undo (current-buffer))
  (setq bb-board (bb-init-board (or num 4)))
  (setq bb-balls-placed nil)
  (setq bb-x -1)
  (setq bb-y -1)
  (setq bb-score 0)
  (setq bb-detour-count 0)
  (bb-insert-board)
  (bb-goto (cons bb-x bb-y)))

(defun bb-init-board (num-balls)
  (random t)
  (let (board pos)
    (while (>= (setq num-balls (1- num-balls)) 0)
      (while
	  (progn
	    (setq pos (cons (random 8) (random 8)))
	    (bb-member pos board)))
      (setq board (cons pos board)))
    board))

(defun bb-insert-board ()
  (let (i (buffer-read-only nil))
    (erase-buffer)
    (insert "                     \n")
    (setq i 8)
    (while (>= (setq i (1- i)) 0)
      (insert "   - - - - - - - -   \n"))
    (insert "                     \n")
    (insert (format "\nThere are %d balls in the box" (length bb-board)))
    ))

(defun bb-right ()
  (interactive)
  (if (= bb-x 8)
      ()
    (forward-char 2)
    (setq bb-x (1+ bb-x))))

(defun bb-left ()
  (interactive)
  (if (= bb-x -1)
      ()
    (backward-char 2)
    (setq bb-x (1- bb-x))))

(defun bb-up ()
  (interactive)
  (if (= bb-y -1)
      ()
    (previous-line 1)
    (setq bb-y (1- bb-y))))

(defun bb-down ()
  (interactive)
  (if (= bb-y 8)
      ()
    (next-line 1)
    (setq bb-y (1+ bb-y))))

(defun bb-eol ()
  (interactive)
  (setq bb-x 8)
  (bb-goto (cons bb-x bb-y)))

(defun bb-bol ()
  (interactive)
  (setq bb-x -1)
  (bb-goto (cons bb-x bb-y)))

(defun bb-romp ()
  (interactive)
  (cond
   ((and
     (or (= bb-x -1) (= bb-x 8))
     (or (= bb-y -1) (= bb-y 8))))
   ((bb-outside-box bb-x bb-y)
    (bb-trace-ray bb-x bb-y))
   (t
    (bb-place-ball bb-x bb-y))))

(defun bb-place-ball (x y)
  (let ((coord (cons x y)))
    (cond
     ((bb-member coord bb-balls-placed)
      (setq bb-balls-placed (bb-delete coord bb-balls-placed))
      (bb-update-board "-"))
     (t
      (setq bb-balls-placed (cons coord bb-balls-placed))
      (bb-update-board "O")))))

(defun bb-trace-ray (x y)
  (let ((result (bb-trace-ray-2
		 t
		 x
		 (cond
		  ((= x -1) 1)
		  ((= x 8) -1)
		  (t 0))
		 y
		 (cond
		  ((= y -1) 1)
		  ((= y 8) -1)
		  (t 0)))))
    (cond
     ((eq result 'hit)
      (bb-update-board "H")
      (setq bb-score (1+ bb-score)))
     ((equal result (cons x y))
      (bb-update-board "R")
      (setq bb-score (1+ bb-score)))
     (t
      (setq bb-detour-count (1+ bb-detour-count))
      (bb-update-board (format "%d" bb-detour-count))
      (save-excursion
	(bb-goto result)
	(bb-update-board (format "%d" bb-detour-count)))
      (setq bb-score (+ bb-score 2))))))

(defun bb-trace-ray-2 (first x dx y dy)
  (cond
   ((and (not first)
	 (bb-outside-box x y))
    (cons x y))
   ((bb-member (cons (+ x dx) (+ y dy)) bb-board)
    'hit)
   ((bb-member (cons (+ x dx dy) (+ y dy dx)) bb-board)
    (bb-trace-ray-2 nil x (- dy) y (- dx)))
   ((bb-member (cons (+ x dx (- dy)) (+ y dy (- dx))) bb-board)
    (bb-trace-ray-2 nil x dy y dx))
   (t
    (bb-trace-ray-2 nil (+ x dx) dx (+ y dy) dy))))

(defun bb-done ()
  "Finish the game and report score."
  (interactive)
  (let (bogus-balls)
    (cond
     ((not (= (length bb-balls-placed) (length bb-board)))
      (message "There %s %d hidden ball%s; you have placed %d."
	       (if (= (length bb-board) 1) "is" "are")
	       (length bb-board)
	       (if (= (length bb-board) 1) "" "s")
	       (length bb-balls-placed)))
     (t
      (setq bogus-balls (bb-show-bogus-balls bb-balls-placed bb-board))
      (if (= bogus-balls 0)
	  (message "Right!  Your score is %d." bb-score)
	(message "Oops!  You missed %d ball%s.  Your score is %d."
		 bogus-balls
		 (if (= bogus-balls 1) "" "s")
		 (+ bb-score (* 5 bogus-balls))))
      (bb-goto '(-1 . -1))))))

(defun bb-show-bogus-balls (balls-placed board)
  (bb-show-bogus-balls-2 balls-placed board "x")
  (bb-show-bogus-balls-2 board balls-placed "o"))

(defun bb-show-bogus-balls-2 (list-1 list-2 c)
  (cond
   ((null list-1)
    0)
   ((bb-member (car list-1) list-2)
    (bb-show-bogus-balls-2 (cdr list-1) list-2 c))
   (t
    (bb-goto (car list-1))
    (bb-update-board c)
    (1+ (bb-show-bogus-balls-2 (cdr list-1) list-2 c)))))

(defun bb-outside-box (x y)
  (or (= x -1) (= x 8) (= y -1) (= y 8)))

(defun bb-goto (pos)
  (goto-char (+ (* (car pos) 2) (* (cdr pos) 22) 26)))

(defun bb-update-board (c)
  (let ((buffer-read-only nil))
    (backward-char (1- (length c)))
    (delete-char (length c))
    (insert c)
    (backward-char 1)))
  
(defun bb-member (elt list)
  "Returns non-nil if ELT is an element of LIST."
  (eval (cons 'or (mapcar (function (lambda (x) (equal x elt))) list))))

(defun bb-delete (item list)
  "Deletes ITEM from LIST and returns a copy."
  (cond
   ((equal item (car list)) (cdr list))
   (t (cons (car list) (bb-delete item (cdr list))))))

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