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
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))
'((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
(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."
(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)
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)
;; 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)
(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)
;;
;; $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'")))
(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))))
(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
(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)
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."
: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:
(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
(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
;; 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))
;; "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)
(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))
(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
(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)))
"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
(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)
(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)
(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)
(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)
(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
(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)
(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)
(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)
(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)))
(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"))
(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
(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)
: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
(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)
"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))
"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."
(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)