aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorPavel Janík2001-12-20 06:51:24 +0000
committerPavel Janík2001-12-20 06:51:24 +0000
commit49b83be92d3df56de9d64e11899176c8791b47e6 (patch)
treecad674550cb230170db6d293d9836aae06b3d3de
parent858f257423d2161f7a3b2821f0094845f70656e0 (diff)
downloademacs-49b83be92d3df56de9d64e11899176c8791b47e6.tar.gz
emacs-49b83be92d3df56de9d64e11899176c8791b47e6.zip
(bb-member): Remove, use member instead.
(bb-delete): Remove, use delete instead. Update copyright notice. Defvar for bb-board, bb-x, bb-y, bb-score, bb-detour-count and bb-balls-placed. Propertize results of rays.
-rw-r--r--lisp/ChangeLog8
-rw-r--r--lisp/play/blackbox.el59
2 files changed, 42 insertions, 25 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 2f780b36479..fce8478e8c8 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,11 @@
12001-12-20 Pavel Jan,Bm(Bk <Pavel@Janik.cz>
2
3 * play/blackbox.el (bb-member): Remove, use member instead.
4 (bb-delete): Remove, use delete instead.
5 Update copyright notice. Defvar for bb-board, bb-x, bb-y,
6 bb-score, bb-detour-count and bb-balls-placed.
7 Propertize results of rays.
8
12001-12-19 Karl Fogel <kfogel@red-bean.com> 92001-12-19 Karl Fogel <kfogel@red-bean.com>
2 10
3 * isearch.el (isearch-forward, isearch-edit-string): Make doc 11 * isearch.el (isearch-forward, isearch-edit-string): Make doc
diff --git a/lisp/play/blackbox.el b/lisp/play/blackbox.el
index 58864bf8ce3..ea709106e81 100644
--- a/lisp/play/blackbox.el
+++ b/lisp/play/blackbox.el
@@ -1,6 +1,6 @@
1;;; blackbox.el --- blackbox game in Emacs Lisp 1;;; blackbox.el --- blackbox game in Emacs Lisp
2 2
3;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc. 3;; Copyright (C) 1985, 1986, 1987, 1992, 2001 Free Software Foundation, Inc.
4 4
5;; Author: F. Thomas May <uw-nsr!uw-warp!tom@beaver.cs.washington.edu> 5;; Author: F. Thomas May <uw-nsr!uw-warp!tom@beaver.cs.washington.edu>
6;; Adapted-By: ESR 6;; Adapted-By: ESR
@@ -70,8 +70,25 @@
70 70
71(defvar blackbox-mode-map nil "") 71(defvar blackbox-mode-map nil "")
72 72
73(if blackbox-mode-map 73(defvar bb-board nil
74 () 74 "Blackbox board.")
75
76(defvar bb-x -1
77 "Current x-position.")
78
79(defvar bb-y -1
80 "Current y-position.")
81
82(defvar bb-score 0
83 "Current score.")
84
85(defvar bb-detour-count 0
86 "Number of detours.")
87
88(defvar bb-balls-placed nil
89 "List of already placed balls.")
90
91(unless blackbox-mode-map
75 (setq blackbox-mode-map (make-keymap)) 92 (setq blackbox-mode-map (make-keymap))
76 (suppress-keymap blackbox-mode-map t) 93 (suppress-keymap blackbox-mode-map t)
77 (define-key blackbox-mode-map "\C-f" 'bb-right) 94 (define-key blackbox-mode-map "\C-f" 'bb-right)
@@ -243,7 +260,7 @@ a reflection."
243 (while 260 (while
244 (progn 261 (progn
245 (setq pos (cons (random 8) (random 8))) 262 (setq pos (cons (random 8) (random 8)))
246 (bb-member pos board))) 263 (member pos board)))
247 (setq board (cons pos board))) 264 (setq board (cons pos board)))
248 board)) 265 board))
249 266
@@ -310,12 +327,12 @@ a reflection."
310(defun bb-place-ball (x y) 327(defun bb-place-ball (x y)
311 (let ((coord (cons x y))) 328 (let ((coord (cons x y)))
312 (cond 329 (cond
313 ((bb-member coord bb-balls-placed) 330 ((member coord bb-balls-placed)
314 (setq bb-balls-placed (bb-delete coord bb-balls-placed)) 331 (setq bb-balls-placed (delete coord bb-balls-placed))
315 (bb-update-board "-")) 332 (bb-update-board "-"))
316 (t 333 (t
317 (setq bb-balls-placed (cons coord bb-balls-placed)) 334 (setq bb-balls-placed (cons coord bb-balls-placed))
318 (bb-update-board "O"))))) 335 (bb-update-board (propertize "O" 'help-echo "Placed ball"))))))
319 336
320(defun bb-trace-ray (x y) 337(defun bb-trace-ray (x y)
321 (let ((result (bb-trace-ray-2 338 (let ((result (bb-trace-ray-2
@@ -332,17 +349,19 @@ a reflection."
332 (t 0))))) 349 (t 0)))))
333 (cond 350 (cond
334 ((eq result 'hit) 351 ((eq result 'hit)
335 (bb-update-board "H") 352 (bb-update-board (propertize "H" 'help-echo "Hit"))
336 (setq bb-score (1+ bb-score))) 353 (setq bb-score (1+ bb-score)))
337 ((equal result (cons x y)) 354 ((equal result (cons x y))
338 (bb-update-board "R") 355 (bb-update-board (propertize "R" 'help-echo "Reflection"))
339 (setq bb-score (1+ bb-score))) 356 (setq bb-score (1+ bb-score)))
340 (t 357 (t
341 (setq bb-detour-count (1+ bb-detour-count)) 358 (setq bb-detour-count (1+ bb-detour-count))
342 (bb-update-board (format "%d" bb-detour-count)) 359 (bb-update-board (propertize (format "%d" bb-detour-count)
360 'help-echo "Detour"))
343 (save-excursion 361 (save-excursion
344 (bb-goto result) 362 (bb-goto result)
345 (bb-update-board (format "%d" bb-detour-count))) 363 (bb-update-board (propertize (format "%d" bb-detour-count)
364 'help-echo "Detour")))
346 (setq bb-score (+ bb-score 2)))))) 365 (setq bb-score (+ bb-score 2))))))
347 366
348(defun bb-trace-ray-2 (first x dx y dy) 367(defun bb-trace-ray-2 (first x dx y dy)
@@ -350,11 +369,11 @@ a reflection."
350 ((and (not first) 369 ((and (not first)
351 (bb-outside-box x y)) 370 (bb-outside-box x y))
352 (cons x y)) 371 (cons x y))
353 ((bb-member (cons (+ x dx) (+ y dy)) bb-board) 372 ((member (cons (+ x dx) (+ y dy)) bb-board)
354 'hit) 373 'hit)
355 ((bb-member (cons (+ x dx dy) (+ y dy dx)) bb-board) 374 ((member (cons (+ x dx dy) (+ y dy dx)) bb-board)
356 (bb-trace-ray-2 nil x (- dy) y (- dx))) 375 (bb-trace-ray-2 nil x (- dy) y (- dx)))
357 ((bb-member (cons (+ x dx (- dy)) (+ y dy (- dx))) bb-board) 376 ((member (cons (+ x dx (- dy)) (+ y dy (- dx))) bb-board)
358 (bb-trace-ray-2 nil x dy y dx)) 377 (bb-trace-ray-2 nil x dy y dx))
359 (t 378 (t
360 (bb-trace-ray-2 nil (+ x dx) dx (+ y dy) dy)))) 379 (bb-trace-ray-2 nil (+ x dx) dx (+ y dy) dy))))
@@ -388,7 +407,7 @@ a reflection."
388 (cond 407 (cond
389 ((null list-1) 408 ((null list-1)
390 0) 409 0)
391 ((bb-member (car list-1) list-2) 410 ((member (car list-1) list-2)
392 (bb-show-bogus-balls-2 (cdr list-1) list-2 c)) 411 (bb-show-bogus-balls-2 (cdr list-1) list-2 c))
393 (t 412 (t
394 (bb-goto (car list-1)) 413 (bb-goto (car list-1))
@@ -408,16 +427,6 @@ a reflection."
408 (insert c) 427 (insert c)
409 (backward-char 1))) 428 (backward-char 1)))
410 429
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))))))
420
421(provide 'blackbox) 430(provide 'blackbox)
422 431
423;;; blackbox.el ends here 432;;; blackbox.el ends here