diff options
| author | Pavel Janík | 2001-12-20 06:51:24 +0000 |
|---|---|---|
| committer | Pavel Janík | 2001-12-20 06:51:24 +0000 |
| commit | 49b83be92d3df56de9d64e11899176c8791b47e6 (patch) | |
| tree | cad674550cb230170db6d293d9836aae06b3d3de | |
| parent | 858f257423d2161f7a3b2821f0094845f70656e0 (diff) | |
| download | emacs-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/ChangeLog | 8 | ||||
| -rw-r--r-- | lisp/play/blackbox.el | 59 |
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 @@ | |||
| 1 | 2001-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 | |||
| 1 | 2001-12-19 Karl Fogel <kfogel@red-bean.com> | 9 | 2001-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 |