Mercurial > emacs
annotate lisp/play/blackbox.el @ 96905:43f0edb65a25
(Fns_selection_exists_p, Fns_selection_owner_p)
(Fx_get_selection_internal, Fns_rotate_cut_buffers_internal)
(Fns_own_selection_internal, Fx_disown_selection_internal)
(Fns_get_cut_buffer_internal, Fns_store_cut_buffer_internal):
Change to use 'doc: /* ... */' style of docstrings. Doc fixes.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Tue, 22 Jul 2008 19:25:08 +0000 |
parents | 949bd6ad1ba4 |
children | a9dc0e7c3f2b |
rev | line source |
---|---|
662
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
473
diff
changeset
|
1 ;;; blackbox.el --- blackbox game in Emacs Lisp |
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
473
diff
changeset
|
2 |
64701
34bd8e434dd7
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64085
diff
changeset
|
3 ;; Copyright (C) 1985, 1986, 1987, 1992, 2001, 2002, 2003, 2004, |
79716 | 4 ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. |
845 | 5 |
801
e9e34745ae3b
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
727
diff
changeset
|
6 ;; Author: F. Thomas May <uw-nsr!uw-warp!tom@beaver.cs.washington.edu> |
e9e34745ae3b
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
727
diff
changeset
|
7 ;; Adapted-By: ESR |
e9e34745ae3b
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
727
diff
changeset
|
8 ;; Keywords: games |
e9e34745ae3b
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
727
diff
changeset
|
9 |
473 | 10 ;; This file is part of GNU Emacs. |
11 | |
94675
949bd6ad1ba4
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87657
diff
changeset
|
12 ;; GNU Emacs is free software: you can redistribute it and/or modify |
473 | 13 ;; it under the terms of the GNU General Public License as published by |
94675
949bd6ad1ba4
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87657
diff
changeset
|
14 ;; the Free Software Foundation, either version 3 of the License, or |
949bd6ad1ba4
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87657
diff
changeset
|
15 ;; (at your option) any later version. |
473 | 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 | |
94675
949bd6ad1ba4
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87657
diff
changeset
|
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
473 | 24 |
801
e9e34745ae3b
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
727
diff
changeset
|
25 ;;; Commentary: |
e9e34745ae3b
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
727
diff
changeset
|
26 |
14169 | 27 ;; by F. Thomas May <uw-nsr!uw-warp!tom@beaver.cs.washington.edu> |
28 ;; doc comment by Root Boy Jim <rbj@dsys.icst.nbs.gov>, 27 Apr 89 | |
29 ;; interface improvements by ESR, Dec 5 1991. | |
473 | 30 |
14169 | 31 ;; The object of the game is to find four hidden balls by shooting rays |
32 ;; into the black box. There are four possibilities: 1) the ray will | |
33 ;; pass thru the box undisturbed, 2) it will hit a ball and be absorbed, | |
34 ;; 3) it will be deflected and exit the box, or 4) be deflected immediately, | |
35 ;; not even being allowed entry into the box. | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
47562
diff
changeset
|
36 ;; |
14169 | 37 ;; The strange part is the method of deflection. It seems that rays will |
38 ;; not pass next to a ball, and change direction at right angles to avoid it. | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
47562
diff
changeset
|
39 ;; |
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
47562
diff
changeset
|
40 ;; R 3 |
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
47562
diff
changeset
|
41 ;; 1 - - - - - - - - 1 |
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
47562
diff
changeset
|
42 ;; - - - - - - - - |
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
47562
diff
changeset
|
43 ;; - O - - - - - - 3 |
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
47562
diff
changeset
|
44 ;; 2 - - - - O - O - |
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
47562
diff
changeset
|
45 ;; 4 - - - - - - - - |
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
47562
diff
changeset
|
46 ;; 5 - - - - - - - - 5 |
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
47562
diff
changeset
|
47 ;; - - - - - - - - R |
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
47562
diff
changeset
|
48 ;; H - - - - - - - O |
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
47562
diff
changeset
|
49 ;; 2 H 4 H |
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
47562
diff
changeset
|
50 ;; |
14169 | 51 ;; Rays which enter and exit are numbered. You can see that rays 1 & 5 pass |
66440
5a126d3f6688
(blackbox-mode-map): Move init into declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66433
diff
changeset
|
52 ;; thru the box undisturbed. Ray 2 is deflected by the northwesternmost |
14169 | 53 ;; ball. Likewise rays 3 and 4. Rays which hit balls and are absorbed are |
54 ;; marked with H. The bottom of the left and the right of the bottom hit | |
55 ;; the southeastern ball directly. Rays may also hit balls after being | |
66440
5a126d3f6688
(blackbox-mode-map): Move init into declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66433
diff
changeset
|
56 ;; reflected. Consider the H on the bottom next to the 4. It bounces off |
14169 | 57 ;; the NW-ern most ball and hits the central ball. A ray shot from above |
58 ;; the right side 5 would hit the SE-ern most ball. The R beneath the 5 | |
59 ;; is because the ball is returned instantly. It is not allowed into | |
60 ;; the box if it would reflect immediately. The R on the top is a more | |
61 ;; leisurely return. Both central balls would tend to deflect it east | |
62 ;; or west, but it cannot go either way, so it just retreats. | |
63 ;; | |
64 ;; At the end of the game, if you've placed guesses for as many balls as | |
65 ;; there are in the box, the true board position will be revealed. Each | |
66 ;; `x' is an incorrect guess of yours; `o' is the true location of a ball. | |
473 | 67 |
801
e9e34745ae3b
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
727
diff
changeset
|
68 ;;; Code: |
e9e34745ae3b
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
727
diff
changeset
|
69 |
42199
6f3215f24a28
(bb-member): Remove, use member instead.
Pavel Janík <Pavel@Janik.cz>
parents:
41668
diff
changeset
|
70 (defvar bb-board nil |
6f3215f24a28
(bb-member): Remove, use member instead.
Pavel Janík <Pavel@Janik.cz>
parents:
41668
diff
changeset
|
71 "Blackbox board.") |
6f3215f24a28
(bb-member): Remove, use member instead.
Pavel Janík <Pavel@Janik.cz>
parents:
41668
diff
changeset
|
72 |
6f3215f24a28
(bb-member): Remove, use member instead.
Pavel Janík <Pavel@Janik.cz>
parents:
41668
diff
changeset
|
73 (defvar bb-x -1 |
6f3215f24a28
(bb-member): Remove, use member instead.
Pavel Janík <Pavel@Janik.cz>
parents:
41668
diff
changeset
|
74 "Current x-position.") |
6f3215f24a28
(bb-member): Remove, use member instead.
Pavel Janík <Pavel@Janik.cz>
parents:
41668
diff
changeset
|
75 |
6f3215f24a28
(bb-member): Remove, use member instead.
Pavel Janík <Pavel@Janik.cz>
parents:
41668
diff
changeset
|
76 (defvar bb-y -1 |
6f3215f24a28
(bb-member): Remove, use member instead.
Pavel Janík <Pavel@Janik.cz>
parents:
41668
diff
changeset
|
77 "Current y-position.") |
6f3215f24a28
(bb-member): Remove, use member instead.
Pavel Janík <Pavel@Janik.cz>
parents:
41668
diff
changeset
|
78 |
6f3215f24a28
(bb-member): Remove, use member instead.
Pavel Janík <Pavel@Janik.cz>
parents:
41668
diff
changeset
|
79 (defvar bb-score 0 |
6f3215f24a28
(bb-member): Remove, use member instead.
Pavel Janík <Pavel@Janik.cz>
parents:
41668
diff
changeset
|
80 "Current score.") |
6f3215f24a28
(bb-member): Remove, use member instead.
Pavel Janík <Pavel@Janik.cz>
parents:
41668
diff
changeset
|
81 |
6f3215f24a28
(bb-member): Remove, use member instead.
Pavel Janík <Pavel@Janik.cz>
parents:
41668
diff
changeset
|
82 (defvar bb-detour-count 0 |
6f3215f24a28
(bb-member): Remove, use member instead.
Pavel Janík <Pavel@Janik.cz>
parents:
41668
diff
changeset
|
83 "Number of detours.") |
6f3215f24a28
(bb-member): Remove, use member instead.
Pavel Janík <Pavel@Janik.cz>
parents:
41668
diff
changeset
|
84 |
6f3215f24a28
(bb-member): Remove, use member instead.
Pavel Janík <Pavel@Janik.cz>
parents:
41668
diff
changeset
|
85 (defvar bb-balls-placed nil |
6f3215f24a28
(bb-member): Remove, use member instead.
Pavel Janík <Pavel@Janik.cz>
parents:
41668
diff
changeset
|
86 "List of already placed balls.") |
6f3215f24a28
(bb-member): Remove, use member instead.
Pavel Janík <Pavel@Janik.cz>
parents:
41668
diff
changeset
|
87 |
66433
4f54bc741533
(blackbox-redefine-key): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
64701
diff
changeset
|
88 ;; This is used below to remap existing bindings for cursor motion to |
4f54bc741533
(blackbox-redefine-key): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
64701
diff
changeset
|
89 ;; blackbox-specific bindings in blackbox-mode-map. This is so that |
4f54bc741533
(blackbox-redefine-key): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
64701
diff
changeset
|
90 ;; users who prefer non-default key bindings for cursor motion don't |
4f54bc741533
(blackbox-redefine-key): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
64701
diff
changeset
|
91 ;; lose that when they play Blackbox. |
66440
5a126d3f6688
(blackbox-mode-map): Move init into declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66433
diff
changeset
|
92 (defun blackbox-redefine-key (map oldfun newfun) |
66433
4f54bc741533
(blackbox-redefine-key): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
64701
diff
changeset
|
93 "Redefine keys that run the function OLDFUN to run NEWFUN instead." |
66440
5a126d3f6688
(blackbox-mode-map): Move init into declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66433
diff
changeset
|
94 (define-key map (vector 'remap oldfun) newfun)) |
5a126d3f6688
(blackbox-mode-map): Move init into declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66433
diff
changeset
|
95 |
66433
4f54bc741533
(blackbox-redefine-key): New function.
Eli Zaretskii <eliz@gnu.org>
parents:
64701
diff
changeset
|
96 |
66440
5a126d3f6688
(blackbox-mode-map): Move init into declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66433
diff
changeset
|
97 (defvar blackbox-mode-map |
5a126d3f6688
(blackbox-mode-map): Move init into declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66433
diff
changeset
|
98 (let ((map (make-keymap))) |
5a126d3f6688
(blackbox-mode-map): Move init into declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66433
diff
changeset
|
99 (suppress-keymap map t) |
5a126d3f6688
(blackbox-mode-map): Move init into declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66433
diff
changeset
|
100 (blackbox-redefine-key map 'backward-char 'bb-left) |
5a126d3f6688
(blackbox-mode-map): Move init into declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66433
diff
changeset
|
101 (blackbox-redefine-key map 'forward-char 'bb-right) |
5a126d3f6688
(blackbox-mode-map): Move init into declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66433
diff
changeset
|
102 (blackbox-redefine-key map 'previous-line 'bb-up) |
5a126d3f6688
(blackbox-mode-map): Move init into declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66433
diff
changeset
|
103 (blackbox-redefine-key map 'next-line 'bb-down) |
5a126d3f6688
(blackbox-mode-map): Move init into declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66433
diff
changeset
|
104 (blackbox-redefine-key map 'move-end-of-line 'bb-eol) |
5a126d3f6688
(blackbox-mode-map): Move init into declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66433
diff
changeset
|
105 (blackbox-redefine-key map 'move-beginning-of-line 'bb-bol) |
5a126d3f6688
(blackbox-mode-map): Move init into declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66433
diff
changeset
|
106 (define-key map " " 'bb-romp) |
87657
d83fb5ce6160
Tom Tromey <tromey at redhat.com>
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
107 (define-key map "q" 'bury-buffer) |
66440
5a126d3f6688
(blackbox-mode-map): Move init into declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66433
diff
changeset
|
108 (define-key map [insert] 'bb-romp) |
87657
d83fb5ce6160
Tom Tromey <tromey at redhat.com>
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
109 (define-key map [return] 'bb-done) |
66440
5a126d3f6688
(blackbox-mode-map): Move init into declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66433
diff
changeset
|
110 (blackbox-redefine-key map 'newline 'bb-done) |
5a126d3f6688
(blackbox-mode-map): Move init into declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66433
diff
changeset
|
111 map)) |
473 | 112 |
113 ;; Blackbox mode is suitable only for specially formatted data. | |
114 (put 'blackbox-mode 'mode-class 'special) | |
115 | |
116 (defun blackbox-mode () | |
41668
29bd5069226c
(blackbox-mode, blackbox): Doc fix.
Pavel Janík <Pavel@Janik.cz>
parents:
18383
diff
changeset
|
117 "Major mode for playing blackbox. |
29bd5069226c
(blackbox-mode, blackbox): Doc fix.
Pavel Janík <Pavel@Janik.cz>
parents:
18383
diff
changeset
|
118 To learn how to play blackbox, see the documentation for function `blackbox'. |
473 | 119 |
120 The usual mnemonic keys move the cursor around the box. | |
121 \\<blackbox-mode-map>\\[bb-bol] and \\[bb-eol] move to the beginning and end of line, respectively. | |
122 | |
123 \\[bb-romp] -- send in a ray from point, or toggle a ball at point | |
63239
f48178f79206
(blackbox-mode): Use run-mode-hooks.
Lute Kamstra <lute@gnu.org>
parents:
62249
diff
changeset
|
124 \\[bb-done] -- end game and get score" |
473 | 125 (interactive) |
126 (kill-all-local-variables) | |
127 (use-local-map blackbox-mode-map) | |
128 (setq truncate-lines t) | |
129 (setq major-mode 'blackbox-mode) | |
63239
f48178f79206
(blackbox-mode): Use run-mode-hooks.
Lute Kamstra <lute@gnu.org>
parents:
62249
diff
changeset
|
130 (setq mode-name "Blackbox") |
f48178f79206
(blackbox-mode): Use run-mode-hooks.
Lute Kamstra <lute@gnu.org>
parents:
62249
diff
changeset
|
131 (run-mode-hooks 'blackbox-mode-hook)) |
473 | 132 |
727 | 133 ;;;###autoload |
473 | 134 (defun blackbox (num) |
41668
29bd5069226c
(blackbox-mode, blackbox): Doc fix.
Pavel Janík <Pavel@Janik.cz>
parents:
18383
diff
changeset
|
135 "Play blackbox. |
29bd5069226c
(blackbox-mode, blackbox): Doc fix.
Pavel Janík <Pavel@Janik.cz>
parents:
18383
diff
changeset
|
136 Optional prefix argument is the number of balls; the default is 4. |
473 | 137 |
138 What is blackbox? | |
139 | |
140 Blackbox is a game of hide and seek played on an 8 by 8 grid (the | |
141 Blackbox). Your opponent (Emacs, in this case) has hidden several | |
142 balls (usually 4) within this box. By shooting rays into the box and | |
143 observing where they emerge it is possible to deduce the positions of | |
144 the hidden balls. The fewer rays you use to find the balls, the lower | |
145 your score. | |
146 | |
147 Overview of play: | |
148 | |
826 | 149 \\<blackbox-mode-map>\ |
150 To play blackbox, type \\[blackbox]. An optional prefix argument | |
151 specifies the number of balls to be hidden in the box; the default is | |
152 four. | |
473 | 153 |
154 The cursor can be moved around the box with the standard cursor | |
155 movement keys. | |
156 | |
157 To shoot a ray, move the cursor to the edge of the box and press SPC. | |
158 The result will be determined and the playfield updated. | |
159 | |
160 You may place or remove balls in the box by moving the cursor into the | |
826 | 161 box and pressing \\[bb-romp]. |
473 | 162 |
163 When you think the configuration of balls you have placed is correct, | |
826 | 164 press \\[bb-done]. You will be informed whether you are correct or |
165 not, and be given your score. Your score is the number of letters and | |
166 numbers around the outside of the box plus five for each incorrectly | |
167 placed ball. If you placed any balls incorrectly, they will be | |
168 indicated with `x', and their actual positions indicated with `o'. | |
473 | 169 |
170 Details: | |
171 | |
172 There are three possible outcomes for each ray you send into the box: | |
173 | |
174 Detour: the ray is deflected and emerges somewhere other than | |
175 where you sent it in. On the playfield, detours are | |
176 denoted by matching pairs of numbers -- one where the | |
177 ray went in, and the other where it came out. | |
178 | |
179 Reflection: the ray is reflected and emerges in the same place | |
180 it was sent in. On the playfield, reflections are | |
181 denoted by the letter `R'. | |
182 | |
183 Hit: the ray strikes a ball directly and is absorbed. It does | |
184 not emerge from the box. On the playfield, hits are | |
185 denoted by the letter `H'. | |
186 | |
187 The rules for how balls deflect rays are simple and are best shown by | |
188 example. | |
189 | |
190 As a ray approaches a ball it is deflected ninety degrees. Rays can | |
191 be deflected multiple times. In the diagrams below, the dashes | |
192 represent empty box locations and the letter `O' represents a ball. | |
193 The entrance and exit points of each ray are marked with numbers as | |
194 described under \"Detour\" above. Note that the entrance and exit | |
195 points are always interchangeable. `*' denotes the path taken by the | |
196 ray. | |
197 | |
198 Note carefully the relative positions of the ball and the ninety | |
199 degree deflection it causes. | |
200 | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
47562
diff
changeset
|
201 1 |
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
47562
diff
changeset
|
202 - * - - - - - - - - - - - - - - - - - - - - - - |
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
47562
diff
changeset
|
203 - * - - - - - - - - - - - - - - - - - - - - - - |
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
47562
diff
changeset
|
204 1 * * - - - - - - - - - - - - - - - O - - - - O - |
473 | 205 - - O - - - - - - - O - - - - - - - * * * * - - |
206 - - - - - - - - - - - * * * * * 2 3 * * * - - * - - | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
47562
diff
changeset
|
207 - - - - - - - - - - - * - - - - - - - O - * - - |
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
47562
diff
changeset
|
208 - - - - - - - - - - - * - - - - - - - - * * - - |
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
47562
diff
changeset
|
209 - - - - - - - - - - - * - - - - - - - - * - O - |
473 | 210 2 3 |
211 | |
212 As mentioned above, a reflection occurs when a ray emerges from the same point | |
213 it was sent in. This can happen in several ways: | |
214 | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
47562
diff
changeset
|
215 |
473 | 216 - - - - - - - - - - - - - - - - - - - - - - - - |
217 - - - - O - - - - - O - O - - - - - - - - - - - | |
218 R * * * * - - - - - - - * - - - - O - - - - - - - | |
219 - - - - O - - - - - - * - - - - R - - - - - - - - | |
220 - - - - - - - - - - - * - - - - - - - - - - - - | |
221 - - - - - - - - - - - * - - - - - - - - - - - - | |
222 - - - - - - - - R * * * * - - - - - - - - - - - - | |
223 - - - - - - - - - - - - O - - - - - - - - - - - | |
224 | |
225 In the first example, the ray is deflected downwards by the upper | |
226 ball, then left by the lower ball, and finally retraces its path to | |
227 its point of origin. The second example is similar. The third | |
228 example is a bit anomalous but can be rationalized by realizing the | |
229 ray never gets a chance to get into the box. Alternatively, the ray | |
230 can be thought of as being deflected downwards and immediately | |
231 emerging from the box. | |
232 | |
233 A hit occurs when a ray runs straight into a ball: | |
234 | |
235 - - - - - - - - - - - - - - - - - - - - - - - - | |
236 - - - - - - - - - - - - - - - - - - - - O - - - | |
237 - - - - - - - - - - - - O - - - H * * * * - - - - | |
238 - - - - - - - - H * * * * O - - - - - - * - - - - | |
239 - - - - - - - - - - - - O - - - - - - O - - - - | |
240 H * * * O - - - - - - - - - - - - - - - - - - - - | |
241 - - - - - - - - - - - - - - - - - - - - - - - - | |
242 - - - - - - - - - - - - - - - - - - - - - - - - | |
243 | |
244 Be sure to compare the second example of a hit with the first example of | |
245 a reflection." | |
246 (interactive "P") | |
247 (switch-to-buffer "*Blackbox*") | |
248 (blackbox-mode) | |
249 (setq buffer-read-only t) | |
250 (buffer-disable-undo (current-buffer)) | |
251 (setq bb-board (bb-init-board (or num 4))) | |
252 (setq bb-balls-placed nil) | |
253 (setq bb-x -1) | |
254 (setq bb-y -1) | |
255 (setq bb-score 0) | |
256 (setq bb-detour-count 0) | |
257 (bb-insert-board) | |
258 (bb-goto (cons bb-x bb-y))) | |
259 | |
260 (defun bb-init-board (num-balls) | |
261 (random t) | |
262 (let (board pos) | |
263 (while (>= (setq num-balls (1- num-balls)) 0) | |
264 (while | |
265 (progn | |
266 (setq pos (cons (random 8) (random 8))) | |
42199
6f3215f24a28
(bb-member): Remove, use member instead.
Pavel Janík <Pavel@Janik.cz>
parents:
41668
diff
changeset
|
267 (member pos board))) |
473 | 268 (setq board (cons pos board))) |
269 board)) | |
270 | |
271 (defun bb-insert-board () | |
272 (let (i (buffer-read-only nil)) | |
273 (erase-buffer) | |
274 (insert " \n") | |
275 (setq i 8) | |
276 (while (>= (setq i (1- i)) 0) | |
277 (insert " - - - - - - - - \n")) | |
278 (insert " \n") | |
279 (insert (format "\nThere are %d balls in the box" (length bb-board))) | |
280 )) | |
281 | |
47562
56e5df2ccc8d
(bb-right): Respect prefix argument.
Richard M. Stallman <rms@gnu.org>
parents:
42199
diff
changeset
|
282 (defun bb-right (count) |
56e5df2ccc8d
(bb-right): Respect prefix argument.
Richard M. Stallman <rms@gnu.org>
parents:
42199
diff
changeset
|
283 (interactive "p") |
56e5df2ccc8d
(bb-right): Respect prefix argument.
Richard M. Stallman <rms@gnu.org>
parents:
42199
diff
changeset
|
284 (while (and (> count 0) (< bb-x 8)) |
473 | 285 (forward-char 2) |
47562
56e5df2ccc8d
(bb-right): Respect prefix argument.
Richard M. Stallman <rms@gnu.org>
parents:
42199
diff
changeset
|
286 (setq bb-x (1+ bb-x)) |
56e5df2ccc8d
(bb-right): Respect prefix argument.
Richard M. Stallman <rms@gnu.org>
parents:
42199
diff
changeset
|
287 (setq count (1- count)))) |
473 | 288 |
47562
56e5df2ccc8d
(bb-right): Respect prefix argument.
Richard M. Stallman <rms@gnu.org>
parents:
42199
diff
changeset
|
289 (defun bb-left (count) |
56e5df2ccc8d
(bb-right): Respect prefix argument.
Richard M. Stallman <rms@gnu.org>
parents:
42199
diff
changeset
|
290 (interactive "p") |
56e5df2ccc8d
(bb-right): Respect prefix argument.
Richard M. Stallman <rms@gnu.org>
parents:
42199
diff
changeset
|
291 (while (and (> count 0) (> bb-x -1)) |
473 | 292 (backward-char 2) |
47562
56e5df2ccc8d
(bb-right): Respect prefix argument.
Richard M. Stallman <rms@gnu.org>
parents:
42199
diff
changeset
|
293 (setq bb-x (1- bb-x)) |
56e5df2ccc8d
(bb-right): Respect prefix argument.
Richard M. Stallman <rms@gnu.org>
parents:
42199
diff
changeset
|
294 (setq count (1- count)))) |
473 | 295 |
47562
56e5df2ccc8d
(bb-right): Respect prefix argument.
Richard M. Stallman <rms@gnu.org>
parents:
42199
diff
changeset
|
296 (defun bb-up (count) |
56e5df2ccc8d
(bb-right): Respect prefix argument.
Richard M. Stallman <rms@gnu.org>
parents:
42199
diff
changeset
|
297 (interactive "p") |
56e5df2ccc8d
(bb-right): Respect prefix argument.
Richard M. Stallman <rms@gnu.org>
parents:
42199
diff
changeset
|
298 (while (and (> count 0) (> bb-y -1)) |
86903
c2cad5807c15
(bb-up, bb-down): Revert 2007-10-21 change and
Martin Rudalics <rudalics@gmx.at>
parents:
85500
diff
changeset
|
299 (with-no-warnings (previous-line)) |
47562
56e5df2ccc8d
(bb-right): Respect prefix argument.
Richard M. Stallman <rms@gnu.org>
parents:
42199
diff
changeset
|
300 (setq bb-y (1- bb-y)) |
56e5df2ccc8d
(bb-right): Respect prefix argument.
Richard M. Stallman <rms@gnu.org>
parents:
42199
diff
changeset
|
301 (setq count (1- count)))) |
473 | 302 |
47562
56e5df2ccc8d
(bb-right): Respect prefix argument.
Richard M. Stallman <rms@gnu.org>
parents:
42199
diff
changeset
|
303 (defun bb-down (count) |
56e5df2ccc8d
(bb-right): Respect prefix argument.
Richard M. Stallman <rms@gnu.org>
parents:
42199
diff
changeset
|
304 (interactive "p") |
56e5df2ccc8d
(bb-right): Respect prefix argument.
Richard M. Stallman <rms@gnu.org>
parents:
42199
diff
changeset
|
305 (while (and (> count 0) (< bb-y 8)) |
86903
c2cad5807c15
(bb-up, bb-down): Revert 2007-10-21 change and
Martin Rudalics <rudalics@gmx.at>
parents:
85500
diff
changeset
|
306 (with-no-warnings (next-line)) |
47562
56e5df2ccc8d
(bb-right): Respect prefix argument.
Richard M. Stallman <rms@gnu.org>
parents:
42199
diff
changeset
|
307 (setq bb-y (1+ bb-y)) |
56e5df2ccc8d
(bb-right): Respect prefix argument.
Richard M. Stallman <rms@gnu.org>
parents:
42199
diff
changeset
|
308 (setq count (1- count)))) |
473 | 309 |
310 (defun bb-eol () | |
311 (interactive) | |
312 (setq bb-x 8) | |
313 (bb-goto (cons bb-x bb-y))) | |
314 | |
315 (defun bb-bol () | |
316 (interactive) | |
317 (setq bb-x -1) | |
318 (bb-goto (cons bb-x bb-y))) | |
319 | |
320 (defun bb-romp () | |
321 (interactive) | |
322 (cond | |
323 ((and | |
324 (or (= bb-x -1) (= bb-x 8)) | |
325 (or (= bb-y -1) (= bb-y 8)))) | |
326 ((bb-outside-box bb-x bb-y) | |
327 (bb-trace-ray bb-x bb-y)) | |
328 (t | |
329 (bb-place-ball bb-x bb-y)))) | |
330 | |
331 (defun bb-place-ball (x y) | |
332 (let ((coord (cons x y))) | |
333 (cond | |
42199
6f3215f24a28
(bb-member): Remove, use member instead.
Pavel Janík <Pavel@Janik.cz>
parents:
41668
diff
changeset
|
334 ((member coord bb-balls-placed) |
6f3215f24a28
(bb-member): Remove, use member instead.
Pavel Janík <Pavel@Janik.cz>
parents:
41668
diff
changeset
|
335 (setq bb-balls-placed (delete coord bb-balls-placed)) |
473 | 336 (bb-update-board "-")) |
337 (t | |
338 (setq bb-balls-placed (cons coord bb-balls-placed)) | |
42199
6f3215f24a28
(bb-member): Remove, use member instead.
Pavel Janík <Pavel@Janik.cz>
parents:
41668
diff
changeset
|
339 (bb-update-board (propertize "O" 'help-echo "Placed ball")))))) |
473 | 340 |
341 (defun bb-trace-ray (x y) | |
56989
7cbddcabb63e
(bb-trace-ray): Avoid double tracing.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
52401
diff
changeset
|
342 (when (= (following-char) 32) |
7cbddcabb63e
(bb-trace-ray): Avoid double tracing.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
52401
diff
changeset
|
343 (let ((result (bb-trace-ray-2 |
7cbddcabb63e
(bb-trace-ray): Avoid double tracing.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
52401
diff
changeset
|
344 t |
7cbddcabb63e
(bb-trace-ray): Avoid double tracing.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
52401
diff
changeset
|
345 x |
7cbddcabb63e
(bb-trace-ray): Avoid double tracing.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
52401
diff
changeset
|
346 (cond |
7cbddcabb63e
(bb-trace-ray): Avoid double tracing.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
52401
diff
changeset
|
347 ((= x -1) 1) |
7cbddcabb63e
(bb-trace-ray): Avoid double tracing.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
52401
diff
changeset
|
348 ((= x 8) -1) |
7cbddcabb63e
(bb-trace-ray): Avoid double tracing.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
52401
diff
changeset
|
349 (t 0)) |
7cbddcabb63e
(bb-trace-ray): Avoid double tracing.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
52401
diff
changeset
|
350 y |
7cbddcabb63e
(bb-trace-ray): Avoid double tracing.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
52401
diff
changeset
|
351 (cond |
7cbddcabb63e
(bb-trace-ray): Avoid double tracing.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
52401
diff
changeset
|
352 ((= y -1) 1) |
7cbddcabb63e
(bb-trace-ray): Avoid double tracing.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
52401
diff
changeset
|
353 ((= y 8) -1) |
7cbddcabb63e
(bb-trace-ray): Avoid double tracing.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
52401
diff
changeset
|
354 (t 0))))) |
7cbddcabb63e
(bb-trace-ray): Avoid double tracing.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
52401
diff
changeset
|
355 (cond |
7cbddcabb63e
(bb-trace-ray): Avoid double tracing.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
52401
diff
changeset
|
356 ((eq result 'hit) |
7cbddcabb63e
(bb-trace-ray): Avoid double tracing.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
52401
diff
changeset
|
357 (bb-update-board (propertize "H" 'help-echo "Hit")) |
7cbddcabb63e
(bb-trace-ray): Avoid double tracing.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
52401
diff
changeset
|
358 (setq bb-score (1+ bb-score))) |
7cbddcabb63e
(bb-trace-ray): Avoid double tracing.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
52401
diff
changeset
|
359 ((equal result (cons x y)) |
7cbddcabb63e
(bb-trace-ray): Avoid double tracing.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
52401
diff
changeset
|
360 (bb-update-board (propertize "R" 'help-echo "Reflection")) |
7cbddcabb63e
(bb-trace-ray): Avoid double tracing.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
52401
diff
changeset
|
361 (setq bb-score (1+ bb-score))) |
7cbddcabb63e
(bb-trace-ray): Avoid double tracing.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
52401
diff
changeset
|
362 (t |
7cbddcabb63e
(bb-trace-ray): Avoid double tracing.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
52401
diff
changeset
|
363 (setq bb-detour-count (1+ bb-detour-count)) |
7cbddcabb63e
(bb-trace-ray): Avoid double tracing.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
52401
diff
changeset
|
364 (bb-update-board (propertize (format "%d" bb-detour-count) |
7cbddcabb63e
(bb-trace-ray): Avoid double tracing.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
52401
diff
changeset
|
365 'help-echo "Detour")) |
7cbddcabb63e
(bb-trace-ray): Avoid double tracing.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
52401
diff
changeset
|
366 (save-excursion |
7cbddcabb63e
(bb-trace-ray): Avoid double tracing.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
52401
diff
changeset
|
367 (bb-goto result) |
7cbddcabb63e
(bb-trace-ray): Avoid double tracing.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
52401
diff
changeset
|
368 (bb-update-board (propertize (format "%d" bb-detour-count) |
7cbddcabb63e
(bb-trace-ray): Avoid double tracing.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
52401
diff
changeset
|
369 'help-echo "Detour"))) |
7cbddcabb63e
(bb-trace-ray): Avoid double tracing.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
52401
diff
changeset
|
370 (setq bb-score (+ bb-score 2))))))) |
473 | 371 |
372 (defun bb-trace-ray-2 (first x dx y dy) | |
373 (cond | |
374 ((and (not first) | |
375 (bb-outside-box x y)) | |
376 (cons x y)) | |
42199
6f3215f24a28
(bb-member): Remove, use member instead.
Pavel Janík <Pavel@Janik.cz>
parents:
41668
diff
changeset
|
377 ((member (cons (+ x dx) (+ y dy)) bb-board) |
473 | 378 'hit) |
42199
6f3215f24a28
(bb-member): Remove, use member instead.
Pavel Janík <Pavel@Janik.cz>
parents:
41668
diff
changeset
|
379 ((member (cons (+ x dx dy) (+ y dy dx)) bb-board) |
473 | 380 (bb-trace-ray-2 nil x (- dy) y (- dx))) |
42199
6f3215f24a28
(bb-member): Remove, use member instead.
Pavel Janík <Pavel@Janik.cz>
parents:
41668
diff
changeset
|
381 ((member (cons (+ x dx (- dy)) (+ y dy (- dx))) bb-board) |
473 | 382 (bb-trace-ray-2 nil x dy y dx)) |
383 (t | |
384 (bb-trace-ray-2 nil (+ x dx) dx (+ y dy) dy)))) | |
385 | |
386 (defun bb-done () | |
387 "Finish the game and report score." | |
388 (interactive) | |
389 (let (bogus-balls) | |
390 (cond | |
391 ((not (= (length bb-balls-placed) (length bb-board))) | |
392 (message "There %s %d hidden ball%s; you have placed %d." | |
393 (if (= (length bb-board) 1) "is" "are") | |
394 (length bb-board) | |
395 (if (= (length bb-board) 1) "" "s") | |
396 (length bb-balls-placed))) | |
397 (t | |
398 (setq bogus-balls (bb-show-bogus-balls bb-balls-placed bb-board)) | |
399 (if (= bogus-balls 0) | |
400 (message "Right! Your score is %d." bb-score) | |
401 (message "Oops! You missed %d ball%s. Your score is %d." | |
402 bogus-balls | |
403 (if (= bogus-balls 1) "" "s") | |
404 (+ bb-score (* 5 bogus-balls)))) | |
405 (bb-goto '(-1 . -1)))))) | |
406 | |
407 (defun bb-show-bogus-balls (balls-placed board) | |
408 (bb-show-bogus-balls-2 balls-placed board "x") | |
409 (bb-show-bogus-balls-2 board balls-placed "o")) | |
410 | |
411 (defun bb-show-bogus-balls-2 (list-1 list-2 c) | |
412 (cond | |
413 ((null list-1) | |
414 0) | |
42199
6f3215f24a28
(bb-member): Remove, use member instead.
Pavel Janík <Pavel@Janik.cz>
parents:
41668
diff
changeset
|
415 ((member (car list-1) list-2) |
473 | 416 (bb-show-bogus-balls-2 (cdr list-1) list-2 c)) |
417 (t | |
418 (bb-goto (car list-1)) | |
419 (bb-update-board c) | |
420 (1+ (bb-show-bogus-balls-2 (cdr list-1) list-2 c))))) | |
421 | |
826 | 422 (defun bb-outside-box (x y) |
423 (or (= x -1) (= x 8) (= y -1) (= y 8))) | |
473 | 424 |
425 (defun bb-goto (pos) | |
426 (goto-char (+ (* (car pos) 2) (* (cdr pos) 22) 26))) | |
427 | |
428 (defun bb-update-board (c) | |
429 (let ((buffer-read-only nil)) | |
430 (backward-char (1- (length c))) | |
431 (delete-char (length c)) | |
432 (insert c) | |
433 (backward-char 1))) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
47562
diff
changeset
|
434 |
18383 | 435 (provide 'blackbox) |
436 | |
66440
5a126d3f6688
(blackbox-mode-map): Move init into declaration.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
66433
diff
changeset
|
437 ;; arch-tag: 6c474c62-5617-4b10-9b44-ac430168c0e2 |
662
8a533acedb77
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
473
diff
changeset
|
438 ;;; blackbox.el ends here |