Mercurial > emacs
diff lisp/play/blackbox.el @ 42199:6f3215f24a28
(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.
author | Pavel Janík <Pavel@Janik.cz> |
---|---|
date | Thu, 20 Dec 2001 06:50:42 +0000 |
parents | 29bd5069226c |
children | 56e5df2ccc8d |
line wrap: on
line diff
--- a/lisp/play/blackbox.el Thu Dec 20 06:38:24 2001 +0000 +++ b/lisp/play/blackbox.el Thu Dec 20 06:50:42 2001 +0000 @@ -1,6 +1,6 @@ ;;; blackbox.el --- blackbox game in Emacs Lisp -;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1987, 1992, 2001 Free Software Foundation, Inc. ;; Author: F. Thomas May <uw-nsr!uw-warp!tom@beaver.cs.washington.edu> ;; Adapted-By: ESR @@ -70,8 +70,25 @@ (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) @@ -243,7 +260,7 @@ (while (progn (setq pos (cons (random 8) (random 8))) - (bb-member pos board))) + (member pos board))) (setq board (cons pos board))) board)) @@ -310,12 +327,12 @@ (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 @@ -332,17 +349,19 @@ (t 0))))) (cond ((eq result 'hit) - (bb-update-board "H") + (bb-update-board (propertize "H" 'help-echo "Hit")) (setq bb-score (1+ bb-score))) ((equal result (cons x y)) - (bb-update-board "R") + (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 (format "%d" bb-detour-count)) + (bb-update-board (propertize (format "%d" bb-detour-count) + 'help-echo "Detour")) (save-excursion (bb-goto result) - (bb-update-board (format "%d" bb-detour-count))) + (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) @@ -350,11 +369,11 @@ ((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)))) @@ -388,7 +407,7 @@ (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)) @@ -408,16 +427,6 @@ (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) ;;; blackbox.el ends here