;;; blackbox.el --- blackbox game in Emacs Lisp
-;; Copyright (C) 1985, 1986, 1987, 1992, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1987, 1992, 2001, 2005 Free Software Foundation, Inc.
;; Author: F. Thomas May <uw-nsr!uw-warp!tom@beaver.cs.washington.edu>
;; Adapted-By: ESR
;; 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.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; 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
-;;
+;;
+;; 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
\\<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)
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 - - - - - - -
(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)
(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 (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))))))
+ (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
(delete-char (length c))
(insert c)
(backward-char 1)))
-
+
(provide 'blackbox)
+;;; arch-tag: 6c474c62-5617-4b10-9b44-ac430168c0e2
;;; blackbox.el ends here