-; Blackbox game in Emacs Lisp
-;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
+;;; blackbox.el --- blackbox game in Emacs Lisp
+
+;; Copyright (C) 1985, 1986, 1987, 1992, 2001, 2002, 2003, 2004,
+;; 2005 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 1, or (at your option)
+;; 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,
;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-; 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 Eric Raymond <eric@snark.thyrsus.com>, 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.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, 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
- ()
+(defvar bb-board nil
+ "Blackbox board.")
+
+(defvar bb-x -1
+ "Current x-position.")
+
+(defvar bb-y -1
+ "Current y-position.")
+
+(defvar bb-score 0
+ "Current score.")
+
+(defvar bb-detour-count 0
+ "Number of detours.")
+
+(defvar bb-balls-placed nil
+ "List of already placed balls.")
+
+(unless 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)
-
- ;; This is a kluge. What we really want is a general
- ;; feature for reminding terminal keys to the functions
- ;; corresponding to them in local maps
- (if (featurep 'keypad)
- (let (keys)
- (if (setq keys (function-key-sequence ?u)) ; Up Arrow
- (define-key blackbox-mode-map keys 'bb-up))
- (if (setq keys (function-key-sequence ?d)) ; Down Arrow
- (define-key blackbox-mode-map keys 'bb-down))
- (if (setq keys (function-key-sequence ?l)) ; Left Arrow
- (define-key blackbox-mode-map keys 'bb-left))
- (if (setq keys (function-key-sequence ?r)) ; Right Arrow
- (define-key blackbox-mode-map keys 'bb-right))
- (if (setq keys (function-key-sequence ?e)) ; Enter
- (define-key blackbox-mode-map keys 'bb-done))
- (if (setq keys (function-key-sequence ?I)) ; Insert
- (define-key blackbox-mode-map keys 'bb-romp))
- )))
-
+ (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'.
+ "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
-"
+\\[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"))
+ (setq mode-name "Blackbox")
+ (run-mode-hooks 'blackbox-mode-hook))
+;;;###autoload
(defun blackbox (num)
- "Play blackbox. Optional prefix argument is the number of balls;
-the default is 4.
+ "Play blackbox.
+Optional prefix argument is the number of balls; the default is 4.
What is blackbox?
Overview of play:
-To play blackbox, call the function `blackbox'. An optional prefix
-argument specifies the number of balls to be hidden in the box; the
-default is four.
+\\<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.
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>.
+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'.
+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:
Note carefully the relative positions of the ball and the ninety
degree deflection it causes.
- 1
- - * - - - - - - - - - - - - - - - - - - - - - -
- - * - - - - - - - - - - - - - - - - - - - - - -
-1 * * - - - - - - - - - - - - - - - O - - - - O -
+ 1
+ - * - - - - - - - - - - - - - - - - - - - - - -
+ - * - - - - - - - - - - - - - - - - - - - - - -
+1 * * - - - - - - - - - - - - - - - O - - - - O -
- - O - - - - - - - O - - - - - - - * * * * - -
- - - - - - - - - - - * * * * * 2 3 * * * - - * - -
- - - - - - - - - - - - * - - - - - - - O - * - -
- - - - - - - - - - - - * - - - - - - - - * * - -
- - - - - - - - - - - - * - - - - - - - - * - O -
+ - - - - - - - - - - - * - - - - - - - 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 - - - - - - -
(while
(progn
(setq pos (cons (random 8) (random 8)))
- (bb-member pos board)))
+ (member pos board)))
(setq board (cons pos board)))
board))
(insert (format "\nThere are %d balls in the box" (length bb-board)))
))
-(defun bb-right ()
- (interactive)
- (if (= bb-x 8)
- ()
+(defun bb-right (count)
+ (interactive "p")
+ (while (and (> count 0) (< bb-x 8))
(forward-char 2)
- (setq bb-x (1+ bb-x))))
+ (setq bb-x (1+ bb-x))
+ (setq count (1- count))))
-(defun bb-left ()
- (interactive)
- (if (= bb-x -1)
- ()
+(defun bb-left (count)
+ (interactive "p")
+ (while (and (> count 0) (> bb-x -1))
(backward-char 2)
- (setq bb-x (1- bb-x))))
+ (setq bb-x (1- bb-x))
+ (setq count (1- count))))
-(defun bb-up ()
- (interactive)
- (if (= bb-y -1)
- ()
+(defun bb-up (count)
+ (interactive "p")
+ (while (and (> count 0) (> bb-y -1))
(previous-line 1)
- (setq bb-y (1- bb-y))))
+ (setq bb-y (1- bb-y))
+ (setq count (1- count))))
-(defun bb-down ()
- (interactive)
- (if (= bb-y 8)
- ()
+(defun bb-down (count)
+ (interactive "p")
+ (while (and (> count 0) (< bb-y 8))
(next-line 1)
- (setq bb-y (1+ bb-y))))
+ (setq bb-y (1+ bb-y))
+ (setq count (1- count))))
(defun bb-eol ()
(interactive)
(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))
+ ((member coord bb-balls-placed)
+ (setq bb-balls-placed (delete coord bb-balls-placed))
(bb-update-board "-"))
(t
(setq bb-balls-placed (cons coord bb-balls-placed))
- (bb-update-board "O")))))
+ (bb-update-board (propertize "O" 'help-echo "Placed ball"))))))
(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))))))
+ (when (= (following-char) 32)
+ (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 (propertize "H" 'help-echo "Hit"))
+ (setq bb-score (1+ bb-score)))
+ ((equal result (cons x y))
+ (bb-update-board (propertize "R" 'help-echo "Reflection"))
+ (setq bb-score (1+ bb-score)))
+ (t
+ (setq bb-detour-count (1+ bb-detour-count))
+ (bb-update-board (propertize (format "%d" bb-detour-count)
+ 'help-echo "Detour"))
+ (save-excursion
+ (bb-goto result)
+ (bb-update-board (propertize (format "%d" bb-detour-count)
+ 'help-echo "Detour")))
+ (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)
+ ((member (cons (+ x dx) (+ y dy)) bb-board)
'hit)
- ((bb-member (cons (+ x dx dy) (+ y dy dx)) bb-board)
+ ((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)
+ ((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))))
(cond
((null list-1)
0)
- ((bb-member (car list-1) list-2)
+ ((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)))))
-;; blackbox.el ends here
+(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)))
(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))))))
+(provide 'blackbox)
+
+;;; arch-tag: 6c474c62-5617-4b10-9b44-ac430168c0e2
+;;; blackbox.el ends here