diff options
| author | John Wiegley <johnw@newartisans.com> | 2002-04-15 05:40:38 +0000 |
|---|---|---|
| committer | John Wiegley <johnw@newartisans.com> | 2002-04-15 05:40:38 +0000 |
| commit | ef7c29d679c6aaf8dda55772e65800097c46f163 (patch) | |
| tree | 543f39f09bfaa6d44606804c18babff26470d4f8 | |
| parent | 6fbcc92505250d896b5d408483822b115bc614c7 (diff) | |
*** no comment ***
| -rw-r--r-- | TODO | 6 | ||||
| -rw-r--r-- | chess-announce.el | 15 | ||||
| -rw-r--r-- | chess-autosave.el | 13 | ||||
| -rw-r--r-- | chess-common.el | 12 | ||||
| -rw-r--r-- | chess-crafty.el | 81 | ||||
| -rw-r--r-- | chess-database.el | 27 | ||||
| -rw-r--r-- | chess-display.el | 13 | ||||
| -rw-r--r-- | chess-engine.el | 426 | ||||
| -rw-r--r-- | chess-gnuchess.el | 61 | ||||
| -rw-r--r-- | chess-ics.el | 136 | ||||
| -rw-r--r-- | chess-ics1.el | 2 | ||||
| -rw-r--r-- | chess-images.el | 9 | ||||
| -rw-r--r-- | chess-irc.el | 81 | ||||
| -rw-r--r-- | chess-link.el | 11 | ||||
| -rw-r--r-- | chess-module.el | 3 | ||||
| -rw-r--r-- | chess-network.el | 159 | ||||
| -rw-r--r-- | chess-none.el | 15 | ||||
| -rw-r--r-- | chess-phalanx.el | 21 | ||||
| -rw-r--r-- | chess-plain.el | 2 | ||||
| -rw-r--r-- | chess-sound.el | 14 | ||||
| -rw-r--r-- | chess-transport.el | 45 | ||||
| -rw-r--r-- | chess.el | 134 |
22 files changed, 612 insertions, 674 deletions
@@ -9,12 +9,6 @@ analysis/highlight tools bughouse/crazyhouse -- if someone says Bx in the san input, use the x to constrain; but - using x is totally optional - -- undoing a single move (my move) and moving again, causes - chess-algebraic to get a little screwed up - - the game should go inactive once I lose by stalemate/checkmate - detect draw/resign/abort/retract, etc., from ICS and common engines diff --git a/chess-announce.el b/chess-announce.el index c69c7e1..1ef1a23 100644 --- a/chess-announce.el +++ b/chess-announce.el @@ -44,24 +44,19 @@ The first is called one start of the announcer. The second is called with the string to announce each time. The third is called to shutdown the announcer process, if necessary.") -(defun chess-announce-handler (event &rest args) - "This display module presents a standard chessboard. -See `chess-display-type' for the different kinds of displays." +(defun chess-announce-handler (game event &rest args) (cond ((eq event 'initialize) - (kill-buffer (current-buffer)) - (set-buffer (generate-new-buffer " *chess-announce*")) (funcall (nth 0 chess-announce-functions)) - (current-buffer)) + t) - ((eq event 'shutdown) + ((eq event 'destroy) (funcall (nth 2 chess-announce-functions))) ((eq event 'move) - (let* ((ply (chess-game-ply chess-display-game - (1- (chess-game-index chess-display-game)))) + (let* ((ply (chess-game-ply game (1- (chess-game-index game)))) (pos (chess-ply-pos ply))) - (unless (eq (chess-game-data chess-display-game 'my-color) + (unless (eq (chess-game-data game 'my-color) (chess-pos-side-to-move pos)) (let* ((source (chess-ply-source ply)) (target (chess-ply-target ply)) diff --git a/chess-autosave.el b/chess-autosave.el index 8652070..58a07c0 100644 --- a/chess-autosave.el +++ b/chess-autosave.el @@ -19,13 +19,13 @@ '((chess-read-autosave . "There is a chess autosave file, read it? ") (chess-delete-autosave . "Delete the autosave file? "))) -(defun chess-autosave-handler (event &rest args) +(defun chess-autosave-handler (game event &rest args) (cond ((eq event 'initialize) (if (file-readable-p chess-autosave-file) (if (y-or-n-p (chess-string 'chess-read-autosave)) (prog1 - (chess-game-copy-game chess-display-game + (chess-game-copy-game game (chess-read-game chess-autosave-file)) (delete-file chess-autosave-file)) (ignore @@ -33,13 +33,14 @@ (delete-file chess-autosave-file))))) (kill-buffer (current-buffer)) (set-buffer (find-file-noselect chess-autosave-file t)) - (current-buffer)) + t) ((eq event 'post-move) - (chess-autosave-write chess-display-game chess-autosave-file)) + (chess-autosave-write game chess-autosave-file)) - ((eq event 'shutdown) - (delete-file chess-autosave-file)))) + ((eq event 'destroy) + (if (file-readable-p chess-autosave-file) + (delete-file chess-autosave-file))))) (defun chess-autosave-write (game file) "Write a chess GAME to FILE as raw Lisp." diff --git a/chess-common.el b/chess-common.el index 5d8ae19..c25c1c9 100644 --- a/chess-common.el +++ b/chess-common.el @@ -28,7 +28,7 @@ (draw-offer-declined . "Your draw offer was declined") (illegal-move . "Illegal move"))) -(defun chess-common-handler (event &rest args) +(defun chess-common-handler (game event &rest args) "Initialize the network chess engine." (cond ((eq event 'initialize) @@ -44,9 +44,9 @@ proc)) ((eq event 'ready) - (chess-game-set-data chess-engine-game 'active t)) + (chess-game-set-data game 'active t)) - ((eq event 'shutdown) + ((eq event 'destroy) (chess-engine-send nil "quit\n") (dolist (file chess-common-temp-files) (if (file-exists-p file) @@ -74,12 +74,12 @@ ;; prevent use from handling the `undo' event which this triggers (let ((chess-engine-handling-event t)) - (chess-game-undo chess-engine-game (car args)))) + (chess-game-undo game (car args)))) ((eq event 'move) (chess-engine-send nil (concat (chess-ply-to-algebraic (car args)) "\n")) - (if (chess-game-over-p chess-engine-game) - (chess-game-set-data chess-engine-game 'active nil))))) + (if (chess-game-over-p game) + (chess-game-set-data game 'active nil))))) (provide 'chess-common) diff --git a/chess-crafty.el b/chess-crafty.el index be1e25b..204effe 100644 --- a/chess-crafty.el +++ b/chess-crafty.el @@ -37,46 +37,57 @@ (cons "\\(Illegal move\\|unrecognized/illegal command\\):\\s-*\\(.*\\)" (function (lambda () - (error (match-string 1))))))) + (error (match-string 1))))) + (cons "command not legal now" + (function + (lambda () + (error (match-string 0))))))) + +(defun chess-crafty-handler (game event &rest args) + (unless chess-engine-handling-event + (cond + ((eq event 'initialize) + (let ((proc (chess-common-handler game 'initialize "crafty"))) + (when (and (processp proc) + (eq (process-status proc) 'run)) + (process-send-string proc (concat "display nogeneral\n" + "display nochanges\n" + "display noextstats\n" + "display nohashstats\n" + "display nomoves\n" + "display nonodes\n" + "display noply1\n" + "display nostats\n" + "display notime\n" + "display novariation\n" + "alarm off\n" + "ansi off\n")) + t))) -(defun chess-crafty-handler (event &rest args) - (cond - ((eq event 'initialize) - (let ((proc (chess-common-handler 'initialize "crafty"))) - (process-send-string proc (concat "display nogeneral\n" - "display nochanges\n" - "display noextstats\n" - "display nohashstats\n" - "display nomoves\n" - "display nonodes\n" - "display noply1\n" - "display nostats\n" - "display notime\n" - "display novariation\n" - "alarm off\n" - "ansi off\n")) - proc)) + ((eq event 'setup-pos) + (chess-engine-send nil (format "setboard %s\n" + (chess-pos-to-string (car args))))) - ((eq event 'setup-pos) - (chess-engine-send nil (format "setboard %s\n" - (chess-pos-to-string (car args))))) + ((eq event 'evaluate) + (setq chess-crafty-evaluation nil) + (chess-engine-send nil "display general\nscore\ndisplay nogeneral\n") + (let ((limit 50)) + (while (and (null chess-crafty-evaluation) + (> (setq limit (1- limit)) 0)) + (sit-for 0 100 t)) + chess-crafty-evaluation)) - ((eq event 'evaluate) - (setq chess-crafty-evaluation nil) - (chess-engine-send nil "display general\nscore\ndisplay nogeneral\n") - (let ((limit 50)) - (while (and (null chess-crafty-evaluation) - (> (setq limit (1- limit)) 0)) - (sit-for 0 100 t)) - chess-crafty-evaluation)) + ((eq event 'setup-game) + (let ((file (chess-with-temp-file + (insert (chess-game-to-string (car args)) ?\n)))) + (chess-engine-send nil (format "read %s\n" file)))) - ((eq event 'setup-game) - (let ((file (chess-with-temp-file - (insert (chess-game-to-string (car args)) ?\n)))) - (chess-engine-send nil (format "read %s\n" file)))) + (t + (if (and (eq event 'undo) + (= 1 (mod (car args) 2))) + (error "Cannot undo until after crafty moves")) - (t - (apply 'chess-common-handler event args)))) + (apply 'chess-common-handler game event args))))) (provide 'chess-crafty) diff --git a/chess-database.el b/chess-database.el index 2f2655b..35cbc44 100644 --- a/chess-database.el +++ b/chess-database.el @@ -4,16 +4,9 @@ ;; ;; $Revision$ -(defvar chess-database-event-handler nil) +(defvar chess-database-handler nil) -(make-variable-buffer-local 'chess-database-event-handler) - -(defmacro chess-with-current-buffer (buffer &rest body) - `(let ((buf ,buffer)) - (if buf - (with-current-buffer buf - ,@body) - ,@body))) +(make-variable-buffer-local 'chess-database-handler) (chess-message-catalog 'english '((no-such-database . "There is no such chess database module '%s'"))) @@ -21,21 +14,19 @@ (defun chess-database-open (module file) "Returns the opened database object, or nil." (let* ((name (symbol-name module)) - (handler (intern-soft (concat name "-handler"))) - buffer) + (handler (intern-soft (concat name "-handler")))) (unless handler (chess-error 'no-such-database name)) (when (setq buffer (funcall handler 'open file)) (with-current-buffer buffer - (setq chess-database-event-handler handler) + (setq chess-database-handler handler) (add-hook 'kill-buffer-hook 'chess-database-close nil t) (add-hook 'after-revert-hook 'chess-database-rescan nil t) (current-buffer))))) (defsubst chess-database-command (database event &rest args) - (chess-with-current-buffer database - (apply 'chess-database-event-handler nil (current-buffer) - event args))) + (with-current-buffer database + (apply chess-database-handler event args))) (defun chess-database-close (&optional database) (let ((buf (or database (current-buffer)))) @@ -67,12 +58,6 @@ (defun chess-database-query (database &rest terms) (chess-database-command database 'query terms)) -(defun chess-database-event-handler (game database event &rest args) - (if (eq event 'shutdown) - (chess-database-close database) - (chess-with-current-buffer database - (apply chess-database-event-handler event args)))) - (provide 'chess-database) ;;; chess-database.el ends here diff --git a/chess-display.el b/chess-display.el index 7d6356f..68400ae 100644 --- a/chess-display.el +++ b/chess-display.el @@ -320,7 +320,7 @@ See `chess-display-type' for the different kinds of displays." (define-key map [?M] 'chess-display-match) (define-key map [(control ?c) (control ?r)] 'chess-display-resign) (define-key map [?S] 'chess-display-shuffle) - (define-key map [?U] 'chess-display-undo) + (define-key map [(control ?c) (control ?t)] 'chess-display-undo) (define-key map [?X] 'chess-display-quit) (define-key map [(control ?y)] 'chess-display-yank-board) @@ -505,10 +505,15 @@ Basically, it means we are playing, not editing or reviewing." last-command-char) (chess-display-update nil))) -(defalias 'chess-display-quit 'chess-module-destroy) - (chess-message-catalog 'english - '((illegal-notation . "Illegal move notation: %s"))) + '((illegal-notation . "Illegal move notation: %s") + (want-to-quit . "Do you really want to quit? "))) + +(defun chess-display-quit () + (interactive) + (if (or (not (chess-module-leader-p nil)) + (yes-or-no-p (chess-string 'want-to-quit))) + (chess-module-destroy nil))) (defun chess-display-manual-move (move) "Move a piece manually, using chess notation." diff --git a/chess-engine.el b/chess-engine.el index 2eb887a..8eb7f97 100644 --- a/chess-engine.el +++ b/chess-engine.el @@ -15,30 +15,26 @@ :group 'chess) (defvar chess-engine-regexp-alist nil) -(defvar chess-engine-event-handler nil) (defvar chess-engine-response-handler nil) (defvar chess-engine-current-marker nil) -(defvar chess-engine-game nil) (defvar chess-engine-pending-offer nil) (defvar chess-engine-pending-arg nil) (make-variable-buffer-local 'chess-engine-regexp-alist) -(make-variable-buffer-local 'chess-engine-event-handler) (make-variable-buffer-local 'chess-engine-response-handler) (make-variable-buffer-local 'chess-engine-current-marker) -(make-variable-buffer-local 'chess-engine-game) (make-variable-buffer-local 'chess-engine-pending-offer) (make-variable-buffer-local 'chess-engine-pending-arg) (defvar chess-engine-process nil) (defvar chess-engine-last-pos nil) (defvar chess-engine-working nil) +(defvar chess-engine-handling-event nil) (make-variable-buffer-local 'chess-engine-process) (make-variable-buffer-local 'chess-engine-last-pos) (make-variable-buffer-local 'chess-engine-working) -(defvar chess-engine-handling-event nil) (defvar chess-engine-inhibit-auto-pass nil) ;;; Code: @@ -96,212 +92,192 @@ (chess-message 'invalid-pgn)))) (defun chess-engine-default-handler (event &rest args) - (cond - ((eq event 'move) - (if (chess-game-data chess-engine-game 'active) - ;; we don't want the `move' event coming back to us + (let ((game (chess-engine-game nil))) + (cond + ((eq event 'move) + (if (chess-game-data game 'active) + ;; we don't want the `move' event coming back to us + (let ((chess-engine-handling-event t)) + (when (car args) + ;; if the game index is still 0, then our opponent + ;; is white, and we need to pass over the move + (when (and (not chess-engine-inhibit-auto-pass) + (chess-game-data game 'my-color) + (= (chess-game-index game) 0)) + (chess-message 'now-black) + (chess-game-run-hooks game 'pass) + ;; if no one else flipped my-color, we'll do it + (if (chess-game-data game 'my-color) + (chess-game-set-data game 'my-color nil))) + (chess-game-move game (car args)) + (if (chess-game-over-p game) + (chess-game-set-data game 'active nil)) + t)))) + + ((eq event 'pass) + (when (chess-game-data game 'active) + (chess-message 'move-passed) + t)) + + ((eq event 'match) + (if (chess-game-data game 'active) + (chess-engine-command nil 'busy) + (if (y-or-n-p + (if (and (car args) (> (length (car args)) 0)) + (chess-string 'want-to-play (car args)) + (chess-string 'want-to-play-a))) + (progn + (let ((chess-engine-handling-event t)) + (chess-engine-set-position nil)) + (chess-engine-command nil 'accept)) + (chess-engine-command nil 'decline))) + t) + + ((eq event 'setup-pos) + (when (car args) + ;; we don't want the `setup-game' event coming back to us (let ((chess-engine-handling-event t)) - (when (car args) - ;; if the game index is still 0, then our opponent - ;; is white, and we need to pass over the move - (when (and (not chess-engine-inhibit-auto-pass) - (chess-game-data chess-engine-game 'my-color) - (= (chess-game-index chess-engine-game) 0)) - (chess-message 'now-black) - (chess-game-run-hooks chess-engine-game 'pass) - ;; if no one else flipped my-color, we'll do it - (if (chess-game-data chess-engine-game 'my-color) - (chess-game-set-data chess-engine-game 'my-color nil))) - (chess-game-move chess-engine-game (car args)) - (if (chess-game-over-p chess-engine-game) - (chess-game-set-data chess-engine-game 'active nil)) - t)))) - - ((eq event 'pass) - (when (chess-game-data chess-engine-game 'active) - (chess-message 'move-passed) - t)) - - ((eq event 'match) - (if (chess-game-data chess-engine-game 'active) - (chess-engine-command nil 'busy) - (if (y-or-n-p - (if (and (car args) (> (length (car args)) 0)) - (chess-string 'want-to-play (car args)) - (chess-string 'want-to-play-a))) + (chess-engine-set-position nil (car args) t)) + t)) + + ((eq event 'setup-game) + (when (car args) + ;; we don't want the `setup-game' event coming back to us + (let ((chess-engine-handling-event t) + (chess-game-inhibit-events t)) + (chess-engine-set-game nil (car args)) + (chess-game-set-data game 'active t) + (if (string= chess-full-name + (chess-game-tag game "White")) + (chess-game-set-data game 'my-color t) + (chess-game-set-data game 'my-color nil))) + t)) + + ((eq event 'quit) + (chess-message 'opp-quit) + (let ((chess-engine-handling-event t)) + (chess-game-set-data game 'active nil)) + t) + + ((eq event 'resign) + (let ((chess-engine-handling-event t)) + (chess-message 'opp-resigned) + (chess-game-end game :resign) + (chess-game-set-data game 'active nil) + t)) + + ((eq event 'draw) + (if (y-or-n-p (chess-string 'opp-draw)) (progn (let ((chess-engine-handling-event t)) - (chess-engine-set-position nil)) + (chess-game-end game :draw) + (chess-game-set-data game 'active nil)) (chess-engine-command nil 'accept)) - (chess-engine-command nil 'decline))) - t) + (chess-engine-command nil 'decline)) + t) - ((eq event 'setup-pos) - (when (car args) - ;; we don't want the `setup-game' event coming back to us - (let ((chess-engine-handling-event t)) - (chess-engine-set-position nil (car args) t)) - t)) - - ((eq event 'setup-game) - (when (car args) - ;; we don't want the `setup-game' event coming back to us - (let ((chess-engine-handling-event t) - (chess-game-inhibit-events t)) - (chess-engine-set-game nil (car args)) - (chess-game-set-data chess-engine-game 'active t) - (if (string= chess-full-name - (chess-game-tag chess-engine-game "White")) - (chess-game-set-data chess-engine-game 'my-color t) - (chess-game-set-data chess-engine-game 'my-color nil))) - t)) - - ((eq event 'quit) - (chess-message 'opp-quit) - (let ((chess-engine-handling-event t)) - (chess-game-set-data chess-engine-game 'active nil)) - t) - - ((eq event 'resign) - (let ((chess-engine-handling-event t)) - (chess-message 'opp-resigned) - (chess-game-end chess-engine-game :resign) - (chess-game-set-data chess-engine-game 'active nil) - t)) - - ((eq event 'draw) - (if (y-or-n-p (chess-string 'opp-draw)) - (progn - (let ((chess-engine-handling-event t)) - (chess-game-end chess-engine-game :draw) - (chess-game-set-data chess-engine-game 'active nil)) - (chess-engine-command nil 'accept)) - (chess-engine-command nil 'decline)) - t) - - ((eq event 'abort) - (if (y-or-n-p (chess-string 'opp-abort)) - (progn - (let ((chess-engine-handling-event t)) - (chess-game-set-data chess-engine-game 'active nil)) - (chess-engine-command nil 'accept)) - (chess-engine-command nil 'decline)) - t) - - ((eq event 'undo) - (if (y-or-n-p (chess-string 'opp-undo (car args))) - (progn - (let ((chess-engine-handling-event t)) - (chess-game-undo chess-engine-game (car args))) - (chess-engine-command nil 'accept)) - (chess-engine-command nil 'decline)) - t) - - ((eq event 'accept) - (when chess-engine-pending-offer - (if (eq chess-engine-pending-offer 'match) - (unless (chess-game-data chess-engine-game 'active) - (if (and (car args) (> (length (car args)) 0)) - (chess-message 'opp-ready (car args)) - (chess-message 'opp-ready-a)) + ((eq event 'abort) + (if (y-or-n-p (chess-string 'opp-abort)) + (progn (let ((chess-engine-handling-event t)) - (chess-engine-set-position nil))) - (let ((chess-engine-handling-event t)) - (cond - ((eq chess-engine-pending-offer 'draw) - (chess-message 'opp-draw-acc) - (chess-game-end chess-engine-game :draw) - (chess-game-set-data chess-engine-game 'active nil)) - - ((eq chess-engine-pending-offer 'abort) - (chess-message 'opp-abort-acc) - (chess-game-set-data chess-engine-game 'active nil)) - - ((eq chess-engine-pending-offer 'undo) - (chess-message 'opp-undo-acc chess-engine-pending-arg) - (chess-game-undo chess-engine-game (car args)))))) - (setq chess-engine-pending-offer nil - chess-engine-pending-arg nil) - t)) - - ((eq event 'decline) - (when chess-engine-pending-offer - (cond - ((eq chess-engine-pending-offer 'draw) - (chess-message 'opp-draw-dec)) - - ((eq chess-engine-pending-offer 'abort) - (chess-message 'opp-abort-dec)) - - ((eq chess-engine-pending-offer 'undo) - (chess-message 'opp-undo-dec chess-engine-pending-arg))) - - (setq chess-engine-pending-offer nil - chess-engine-pending-arg nil) - t)) - - ((eq event 'retract) - (when chess-engine-pending-offer - (cond - ((eq chess-engine-pending-offer 'draw) - (chess-message 'opp-draw-ret)) - - ((eq chess-engine-pending-offer 'abort) - (chess-message 'opp-abort-ret)) - - ((eq chess-engine-pending-offer 'undo) - (chess-message 'opp-undo-ret chess-engine-pending-arg))) - - (setq chess-engine-pending-offer nil - chess-engine-pending-arg nil) - t)) - - ((eq event 'illegal) - (chess-message 'opp-illegal)))) - -(defun chess-engine-create (game module &optional response-handler + (chess-game-set-data game 'active nil)) + (chess-engine-command nil 'accept)) + (chess-engine-command nil 'decline)) + t) + + ((eq event 'undo) + (if (y-or-n-p (chess-string 'opp-undo (car args))) + (progn + (let ((chess-engine-handling-event t)) + (chess-game-undo game (car args))) + (chess-engine-command nil 'accept)) + (chess-engine-command nil 'decline)) + t) + + ((eq event 'accept) + (when chess-engine-pending-offer + (if (eq chess-engine-pending-offer 'match) + (unless (chess-game-data game 'active) + (if (and (car args) (> (length (car args)) 0)) + (chess-message 'opp-ready (car args)) + (chess-message 'opp-ready-a)) + (let ((chess-engine-handling-event t)) + (chess-engine-set-position nil))) + (let ((chess-engine-handling-event t)) + (cond + ((eq chess-engine-pending-offer 'draw) + (chess-message 'opp-draw-acc) + (chess-game-end game :draw) + (chess-game-set-data game 'active nil)) + + ((eq chess-engine-pending-offer 'abort) + (chess-message 'opp-abort-acc) + (chess-game-set-data game 'active nil)) + + ((eq chess-engine-pending-offer 'undo) + (chess-message 'opp-undo-acc chess-engine-pending-arg) + (chess-game-undo game (car args)))))) + (setq chess-engine-pending-offer nil + chess-engine-pending-arg nil) + t)) + + ((eq event 'decline) + (when chess-engine-pending-offer + (cond + ((eq chess-engine-pending-offer 'draw) + (chess-message 'opp-draw-dec)) + + ((eq chess-engine-pending-offer 'abort) + (chess-message 'opp-abort-dec)) + + ((eq chess-engine-pending-offer 'undo) + (chess-message 'opp-undo-dec chess-engine-pending-arg))) + + (setq chess-engine-pending-offer nil + chess-engine-pending-arg nil) + t)) + + ((eq event 'retract) + (when chess-engine-pending-offer + (cond + ((eq chess-engine-pending-offer 'draw) + (chess-message 'opp-draw-ret)) + + ((eq chess-engine-pending-offer 'abort) + (chess-message 'opp-abort-ret)) + + ((eq chess-engine-pending-offer 'undo) + (chess-message 'opp-undo-ret chess-engine-pending-arg))) + + (setq chess-engine-pending-offer nil + chess-engine-pending-arg nil) + t)) + + ((eq event 'illegal) + (chess-message 'opp-illegal))))) + +(defun chess-engine-create (module game &optional response-handler &rest handler-ctor-args) - (let ((regexp-alist (intern-soft (concat (symbol-name module) - "-regexp-alist"))) - (handler (intern-soft (concat (symbol-name module) "-handler"))) - buffer) - (with-current-buffer (generate-new-buffer " *chess-engine*") - (setq buffer (current-buffer)) - (let ((proc (apply handler 'initialize handler-ctor-args))) - (if (null proc) ; must be a process or t - (ignore - (kill-buffer buffer)) - (add-hook 'kill-buffer-hook 'chess-engine-on-kill nil t) - (setq chess-engine-regexp-alist (symbol-value regexp-alist) - chess-engine-event-handler handler - chess-engine-response-handler - (or response-handler 'chess-engine-default-handler)) - (chess-engine-set-game* nil game t) + (let* ((engine (chess-module-create module game nil handler-ctor-args))) + (when engine + (with-current-buffer engine + (setq chess-engine-regexp-alist + (symbol-value + (intern (concat (symbol-name module) "-regexp-alist"))) + chess-engine-response-handler + (or response-handler 'chess-engine-default-handler)) + (let ((proc (get-buffer-process (current-buffer)))) (when (processp proc) (unless (memq (process-status proc) '(run open)) (chess-error 'failed-engine-start)) (setq chess-engine-process proc) - (set-process-buffer proc (current-buffer)) (set-process-filter proc 'chess-engine-filter)) (setq chess-engine-current-marker (point-marker)) - buffer))))) - -(defun chess-engine-on-kill () - "Function called when the buffer is killed." - (chess-engine-command nil 'shutdown)) - -(defun chess-engine-destroy (engine) - (let ((buf (or engine (current-buffer)))) - (when (buffer-live-p buf) - (with-current-buffer buf - (remove-hook 'kill-buffer-hook 'chess-engine-on-kill t)) - (chess-engine-command buf 'destroy) - (kill-buffer buf)))) + (current-buffer)))))) (defun chess-engine-command (engine event &rest args) (chess-with-current-buffer engine - (apply 'chess-engine-event-handler chess-engine-game - engine event args))) + (apply chess-module-event-handler chess-module-game event args))) ;; 'ponder ;; 'search-depth @@ -329,49 +305,25 @@ (let ((chess-game-inhibit-events t)) (if position (progn - (chess-game-set-start-position chess-engine-game position) - (chess-game-set-data chess-engine-game 'my-color my-color)) - (chess-game-set-start-position chess-engine-game + (chess-game-set-start-position chess-module-game position) + (chess-game-set-data chess-module-game 'my-color my-color)) + (chess-game-set-start-position chess-module-game chess-starting-position) - (chess-game-set-data chess-engine-game 'my-color t)) - (chess-game-set-data chess-engine-game 'active t)))) + (chess-game-set-data chess-module-game 'my-color t)) + (chess-game-set-data chess-module-game 'active t)))) (defun chess-engine-position (engine) (chess-with-current-buffer engine - (chess-game-pos chess-engine-game))) - -(defun chess-engine-set-game (engine game &optional no-setup) - (chess-with-current-buffer engine - (let ((chess-game-inhibit-events no-setup)) - (chess-game-copy-game chess-engine-game game)))) - -(defun chess-engine-set-game* (engine game &optional no-setup) - (chess-with-current-buffer engine - (if chess-engine-game - (chess-engine-detach-game nil)) - (setq chess-engine-game game) - (chess-game-add-hook game 'chess-engine-event-handler - (or engine (current-buffer))) - (unless no-setup - (chess-engine-command nil 'setup-game game)))) - -(defun chess-engine-detach-game (engine) - (chess-with-current-buffer engine - (chess-game-remove-hook chess-engine-game - 'chess-engine-event-handler - (or engine (current-buffer))))) + (chess-game-pos chess-module-game))) -(defun chess-engine-game (engine) - (chess-with-current-buffer engine - chess-engine-game)) - -(defun chess-engine-index (engine) - (chess-with-current-buffer engine - (chess-game-index chess-engine-game))) +(defalias 'chess-engine-game 'chess-module-game) +(defalias 'chess-engine-set-game 'chess-module-set-game) +(defalias 'chess-engine-set-game* 'chess-module-set-game*) +(defalias 'chess-engine-index 'chess-module-game-index) (defun chess-engine-move (engine ply) (chess-with-current-buffer engine - (chess-game-move chess-engine-game ply) + (chess-game-move chess-module-game ply) (chess-engine-command engine 'move ply))) (chess-message-catalog 'english @@ -403,20 +355,6 @@ ;; Primary event handler ;; -(defun chess-engine-event-handler (game engine event &rest args) - "Handle any commands being sent to this instance of this module." - (unless chess-engine-handling-event - (let (result) - (chess-with-current-buffer engine - (setq result (apply chess-engine-event-handler event args))) - (cond - ((eq event 'shutdown) - (chess-engine-destroy engine)) - - ((eq event 'destroy) - (chess-engine-detach-game engine))) - result))) - (defun chess-engine-sentinal (proc event) (when (buffer-live-p (process-buffer proc)) (set-buffer (process-buffer proc)) diff --git a/chess-gnuchess.el b/chess-gnuchess.el index 225ee30..32c4030 100644 --- a/chess-gnuchess.el +++ b/chess-gnuchess.el @@ -38,40 +38,43 @@ ;; "go" after the user's move (setq chess-gnuchess-bad-board t)))))) -(defun chess-gnuchess-handler (event &rest args) - (cond - ((eq event 'initialize) - (let ((proc (chess-common-handler 'initialize "gnuchess"))) - (process-send-string proc "nopost\n") - proc)) +(defun chess-gnuchess-handler (game event &rest args) + (unless chess-engine-handling-event + (cond + ((eq event 'initialize) + (let ((proc (chess-common-handler game 'initialize "gnuchess"))) + (when (and (processp proc) + (eq (process-status proc) 'run)) + (process-send-string proc "nopost\n") + t))) - ((eq event 'setup-pos) - (let ((file (chess-with-temp-file - (insert (chess-pos-to-string (car args)) ?\n)))) - (chess-engine-send nil (format "epdload %s\n" file)))) + ((eq event 'setup-pos) + (let ((file (chess-with-temp-file + (insert (chess-pos-to-string (car args)) ?\n)))) + (chess-engine-send nil (format "epdload %s\n" file)))) - ((eq event 'setup-game) - (let ((file (chess-with-temp-file - (insert (chess-game-to-string (car args)) ?\n)))) - (chess-engine-send nil (format "pgnload %s\n" file)))) + ((eq event 'setup-game) + (let ((file (chess-with-temp-file + (insert (chess-game-to-string (car args)) ?\n)))) + (chess-engine-send nil (format "pgnload %s\n" file)))) - ((eq event 'pass) - (chess-engine-send nil (concat (if (chess-pos-side-to-move - (chess-engine-position nil)) - "white" "black") - "\n")) - (chess-engine-send nil "go\n") - (setq chess-gnuchess-bad-board nil)) - - ((eq event 'move) - (chess-engine-send nil (concat (chess-ply-to-algebraic (car args)) - "\n")) - (when chess-gnuchess-bad-board + ((eq event 'pass) + (chess-engine-send nil (concat (if (chess-pos-side-to-move + (chess-engine-position nil)) + "white" "black") + "\n")) (chess-engine-send nil "go\n") - (setq chess-gnuchess-bad-board nil))) + (setq chess-gnuchess-bad-board nil)) + + ((eq event 'move) + (chess-engine-send nil (concat (chess-ply-to-algebraic (car args)) + "\n")) + (when chess-gnuchess-bad-board + (chess-engine-send nil "go\n") + (setq chess-gnuchess-bad-board nil))) - (t - (apply 'chess-common-handler event args)))) + (t + (apply 'chess-common-handler game event args))))) (provide 'chess-gnuchess) diff --git a/chess-ics.el b/chess-ics.el index 4b1284a..ecd898b 100644 --- a/chess-ics.el +++ b/chess-ics.el @@ -132,23 +132,24 @@ who is black." (begin (match-beginning 1)) (end (match-end 1)) (info (chess-ics12-parse (match-string 3)))) - (if (and (chess-game-data chess-engine-game 'active) - (> (chess-game-index chess-engine-game) 0)) + (if (and (chess-game-data (chess-engine-game nil) 'active) + (> (chess-engine-index nil) 0)) (when (and (cadr info) (eq (chess-pos-side-to-move (car info)) - (chess-game-data chess-engine-game 'my-color))) - (chess-game-move chess-engine-game + (chess-game-data (chess-engine-game nil) 'my-color))) + (chess-game-move (chess-engine-game nil) (chess-algebraic-to-ply (chess-ply-pos - (car (last (chess-game-plies chess-engine-game)))) + (car (last (chess-game-plies + (chess-engine-game nil))))) (cadr info) t)) (assert (equal (car info) (chess-engine-position nil)))) (let ((chess-game-inhibit-events t) plies) - (chess-game-set-data chess-engine-game + (chess-game-set-data (chess-engine-game nil) 'my-color (string= (nth 2 info) chess-ics-handle)) - (chess-game-set-data chess-engine-game 'active t) - (chess-game-set-start-position chess-engine-game (car info))) - (chess-game-run-hooks chess-engine-game 'orient)) + (chess-game-set-data (chess-engine-game nil) 'active t) + (chess-game-set-start-position (chess-engine-game nil) (car info))) + (chess-game-run-hooks (chess-engine-game nil) 'orient)) (delete-region begin end) t)) @@ -167,70 +168,69 @@ who is black." (ics-connected . "Connecting to Internet Chess Server '%s'...done") (challenge-whom . "Whom would you like challenge? "))) -(defun chess-ics-handler (event &rest args) - (cond - ((eq event 'initialize) - (kill-buffer (current-buffer)) - - (let ((server - (if (= (length chess-ics-server-list) 1) - (car chess-ics-server-list) - (assoc (completing-read (chess-string 'ics-server-prompt) - chess-ics-server-list - nil t (caar chess-ics-server-list)) - chess-ics-server-list)))) - - (chess-message 'ics-connecting (car server)) - - (let ((buf (apply 'make-comint "chess-ics" - (if (nth 3 server) - (cons (nth 4 server) (nth 5 server)) - (list (cons (nth 0 server) (nth 1 server))))))) - - (chess-message 'ics-connected (car server)) - - (display-buffer buf) - (set-buffer buf) - - (add-hook 'comint-output-filter-functions 'chess-ics-filter t t) - (set (make-local-variable 'comint-preoutput-filter-functions) - '(chess-ics-strip)) - - (if (nth 2 server) - (progn - (setq chess-ics-handle (nth 2 server)) - (comint-send-string (concat chess-ics-handle "\n")) - (let ((pass (nth 3 server))) - (when pass - (if (file-readable-p pass) - (setq pass (with-temp-buffer - (insert-file-contents file) - (buffer-string)))) - (comint-send-string (concat pass "\n"))))) - ;; jww (2002-04-13): Have to parse out the allocated Guest - ;; name from the output - (comint-send-string "guest\n\n")))) - +(defun chess-ics-handler (game event &rest args) + (unless chess-engine-handling-event + (cond + ((eq event 'initialize) + (kill-buffer (current-buffer)) + (let ((server + (if (= (length chess-ics-server-list) 1) + (car chess-ics-server-list) + (assoc (completing-read (chess-string 'ics-server-prompt) + chess-ics-server-list + nil t (caar chess-ics-server-list)) + chess-ics-server-list)))) + + (chess-message 'ics-connecting (car server)) + + (let ((buf (apply 'make-comint "chess-ics" + (if (nth 3 server) + (cons (nth 4 server) (nth 5 server)) + (list (cons (nth 0 server) (nth 1 server))))))) + + (chess-message 'ics-connected (car server)) + + (display-buffer buf) + (set-buffer buf) + + (add-hook 'comint-output-filter-functions 'chess-ics-filter t t) + (set (make-local-variable 'comint-preoutput-filter-functions) + '(chess-ics-strip)) + + (if (nth 2 server) + (progn + (setq chess-ics-handle (nth 2 server)) + (comint-send-string (concat chess-ics-handle "\n")) + (let ((pass (nth 3 server))) + (when pass + (if (file-readable-p pass) + (setq pass (with-temp-buffer + (insert-file-contents file) + (buffer-string)))) + (comint-send-string (concat pass "\n"))))) + ;; jww (2002-04-13): Have to parse out the allocated Guest + ;; name from the output + (comint-send-string "guest\n\n")))) t) - ((eq event 'match) - (setq chess-engine-pending-offer 'match) - (chess-engine-send - nil (format "match %s\n" - (read-string (chess-string 'challenge-whom))))) + ((eq event 'match) + (setq chess-engine-pending-offer 'match) + (chess-engine-send + nil (format "match %s\n" + (read-string (chess-string 'challenge-whom))))) - ((eq event 'move) - (unless chess-ics-ensure-ics12 - (chess-engine-send nil "set style 12\n") - (setq chess-ics-ensure-ics12 t)) - (chess-network-handler 'move (car args))) + ((eq event 'move) + (unless chess-ics-ensure-ics12 + (chess-engine-send nil "set style 12\n") + (setq chess-ics-ensure-ics12 t)) + (chess-network-handler 'move (car args))) - ((eq event 'send) - (comint-send-string (get-buffer-process (current-buffer)) - (car args))) + ((eq event 'send) + (comint-send-string (get-buffer-process (current-buffer)) + (car args))) - (t - (apply 'chess-network-handler event args)))) + (t + (apply 'chess-network-handler event args))))) (defun chess-ics-filter (string) (save-excursion diff --git a/chess-ics1.el b/chess-ics1.el index ac8e485..f21c63e 100644 --- a/chess-ics1.el +++ b/chess-ics1.el @@ -39,7 +39,7 @@ (defun chess-ics1-handler (event &rest args) (cond - ((eq event 'initialize) (current-buffer)) + ((eq event 'initialize) t) ((eq event 'popup) (if chess-display-popup (funcall chess-ics1-popup-function))) diff --git a/chess-images.el b/chess-images.el index 96aa8eb..e6f86ca 100644 --- a/chess-images.el +++ b/chess-images.el @@ -152,17 +152,16 @@ called." "The names and index values of the different pieces.") (chess-message-catalog 'english - '((no-images-fallback . "Could not find suitable chess images; using ics1 display"))) + '((no-images-fallback . "Could not find suitable chess images"))) (defun chess-images-handler (event &rest args) (cond ((eq event 'initialize) (when (display-graphic-p) (chess-images-initialize) - (if chess-images-size - (current-buffer) - (chess-message 'no-images-fallback) - nil))) + (or chess-images-size + (ignore + (chess-message 'no-images-fallback))))) ((eq event 'popup) (if chess-display-popup diff --git a/chess-irc.el b/chess-irc.el index c5ae5d0..b8dfa9e 100644 --- a/chess-irc.el +++ b/chess-irc.el @@ -56,47 +56,48 @@ (make-variable-buffer-local 'chess-irc-last-pos) (make-variable-buffer-local 'chess-irc-use-ctcp) -(defun chess-irc-handler (event &rest args) +(defun chess-irc-handler (game event &rest args) "This is an example of a generic transport engine." - (cond - ((eq event 'initialize) - (chess-message 'irc-connecting chess-irc-server chess-irc-port) - (let ((engine (current-buffer)) proc) - (with-current-buffer (generate-new-buffer " *chess-irc*") - (setq chess-irc-engine engine - proc (open-network-stream "*chess-irc*" (current-buffer) - chess-irc-server chess-irc-port)) - (chess-message 'irc-logging-in chess-irc-nick) - (when (and proc (eq (process-status proc) 'open)) - (process-send-string proc (format "USER %s 0 * :%s\n" - (user-login-name) - chess-full-name)) - (process-send-string proc (format "NICK %s\n" chess-irc-nick)) - (set-process-filter proc 'chess-irc-filter) - (set-process-buffer proc (current-buffer)) - (set-marker (process-mark proc) (point)) - (chess-message 'irc-waiting))) - (setq chess-irc-process proc)) - t) - - ((eq event 'match) - (setq chess-irc-opponent (read-string (chess-string 'irc-challenge))) - (chess-network-handler 'match chess-irc-opponent)) - - ((eq event 'shutdown) - (chess-engine-send nil "quit") - (process-send-string chess-irc-process "QUIT :Goodbye\n") - (kill-buffer (process-buffer chess-irc-process))) - - ((eq event 'send) - (process-send-string chess-irc-process - (if chess-irc-use-ctcp - (format "PRIVMSG %s :\C-aCHESS %s\C-a\n" - chess-irc-opponent (car args)) - (format "PRIVMSG %s :%s\n" - chess-irc-opponent (car args))))) - (t - (apply 'chess-network-handler event args)))) + (unless chess-engine-handling-event + (cond + ((eq event 'initialize) + (chess-message 'irc-connecting chess-irc-server chess-irc-port) + (let ((engine (current-buffer)) proc) + (with-current-buffer (generate-new-buffer " *chess-irc*") + (setq chess-irc-engine engine + proc (open-network-stream "*chess-irc*" (current-buffer) + chess-irc-server chess-irc-port)) + (chess-message 'irc-logging-in chess-irc-nick) + (when (and proc (eq (process-status proc) 'open)) + (process-send-string proc (format "USER %s 0 * :%s\n" + (user-login-name) + chess-full-name)) + (process-send-string proc (format "NICK %s\n" chess-irc-nick)) + (set-process-filter proc 'chess-irc-filter) + (set-process-buffer proc (current-buffer)) + (set-marker (process-mark proc) (point)) + (chess-message 'irc-waiting))) + (setq chess-irc-process proc)) + t) + + ((eq event 'match) + (setq chess-irc-opponent (read-string (chess-string 'irc-challenge))) + (chess-network-handler 'match chess-irc-opponent)) + + ((eq event 'destroy) + (chess-engine-send nil "quit") + (process-send-string chess-irc-process "QUIT :Goodbye\n") + (kill-buffer (process-buffer chess-irc-process))) + + ((eq event 'send) + (process-send-string chess-irc-process + (if chess-irc-use-ctcp + (format "PRIVMSG %s :\C-aCHESS %s\C-a\n" + chess-irc-opponent (car args)) + (format "PRIVMSG %s :%s\n" + chess-irc-opponent (car args))))) + (t + (apply 'chess-network-handler event args))))) ;; This filter translates IRC syntax into basic chess-network protocol (defun chess-irc-filter (proc string) diff --git a/chess-link.el b/chess-link.el index 9552a0f..dd57632 100644 --- a/chess-link.el +++ b/chess-link.el @@ -13,9 +13,9 @@ (defun chess-link-response-handler (event &rest args) "This function handles responses from the bot's computing engine." (let ((first-engine - (chess-game-data chess-engine-game 'first-engine)) + (chess-game-data (chess-engine-game nil) 'first-engine)) (second-engine - (chess-game-data chess-engine-game 'second-engine)) + (chess-game-data (chess-engine-game nil) 'second-engine)) return-value) (cond ((eq event 'match) @@ -53,8 +53,7 @@ engine, and the computer the second engine." (require chess-default-display) (let* ((my-color t) ; we start out as white always (game (chess-game-create)) - (display (chess-display-create game chess-default-display - my-color))) + (display (chess-create-display-object my-color))) (chess-game-set-data game 'my-color my-color) (chess-display-set-main display) (chess-display-disable-popup display) @@ -62,9 +61,9 @@ engine, and the computer the second engine." (when (and (require first-engine-type) (require second-engine-type)) (let ((first-engine - (chess-engine-create game first-engine-type)) + (chess-engine-create first-engine-type game)) (second-engine - (chess-engine-create game second-engine-type))) + (chess-engine-create second-engine-type game))) (chess-game-set-data game 'first-engine first-engine) (chess-engine-command first-engine 'ready) diff --git a/chess-module.el b/chess-module.el index 8d6eed9..47b5ff0 100644 --- a/chess-module.el +++ b/chess-module.el @@ -83,8 +83,7 @@ (chess-with-current-buffer module (setq chess-module-leader nil))) -(defun chess-module-destroy (&optional module) - (interactive) +(defun chess-module-destroy (module) (let ((buf (or module (current-buffer)))) (when (buffer-live-p buf) (with-current-buffer buf diff --git a/chess-network.el b/chess-network.el index f44d4b0..0d7a6af 100644 --- a/chess-network.el +++ b/chess-network.el @@ -74,86 +74,87 @@ (network-waiting . "Now waiting for your opponent to connect...") (network-connected ."You have connected; pass now or make your move."))) -(defun chess-network-handler (event &rest args) +(defun chess-network-handler (game event &rest args) "Initialize the network chess engine." - (cond - ((eq event 'initialize) - (let ((which (read-char "Are you the c)lient or s)erver? ")) - proc) - (chess-message 'network-starting) - (setq proc (if (eq which ?s) - (start-process "*chess-network*" - (current-buffer) "/usr/bin/nc" - "-l" "-p" (read-string "Port: ")) - (open-network-stream "*chess-network*" (current-buffer) - (read-string "Host: ") - (read-string "Port: ")))) - (if (eq which ?s) - (chess-message 'network-waiting) - (chess-network-handler 'match) - (chess-message 'network-connected)) - proc)) - - ((eq event 'shutdown) - (chess-engine-send nil "quit\n")) - - ((eq event 'setup-pos) - (chess-engine-send nil (format "fen %s\n" - (chess-pos-to-string (car args))))) - - ((eq event 'setup-game) - (chess-engine-send nil (format "pgn %s\n" - (chess-game-to-string (car args))))) - - ((eq event 'pass) - (chess-engine-send nil "pass\n")) - - ((eq event 'busy) - (chess-engine-send nil "playing\n")) - - ((eq event 'match) - (setq chess-engine-pending-offer 'match) - (chess-engine-send nil (format "chess match %s\n" chess-full-name))) - - ((eq event 'resign) - (chess-engine-send nil "resign\n") - (chess-game-set-data chess-engine-game 'active nil)) - - ((eq event 'draw) - (if chess-engine-pending-offer - (chess-engine-command nil 'retract)) - (setq chess-engine-pending-offer 'draw) - (chess-engine-send nil "draw\n")) - - ((eq event 'abort) - (if chess-engine-pending-offer - (chess-engine-command nil 'retract)) - (setq chess-engine-pending-offer 'abort) - (chess-engine-send nil "abort\n")) - - ((eq event 'undo) - (if chess-engine-pending-offer - (chess-engine-command nil 'retract)) - (setq chess-engine-pending-offer 'undo - chess-engine-pending-arg (car args)) - (chess-engine-send nil (format "takeback %d\n" (car args)))) - - ((eq event 'accept) - (chess-engine-send nil "accept\n")) - - ((eq event 'decline) - (chess-engine-send nil "decline\n")) - - ((eq event 'retract) - (chess-engine-send nil "retract\n")) - - ((eq event 'illegal) - (chess-engine-send nil "illegal\n")) - - ((eq event 'move) - (chess-engine-send nil (concat (chess-ply-to-algebraic (car args)) "\n")) - (if (chess-game-over-p chess-engine-game) - (chess-game-set-data chess-engine-game 'active nil))))) + (unless chess-engine-handling-event + (cond + ((eq event 'initialize) + (let ((which (read-char "Are you the c)lient or s)erver? ")) + proc) + (chess-message 'network-starting) + (setq proc (if (eq which ?s) + (start-process "*chess-network*" + (current-buffer) "/usr/bin/nc" + "-l" "-p" (read-string "Port: ")) + (open-network-stream "*chess-network*" (current-buffer) + (read-string "Host: ") + (read-string "Port: ")))) + (if (eq which ?s) + (chess-message 'network-waiting) + (chess-network-handler 'match) + (chess-message 'network-connected)) + t)) + + ((eq event 'destroy) + (chess-engine-send nil "quit\n")) + + ((eq event 'setup-pos) + (chess-engine-send nil (format "fen %s\n" + (chess-pos-to-string (car args))))) + + ((eq event 'setup-game) + (chess-engine-send nil (format "pgn %s\n" + (chess-game-to-string (car args))))) + + ((eq event 'pass) + (chess-engine-send nil "pass\n")) + + ((eq event 'busy) + (chess-engine-send nil "playing\n")) + + ((eq event 'match) + (setq chess-engine-pending-offer 'match) + (chess-engine-send nil (format "chess match %s\n" chess-full-name))) + + ((eq event 'resign) + (chess-engine-send nil "resign\n") + (chess-game-set-data game 'active nil)) + + ((eq event 'draw) + (if chess-engine-pending-offer + (chess-engine-command nil 'retract)) + (setq chess-engine-pending-offer 'draw) + (chess-engine-send nil "draw\n")) + + ((eq event 'abort) + (if chess-engine-pending-offer + (chess-engine-command nil 'retract)) + (setq chess-engine-pending-offer 'abort) + (chess-engine-send nil "abort\n")) + + ((eq event 'undo) + (if chess-engine-pending-offer + (chess-engine-command nil 'retract)) + (setq chess-engine-pending-offer 'undo + chess-engine-pending-arg (car args)) + (chess-engine-send nil (format "takeback %d\n" (car args)))) + + ((eq event 'accept) + (chess-engine-send nil "accept\n")) + + ((eq event 'decline) + (chess-engine-send nil "decline\n")) + + ((eq event 'retract) + (chess-engine-send nil "retract\n")) + + ((eq event 'illegal) + (chess-engine-send nil "illegal\n")) + + ((eq event 'move) + (chess-engine-send nil (concat (chess-ply-to-algebraic (car args)) "\n")) + (if (chess-game-over-p game) + (chess-game-set-data game 'active nil)))))) (provide 'chess-network) diff --git a/chess-none.el b/chess-none.el index 104d524..e5004ef 100644 --- a/chess-none.el +++ b/chess-none.el @@ -6,19 +6,20 @@ (require 'chess-engine) -(defun chess-none-handler (event &rest args) +(defun chess-none-handler (game event &rest args) "An empty chess engine, used for fielding key events. This is only useful when two humans are playing each other, in which case this engine will do the job of accepting undos, handling resignations, etc." - (cond - ((eq event 'initialize) t) + (unless chess-engine-handling-event + (cond + ((eq event 'initialize) t) - ((memq event '(resign abort)) - (chess-engine-set-position nil)) + ((memq event '(resign abort)) + (chess-engine-set-position nil)) - ((eq event 'undo) - (chess-game-undo chess-engine-game (car args))))) + ((eq event 'undo) + (chess-game-undo game (car args)))))) (provide 'chess-none) diff --git a/chess-phalanx.el b/chess-phalanx.el index 270376d..846946e 100644 --- a/chess-phalanx.el +++ b/chess-phalanx.el @@ -28,15 +28,18 @@ (lambda () (error (match-string 1))))))) -(defun chess-phalanx-handler (event &rest args) - (cond - ((eq event 'initialize) - (let ((proc (chess-common-handler 'initialize "phalanx"))) - (process-send-string proc "nopost\n") - proc)) - - (t - (apply 'chess-common-handler event args)))) +(defun chess-phalanx-handler (game event &rest args) + (unless chess-engine-handling-event + (cond + ((eq event 'initialize) + (let ((proc (chess-common-handler game 'initialize "phalanx"))) + (when (and (processp proc) + (eq (process-status proc) 'run)) + (process-send-string proc "nopost\n") + t))) + + (t + (apply 'chess-common-handler game event args))))) (provide 'chess-phalanx) diff --git a/chess-plain.el b/chess-plain.el index 3008ad5..693e5eb 100644 --- a/chess-plain.el +++ b/chess-plain.el @@ -70,7 +70,7 @@ modify `chess-plain-piece-chars' to avoid real confusion.)" (defun chess-plain-handler (event &rest args) (cond - ((eq event 'initialize) (current-buffer)) + ((eq event 'initialize) t) ((eq event 'popup) (if chess-display-popup (funcall chess-plain-popup-function))) diff --git a/chess-sound.el b/chess-sound.el index 8761f1d..1740261 100644 --- a/chess-sound.el +++ b/chess-sound.el @@ -51,25 +51,19 @@ (apply 'call-process chess-sound-program nil nil nil (append chess-sound-args (list file)))) -(defun chess-sound-handler (event &rest args) - "This display module presents a standard chessboard. -See `chess-display-type' for the different kinds of displays." +(defun chess-sound-handler (game event &rest args) (cond ((eq event 'initialize) - (kill-buffer (current-buffer)) - (set-buffer (generate-new-buffer " *chess-sound*")) (and (file-directory-p chess-sound-directory) (file-readable-p (expand-file-name "move.wav" chess-sound-directory)) (or (eq chess-sound-play-function 'play-sound-file) - (file-executable-p chess-sound-program)) - (current-buffer))) + (file-executable-p chess-sound-program)))) ((eq event 'move) - (let* ((ply (chess-game-ply chess-display-game - (1- (chess-game-index chess-display-game)))) + (let* ((ply (chess-game-ply game (1- (chess-game-index game)))) (pos (chess-ply-pos ply))) - (if (eq (chess-game-data chess-display-game 'my-color) + (if (eq (chess-game-data game 'my-color) (chess-pos-side-to-move pos)) (if chess-sound-my-moves (chess-sound "move")) diff --git a/chess-transport.el b/chess-transport.el index 3a1beba..f88432e 100644 --- a/chess-transport.el +++ b/chess-transport.el @@ -11,29 +11,30 @@ (defvar chess-transport-regexp-alist chess-network-regexp-alist) -(defun chess-transport-handler (event &rest args) +(defun chess-transport-handler (game event &rest args) "This is an example of a generic transport engine." - (cond - ((eq event 'initialize) - ;; Initialize the transport here, if necessary. Make sure that - ;; any housekeeping data you use is kept in buffer-local - ;; variables. Otherwise, multiple games played using the same - ;; kind of transport might collide. For example: - ;; - ;; (set (make-local-variable 'chess-transport-data) (car args)) - ;; - ;; NOTE: Be sure not to return a process, or else chess-engine - ;; will do all the transport work! - t) - - ((eq event 'send) - ;; Transmit the string given in `(car args)' to the outbound - ;; transport from here - ) - - (t - ;; Pass all other events down to chess-network - (apply 'chess-network-handler event args)))) + (unless chess-engine-handling-event + (cond + ((eq event 'initialize) + ;; Initialize the transport here, if necessary. Make sure that + ;; any housekeeping data you use is kept in buffer-local + ;; variables. Otherwise, multiple games played using the same + ;; kind of transport might collide. For example: + ;; + ;; (set (make-local-variable 'chess-transport-data) (car args)) + ;; + ;; NOTE: Be sure not to return a process, or else chess-engine + ;; will do all the transport work! + t) + + ((eq event 'send) + ;; Transmit the string given in `(car args)' to the outbound + ;; transport from here + ) + + (t + ;; Pass all other events down to chess-network + (apply 'chess-network-handler event args))))) ;; Call `(chess-engine-submit engine STRING)' for text that arrives ;; from the inbound transport @@ -86,25 +86,28 @@ (defconst chess-version "2.0a8" "The version of the Emacs chess program.") -(defcustom chess-default-displays - '((chess-images chess-ics1 chess-plain) - (chess-sound chess-announce) +(defcustom chess-default-display + '(chess-images chess-ics1 chess-plain) + "Default display to be used when starting a chess session. +A list indicates a series of alternatives if the first display is +not available." + :type '(choice symbol (repeat symbol)) + :group 'chess) + +(defcustom chess-default-modules + '((chess-sound chess-announce) chess-autosave) - "Default displays to be used when starting a chess session. -This is a list of display modules, all of which will be invoked. If -any entry is itself a list, then it specifies a series of alternatives -if the first modules were not available. -Note: The very first display is marked the 'main' display, which will -popup on significant events (unless `chess-display-popup' in nil); -also, killing this main display will cause all related chess buffers -to be killed." - :type '(repeat (choice symbol (repeat symbol))) + "Modules to be used when starting a chess session. +A sublist indicates a series of alternatives, if the first is not +available. +These can do just about anything." + :type '(choice symbol (repeat symbol)) :group 'chess) (defcustom chess-default-engine '(chess-crafty chess-gnuchess chess-phalanx) "Default engine to be used when starting a chess session. -A list indicates a series of alternatives if the first engines are not +A list indicates a series of alternatives if the first engine is not available." :type '(choice symbol (repeat symbol)) :group 'chess) @@ -114,19 +117,22 @@ available." :type 'string :group 'chess) -(defun chess--create-display (module game my-color first disable-popup) +(defun chess--create-display (module game my-color disable-popup) (if (require module nil t) - (let ((display (chess-display-create game module my-color first))) + (let ((display (chess-display-create game module my-color))) (when display (chess-game-set-data game 'my-color my-color) (if disable-popup (chess-display-disable-popup display)) - (chess-display-update display t) display)))) +(defun chess--create-module (module game) + (and (require module nil t) + (chess-module-create module game))) + (defun chess--create-engine (module game response-handler ctor-args) (if (require module nil t) - (let ((engine (apply 'chess-engine-create game module + (let ((engine (apply 'chess-engine-create module game response-handler ctor-args))) (when engine ;; for the sake of engines which are ready to play now, and @@ -136,6 +142,23 @@ available." (chess-engine-command engine 'ready) engine)))) +(defun chess-create-modules (module-list create-func &rest args) + (let (objects) + (dolist (module module-list) + (let (object) + (if (symbolp module) + (if (setq object (apply create-func module args)) + (push object objects)) + ;; this module is actually a list, which means keep trying + ;; until we find one that works + (while module + (if (setq object (apply create-func (car module) args)) + (progn + (push object objects) + (setq module nil)) + (setq module (cdr module))))))) + (nreverse objects))) + ;;;###autoload (defun chess (&optional engine disable-popup engine-response-handler &rest engine-ctor-args) @@ -151,48 +174,29 @@ available." "none")))) chess-default-engine))) - (let ((my-color t) ; we start out as white always - (game (chess-game-create)) - (first t) + (let ((game (chess-game-create)) + (my-color t) ; we start out as white always objects) - (dolist (module chess-default-displays) - (let (display) - (if (symbolp module) - (setq display (chess--create-display module game my-color - first disable-popup)) - ;; this module is actually a list, which means keep trying - ;; until we find one that works - (while module - (if (setq display (chess--create-display (car module) game - my-color first - disable-popup)) - (setq module nil) - (setq module (cdr module))))) - (if display - (push display objects))) - (setq first nil)) - - (setq objects (nreverse objects)) - - (let ((module (or engine chess-default-engine))) - (if (symbolp module) - (push (chess--create-engine module game - engine-response-handler - engine-ctor-args) - objects) - (let (engine) - (while module - (setq engine (chess--create-engine (car module) game - engine-response-handler - engine-ctor-args)) - (if engine - (progn - (push engine objects) - (setq module nil)) - (setq module (cdr module)))) - (unless engine - (push nil objects))))) + ;; all these odd calls are so that `objects' ends up looking like: + ;; (ENGINE FIRST-DISPLAY...) + + (setq objects (chess-create-modules (list chess-default-display) + 'chess--create-display + game my-color disable-popup)) + (when (car objects) + (mapc 'chess-display-update objects) + (chess-module-set-leader (car objects)) + (chess-display-popup (car objects))) + + (nconc objects (chess-create-modules chess-default-modules + 'chess--create-module game)) + + (push (car (chess-create-modules (list (or engine chess-default-engine)) + 'chess--create-engine game + engine-response-handler + engine-ctor-args)) + objects) objects)) @@ -202,6 +206,11 @@ available." "Just make a display to use, letting chess.el decide the style." (cadr (chess-session 'chess-none))) +(defun chess-create-display-object (perspective) + (car (chess-create-modules (list chess-default-display) + 'chess--create-display + (chess-mage-create) perspective))) + ;;;###autoload (defun chess-read-pgn (&optional file) "Read and display a PGN game after point." @@ -238,18 +247,17 @@ making it easy to go on to the next puzzle once you've solved one." (defun chess-puzzle-next () "Play the next puzzle in the collection, selected randomly." (interactive) - (let* ((database (chess-game-data chess-display-game 'database)) + (let* ((game (chess-display-game nil)) + (database (chess-game-data game 'database)) (index (random (chess-database-count database))) (next-game (chess-database-read database index))) (if (null next-game) (error "Error reading game at position %d" index) (chess-display-set-game nil next-game 0) - (chess-game-set-data chess-display-game 'my-color - (chess-pos-side-to-move - (chess-game-pos chess-display-game))) + (chess-game-set-data game 'my-color + (chess-pos-side-to-move (chess-game-pos game))) (dolist (key '(database database-index database-count)) - (chess-game-set-data chess-display-game key - (chess-game-data next-game key)))))) + (chess-game-set-data game key (chess-game-data next-game key)))))) (provide 'chess) |
