diff options
| -rw-r--r-- | chess-common.el | 76 | ||||
| -rw-r--r-- | chess-crafty.el | 56 | ||||
| -rw-r--r-- | chess-engine.el | 157 | ||||
| -rw-r--r-- | chess-gnuchess.el | 59 | ||||
| -rw-r--r-- | chess-ics.el | 29 | ||||
| -rw-r--r-- | chess-link.el | 4 | ||||
| -rw-r--r-- | chess-network.el | 79 | ||||
| -rw-r--r-- | chess-phalanx.el | 40 |
8 files changed, 222 insertions, 278 deletions
diff --git a/chess-common.el b/chess-common.el new file mode 100644 index 0000000..7019bb9 --- /dev/null +++ b/chess-common.el @@ -0,0 +1,76 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Define handler functions that are common to the (relatively) +;; standard chess engine communication protocol: +;; +;; http://www.tim-mann.org/xboard/engine-intf.html +;; +;; $Revision$ + +(require 'chess-engine) + +(defvar chess-common-temp-files nil) +(make-variable-buffer-local 'chess-common-temp-files) + +(defmacro chess-with-temp-file (&rest body) + (let ((file (make-temp-file "chess"))) + (with-temp-file file + ,@body) + (push file chess-common-temp-files) + file)) + +(put 'chess-with-temp-file 'lisp-indent-function 1) + +(defun chess-common-handler (event &rest args) + "Initialize the network chess engine." + (cond + ((eq event 'initialize) + (let* ((name (car args)) + (path (intern (concat "chess-" name "-path"))) + proc) + (message "Starting chess program '%s'..." name) + (unless (boundp path) + (error "Cannot find %s executable; check `%s'" name path)) + (setq proc (start-process (concat "chess-" name) + (current-buffer) (symbol-value path))) + (message "Starting chess program '%s'...done" name) + proc)) + + ((eq event 'ready) + (and (chess-engine-game nil) + (chess-game-set-data (chess-engine-game nil) 'active t))) + + ((eq event 'shutdown) + (chess-engine-send nil "quit\n") + (dolist (file chess-common-temp-files) + (if (file-exists-p file) + (delete-file file))) + (setq chess-common-temp-files nil)) + + ((eq event 'pass) + (chess-engine-send nil "go\n")) + + ((eq event 'resign) + (chess-engine-send nil "resign\n")) + + ((eq event 'draw) + (message "Your draw offer was declined")) + + ((memq event '(resign abort)) + (chess-engine-send nil "new\n") + (and (chess-engine-game nil) + (chess-engine-set-start-position nil))) + + ((eq event 'undo) + (when (chess-engine-game nil) + (dotimes (i (car args)) + (chess-engine-send nil "undo\n")) + (chess-game-undo (chess-engine-game nil) (car args)))) + + ((eq event 'move) + (chess-engine-send nil (concat (chess-ply-to-algebraic (car args)) + "\n"))))) + +(provide 'chess-common) + +;;; chess-common.el ends here diff --git a/chess-crafty.el b/chess-crafty.el index 884e372..6e0d733 100644 --- a/chess-crafty.el +++ b/chess-crafty.el @@ -5,8 +5,7 @@ ;; $Revision$ (require 'chess-engine) -(require 'chess-fen) -(require 'chess-algebraic) +(require 'chess-common) (defgroup chess-crafty nil "The publically available chess engine 'crafty'." @@ -18,9 +17,6 @@ :type 'file :group 'chess-crafty) -(defvar chess-crafty-temp-files nil) -(make-variable-buffer-local 'chess-crafty-temp-files) - (defvar chess-crafty-regexp-alist (list (cons (concat "\\(White\\|Black\\)\\s-*([0-9]+):\\s-+\\(" @@ -37,13 +33,7 @@ (defun chess-crafty-handler (event &rest args) (cond ((eq event 'initialize) - (let (proc) - (message "Starting chess program 'crafty'...") - (unless chess-crafty-path - (error "Cannot find crafty executable; check `chess-crafty-path'")) - (setq proc (start-process "chess-process" (current-buffer) - chess-crafty-path)) - (message "Starting chess program 'crafty'...done") + (let ((proc (chess-common-handler 'initialize "crafty"))) (process-send-string proc (concat "display nogeneral\n" "display nochanges\n" "display noextstats\n" @@ -58,47 +48,17 @@ "ansi off\n")) proc)) - ((eq event 'shutdown) - (chess-engine-send nil "quit\n") - (dolist (file chess-crafty-temp-files) - (if (file-exists-p file) - (delete-file file)))) - - ((eq event 'ready) - (and (chess-engine-game nil) - (chess-game-set-data (chess-engine-game nil) 'active t))) - ((eq event 'setup-pos) (chess-engine-send nil (format "setboard %s\n" - (chess-pos-to-fen (car args))))) + (chess-pos-to-string (car args))))) ((eq event 'setup-game) - (let ((file (make-temp-file "cra"))) - (with-temp-file file - (insert (chess-game-to-string (car args)) ?\n)) - (chess-engine-send nil (format "read %s\n" file)) - (push file chess-crafty-temp-files))) - - ((eq event 'pass) - (chess-engine-send nil "go\n")) - - ((memq event '(abort resign)) - (chess-engine-send nil "new\n") - (and (chess-engine-game nil) - (chess-engine-set-start-position nil))) - - ((eq event 'draw) - (chess-engine-default-handler 'decline-draw)) - - ((eq event 'undo) - (when (chess-engine-game nil) - (dotimes (i (car args)) - (chess-engine-send nil "undo\n")) - (chess-game-undo (chess-engine-game nil) (car args)))) + (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 'move) - (chess-engine-send nil (concat (chess-ply-to-algebraic (car args)) - "\n"))))) + (t + (apply 'chess-common-handler event args)))) (provide 'chess-crafty) diff --git a/chess-engine.el b/chess-engine.el index cc3e26e..21109e1 100644 --- a/chess-engine.el +++ b/chess-engine.el @@ -20,6 +20,8 @@ (defvar chess-engine-current-marker nil) (defvar chess-engine-position 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) @@ -27,6 +29,8 @@ (make-variable-buffer-local 'chess-engine-current-marker) (make-variable-buffer-local 'chess-engine-position) (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) @@ -105,7 +109,7 @@ (message "Your opponent has passed the move to you") t)) - ((eq event 'connect) + ((eq event 'match) (if (and game (chess-game-data game 'active)) (chess-engine-command nil 'busy) (if (y-or-n-p @@ -113,23 +117,12 @@ (format "Do you wish to play a chess game against %s? " (car args)) (format "Do you wish to play a chess game against an anonymous opponent? "))) - (chess-engine-command nil 'accept-connect) + (chess-engine-command nil 'accept) (chess-engine-send nil 'decline))) t) - ((eq event 'accept-connect) - (unless (and game (chess-game-data game 'active)) - (if (and (car args) (> (length (car args)) 0)) - (message "Your opponent, %s, is now ready to play" (car args)) - (message "Your opponent is now ready to play")) - - ;; NOTE: There will be no display for this game object! This - ;; is really only useful if you are using a computer on the - ;; accepting side - (unless game - (setq game (chess-engine-set-game nil (chess-game-create)))) - (chess-engine-set-start-position nil) - t)) + ((eq event 'accept) +) ((eq event 'setup-pos) (when (car args) @@ -162,67 +155,101 @@ (chess-game-set-data game 'active nil) t)) - ((eq event 'abort) + ((eq event 'draw) (when game - (if (y-or-n-p "Your opponent wants to abort this game, accept? ") + (if (y-or-n-p "Your opponent offers a draw, accept? ") (progn - (chess-game-set-data game 'active nil) - (chess-engine-command nil 'accept-abort)) - (chess-engine-command nil 'decline-abort)) - t)) - - ((eq event 'accept-abort) - (when game - (message "Your offer to abort was accepted") - (chess-game-set-data game 'active nil) + (chess-game-draw game) + (chess-engine-command nil 'accept) + (chess-game-set-data game 'active nil)) + (chess-engine-command nil 'decline)) t)) - ((eq event 'decline-abort) + ((eq event 'abort) (when game - (message "Your offer to abort was declined") + (if (y-or-n-p "Your opponent wants to abort this game, accept? ") + (progn + (chess-game-set-data game 'active nil) + (chess-engine-command nil 'accept)) + (chess-engine-command nil 'decline)) t)) ((eq event 'undo) (when game - (if (y-or-n-p (format "Your opponent wants to take back %d moves, accept? " - (car args))) + (if (y-or-n-p + (format "Your opponent wants to take back %d moves, accept? " + (car args))) (progn (chess-game-undo game (car args)) - (chess-engine-command nil 'accept-undo)) - (chess-engine-command nil 'decline-undo)) + (chess-engine-command nil 'accept)) + (chess-engine-command nil 'decline)) t)) - ((eq event 'accept-undo) - (when game - (message "Undo of %d moves accepted" (car args)) - (chess-game-undo game (car args)) + ((eq event 'accept) + (when chess-engine-pending-offer + (if (eq chess-engine-pending-offer 'match) + (unless (and game (chess-game-data game 'active)) + (if (and (car args) (> (length (car args)) 0)) + (message "Your opponent, %s, is now ready to play" + (car args)) + (message "Your opponent is now ready to play")) + + ;; NOTE: There will be no display for this game object! This + ;; is really only useful if you are using a computer on the + ;; accepting side + (unless game + (setq game (chess-engine-set-game nil (chess-game-create)))) + (chess-engine-set-start-position nil)) + (cond + ((eq chess-engine-pending-offer 'draw) + (message "Your draw offer was accepted") + (chess-game-draw game) + (chess-game-set-data game 'active nil)) + + ((eq chess-engine-pending-offer 'abort) + (message "Your offer to abort was accepted") + (chess-game-set-data game 'active nil)) + + ((eq chess-engine-pending-offer 'undo) + (message "Request to undo %d moves was accepted" + 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-undo) - (when game - (message "Undo of %d moves declined" (car args)) - t)) + ((eq event 'decline) + (when (and game chess-engine-pending-offer) + (cond + ((eq chess-engine-pending-offer 'draw) + (message "Your draw offer was declined")) - ((eq event 'draw) - (when game - (if (y-or-n-p "Your opponent offers a draw, accept? ") - (progn - (chess-game-draw game) - (chess-engine-command nil 'accept-draw) - (chess-game-set-data game 'active nil)) - (chess-engine-command nil 'decline-draw)) - t)) + ((eq chess-engine-pending-offer 'abort) + (message "Your offer to abort was declined")) - ((eq event 'accept-draw) - (when game - (message "Your draw offer was accepted") - (chess-game-draw game) - (chess-game-set-data game 'active nil) + ((eq chess-engine-pending-offer 'undo) + (message "Your request to undo %d moves was decline" + chess-engine-pending-arg))) + + (setq chess-engine-pending-offer nil + chess-engine-pending-arg nil) t)) - ((eq event 'decline-draw) - (when game - (message "Your draw offer was declined") + ((eq event 'retract) + (when (and game chess-engine-pending-offer) + (cond + ((eq chess-engine-pending-offer 'draw) + (message "Your opponent has retracted their draw offer")) + + ((eq chess-engine-pending-offer 'abort) + (message "Your opponent has retracted their offer to abort")) + + ((eq chess-engine-pending-offer 'undo) + (message "Your opponent has retracted their request to undo %d moves" + chess-engine-pending-arg))) + + (setq chess-engine-pending-offer nil + chess-engine-pending-arg nil) t))))) (defun chess-engine-create (module &optional response-handler &rest args) @@ -367,22 +394,6 @@ function in all cases; this is merely a bandwidth-saver." (chess-engine-do-move ply) (chess-engine-command engine 'move ply))) -(defun chess-engine-pass (engine) - (chess-with-current-buffer engine - (chess-engine-command engine 'pass))) - -(defun chess-engine-resign (engine) - (chess-with-current-buffer engine - (chess-engine-command engine 'resign))) - -(defun chess-engine-abort (engine) - (chess-with-current-buffer engine - (chess-engine-command engine 'abort))) - -(defun chess-engine-undo (engine count) - (chess-with-current-buffer engine - (chess-engine-command engine 'undo count))) - (defun chess-engine-send (engine string) "Send the given STRING to ENGINE." (chess-with-current-buffer engine diff --git a/chess-gnuchess.el b/chess-gnuchess.el index 90a0613..ee5912b 100644 --- a/chess-gnuchess.el +++ b/chess-gnuchess.el @@ -5,8 +5,7 @@ ;; $Revision$ (require 'chess-engine) -(require 'chess-fen) -(require 'chess-algebraic) +(require 'chess-common) (defgroup chess-gnuchess nil "The publically available chess engine 'gnuchess'." @@ -17,9 +16,7 @@ :type 'file :group 'chess-gnuchess) -(defvar chess-gnuchess-temp-files nil) (defvar chess-gnuchess-bad-board nil) -(make-variable-buffer-local 'chess-gnuchess-temp-files) (make-variable-buffer-local 'chess-gnuchess-bad-board) (defvar chess-gnuchess-regexp-alist @@ -44,40 +41,19 @@ (defun chess-gnuchess-handler (event &rest args) (cond ((eq event 'initialize) - (let (proc) - (message "Starting chess program 'gnuchess'...") - (unless chess-gnuchess-path - (error "Cannot find gnuchess executable; check `chess-gnuchess-path'")) - (setq proc (start-process "chess-process" (current-buffer) - chess-gnuchess-path)) - (message "Starting chess program 'gnuchess'...done") + (let ((proc (chess-common-handler 'initialize "gnuchess"))) (process-send-string proc "nopost\n") proc)) - ((eq event 'shutdown) - (chess-engine-send nil "quit\n") - (dolist (file chess-gnuchess-temp-files) - (if (file-exists-p file) - (delete-file file)))) - - ((eq event 'ready) - (let ((game (chess-engine-game nil))) - (if game - (chess-game-set-data game 'active t)))) - ((eq event 'setup-pos) - (let ((file (make-temp-file "gch"))) - (with-temp-file file - (insert (chess-pos-to-string (car args)) ?\n)) - (chess-engine-send nil (format "epdload %s\n" file)) - (push file chess-gnuchess-temp-files))) + (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 (make-temp-file "gch"))) - (with-temp-file file - (insert (chess-game-to-string (car args)) ?\n)) - (chess-engine-send nil (format "pgnload %s\n" file)) - (push file chess-gnuchess-temp-files))) + (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 @@ -87,26 +63,15 @@ (chess-engine-send nil "go\n") (setq chess-gnuchess-bad-board nil)) - ((memq event '(abort resign)) - (chess-engine-send nil "new\n") - (and (chess-engine-game nil) - (chess-engine-set-start-position nil))) - - ((eq event 'draw) - (chess-engine-default-handler 'decline-draw)) - - ((eq event 'undo) - (when (chess-engine-game nil) - (dotimes (i (car args)) - (chess-engine-send nil "undo\n")) - (chess-game-undo (chess-engine-game nil) (car args)))) - ((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))))) + (setq chess-gnuchess-bad-board nil))) + + (t + (apply 'chess-common-handler event args)))) (provide 'chess-gnuchess) diff --git a/chess-ics.el b/chess-ics.el index 42bd3ef..cd72142 100644 --- a/chess-ics.el +++ b/chess-ics.el @@ -126,7 +126,7 @@ who is black." (cons "Challenge: \\(\\S-+\\) \\S-+ \\S-+ \\S-+ .+" (function (lambda () - (funcall chess-engine-response-handler 'connect + (funcall chess-engine-response-handler 'match (match-string 1))))))) (defun chess-ics-handler (event &rest args) @@ -178,34 +178,19 @@ who is black." nil)) - ((eq event 'shutdown) - (chess-engine-send nil "quit\n")) - ((eq event 'move) (unless chess-ics-ensure-ics12 (comint-send-string (get-buffer-process (current-buffer)) "set style 12\n") (setq chess-ics-ensure-ics12 t)) - (chess-engine-send nil (concat (chess-ply-to-algebraic (car args)) - "\n"))) - - ((memq event '(accept-connect accept-undo accept-draw accept-abort)) - (chess-engine-send nil "accept\n")) - - ((memq event '(decline-connect decline-undo decline-draw decline-abort)) - (chess-engine-send nil "decline\n")) - - ((eq event 'resign) - (chess-engine-send nil "resign\n")) - - ((eq event 'abort) - (chess-engine-send nil "abort\n")) - - ((eq event 'undo) - (chess-engine-send nil (format "takeback %d\n" (car args)))) + (chess-network-handler 'move (car args))) ((eq event 'send) - (comint-send-string (get-buffer-process (current-buffer)) (car args))))) + (comint-send-string (get-buffer-process (current-buffer)) + (car args))) + + (t + (apply 'chess-network-handler event args)))) (defun chess-ics-filter (string) (save-excursion diff --git a/chess-link.el b/chess-link.el index 321686d..a6dea4e 100644 --- a/chess-link.el +++ b/chess-link.el @@ -17,8 +17,8 @@ (second-engine (chess-game-data game 'second-engine)) return-value) (cond - ((eq event 'connect) - (chess-engine-command nil 'accept-connect) + ((eq event 'match) + (chess-engine-command nil 'accept) t) (t diff --git a/chess-network.el b/chess-network.el index 3468abd..a277423 100644 --- a/chess-network.el +++ b/chess-network.el @@ -18,12 +18,7 @@ (cons "chess match\\(\\s-+\\(.+\\)\\)?$" (function (lambda () - (funcall chess-engine-response-handler 'connect - (match-string 2))))) - (cons "accept match\\(\\s-+\\(.+\\)\\)?$" - (function - (lambda () - (funcall chess-engine-response-handler 'accept-connect + (funcall chess-engine-response-handler 'match (match-string 2))))) (cons "fen\\s-+\\(.+\\)" (function @@ -51,40 +46,28 @@ (function (lambda () (funcall chess-engine-response-handler 'draw)))) - (cons "accept draw$" - (function - (lambda () - (funcall chess-engine-response-handler 'accept-draw)))) - (cons "decline draw$" - (function - (lambda () - (funcall chess-engine-response-handler 'decline-draw)))) (cons "abort$" (function (lambda () (funcall chess-engine-response-handler 'abort)))) - (cons "accept abort$" - (function - (lambda () - (funcall chess-engine-response-handler 'accept-abort)))) - (cons "decline abort$" - (function - (lambda () - (funcall chess-engine-response-handler 'decline-abort)))) (cons "takeback\\s-+\\([0-9]+\\)$" (function (lambda () (funcall chess-engine-response-handler 'undo (string-to-int (match-string 1)))))) - (cons "accept takeback\\s-+\\([0-9]+\\)$" + (cons "accept\\(\\s-+\\(.+\\)\\)?$" (function (lambda () - (funcall chess-engine-response-handler 'accept-undo - (string-to-int (match-string 1)))))) - (cons "decline takeback$" + (funcall chess-engine-response-handler 'accept + (match-string 2))))) + (cons "decline$" (function (lambda () - (funcall chess-engine-response-handler 'decline-undo)))))) + (funcall chess-engine-response-handler 'decline)))) + (cons "retract$" + (function + (lambda () + (funcall chess-engine-response-handler 'retract)))))) (defun chess-network-handler (event &rest args) "Initialize the network chess engine." @@ -123,44 +106,40 @@ ((eq event 'busy) (chess-engine-send nil "playing\n")) - ((eq event 'connect) + ((eq event 'match) + (setq chess-engine-pending-offer 'match) (chess-engine-send nil (format "chess match %s\n" chess-full-name))) - ((eq event 'accept-connect) - (chess-engine-send nil (format "accept match %s\n" chess-full-name))) - - ((eq event 'decline) - (chess-engine-send nil "decline\n")) - ((eq event 'resign) (chess-engine-send nil "resign\n")) ((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 'accept-draw) - (chess-engine-send nil "accept draw\n")) - - ((eq event 'decline-draw) - (chess-engine-send nil "decline 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 'accept-abort) - (chess-engine-send nil "accept abort\n")) - - ((eq event 'decline-abort) - (chess-engine-send nil "decline 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-undo) - (chess-engine-send nil (format "accept 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 'decline-undo) - (chess-engine-send nil "decline takeback\n")) + ((eq event 'retract) + (chess-engine-send nil "retract\n")) ((eq event 'move) (chess-engine-send nil (concat (chess-ply-to-algebraic (car args)) diff --git a/chess-phalanx.el b/chess-phalanx.el index 0e1e830..2cabeb3 100644 --- a/chess-phalanx.el +++ b/chess-phalanx.el @@ -5,8 +5,7 @@ ;; $Revision$ (require 'chess-engine) -(require 'chess-fen) -(require 'chess-algebraic) +(require 'chess-common) (defgroup chess-phalanx nil "The publically available chess engine 'phalanx'." @@ -32,43 +31,12 @@ (defun chess-phalanx-handler (event &rest args) (cond ((eq event 'initialize) - (let (proc) - (message "Starting chess program 'phalanx'...") - (unless chess-phalanx-path - (error "Cannot find phalanx executable; check `chess-phalanx-path'")) - (setq proc (start-process "chess-process" (current-buffer) - chess-phalanx-path)) - (message "Starting chess program 'phalanx'...done") + (let ((proc (chess-common-handler 'initialize "phalanx"))) (process-send-string proc "nopost\n") proc)) - ((eq event 'shutdown) - (chess-engine-send nil "quit\n")) - - ((eq event 'ready) - (and (chess-engine-game nil) - (chess-game-set-data (chess-engine-game nil) 'active t))) - - ((eq event 'pass) - (chess-engine-send nil "go\n")) - - ((memq event '(abort resign)) - (chess-engine-send nil "new\n") - (and (chess-engine-game nil) - (chess-engine-set-start-position nil))) - - ((eq event 'draw) - (chess-engine-default-handler 'decline-draw)) - - ((eq event 'undo) - (when (chess-engine-game nil) - (dotimes (i (car args)) - (chess-engine-send nil "undo\n")) - (chess-game-undo (chess-engine-game nil) (car args)))) - - ((eq event 'move) - (chess-engine-send nil (concat (chess-ply-to-algebraic (car args)) - "\n"))))) + (t + (apply 'chess-common-handler event args)))) (provide 'chess-phalanx) |