diff options
| -rw-r--r-- | chess-crafty.el | 21 | ||||
| -rw-r--r-- | chess-display.el | 13 | ||||
| -rw-r--r-- | chess-engine.el | 156 | ||||
| -rw-r--r-- | chess-gnuchess.el | 33 | ||||
| -rw-r--r-- | chess-link.el | 79 | ||||
| -rw-r--r-- | chess-network.el | 75 | ||||
| -rw-r--r-- | chess.el | 6 |
7 files changed, 242 insertions, 141 deletions
diff --git a/chess-crafty.el b/chess-crafty.el index 260ebb5..12ffb3a 100644 --- a/chess-crafty.el +++ b/chess-crafty.el @@ -22,16 +22,17 @@ (make-variable-buffer-local 'chess-crafty-temp-files) (defvar chess-crafty-regexp-alist - (list (cons (concat "\\s-*\\(White\\|Black\\)\\s-*([0-9]+):\\s-+\\(" - chess-algebraic-regexp "\\)\\s-*$") - (function - (lambda () - (funcall chess-engine-response-handler 'move - (match-string 0))))) - (cons "Illegal move:\\s-*\\(.*\\)" - (function - (lambda () - (signal 'chess-illegal (match-string 1))))))) + (list + (cons (concat "\\(White\\|Black\\)\\s-*([0-9]+):\\s-+\\(" + chess-algebraic-regexp "\\)\\s-*$") + (function + (lambda () + (funcall chess-engine-response-handler 'move + (chess-engine-convert-algebraic (match-string 2)))))) + (cons "Illegal move:\\s-*\\(.*\\)" + (function + (lambda () + (signal 'chess-illegal (match-string 1))))))) (defun chess-crafty-handler (event &rest args) (cond diff --git a/chess-display.el b/chess-display.el index 515330d..d725e6d 100644 --- a/chess-display.el +++ b/chess-display.el @@ -231,7 +231,8 @@ modeline." chess-display-index (chess-game-index game) chess-display-ply nil chess-display-position nil) - (chess-game-add-hook game 'chess-display-event-handler display) + (if game + (chess-game-add-hook game 'chess-display-event-handler display)) (chess-display-update nil t))) (defun chess-display-copy-game (display game) @@ -360,6 +361,8 @@ that is supported by most displays, and is the default mode." (when (buffer-live-p buf) (chess-display-event-handler (chess-display-game nil) buf 'destroy) + (with-current-buffer buf + (remove-hook 'kill-buffer-hook 'chess-display-quit t)) (kill-buffer buf)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -594,7 +597,6 @@ Basically, it means we are playing, not editing or reviewing." (defun chess-display-quit () "Quit the current game." (interactive) - (remove-hook 'kill-buffer-hook 'chess-display-quit t) (if (and chess-display-main-p chess-display-game) (chess-game-run-hooks chess-display-game 'shutdown) @@ -622,8 +624,11 @@ Basically, it means we are playing, not editing or reviewing." (defun chess-display-duplicate (style) (interactive - (list (read-from-minibuffer "Create new display using style: " - (symbol-name (chess-display-style nil))))) + (list (concat "chess-" + (read-from-minibuffer + "Create new display using style: " + (substring (symbol-name (chess-display-style nil)) + 0 (length "chess-")))))) (chess-display-clone (current-buffer) (intern-soft style) (chess-display-perspective nil))) diff --git a/chess-engine.el b/chess-engine.el index 7c35bd7..0c0afb4 100644 --- a/chess-engine.el +++ b/chess-engine.el @@ -31,12 +31,14 @@ (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: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -58,41 +60,42 @@ (chess-engine-position (setq chess-engine-position (chess-ply-next-pos ply))))) +(defsubst chess-engine-convert-algebraic (move) + (or (chess-algebraic-to-ply (chess-engine-position nil) + move) + (message "Received invalid move string: %s" move))) + +(defsubst chess-engine-convert-fen (fen) + (or (chess-fen-to-pos fen) + (message "Received invalid FEN string: %s" fen))) + +(defsubst chess-engine-convert-pgn (pgn) + (or (chess-pgn-to-game pgn) + (message "Received invalid PGN text"))) + (defun chess-engine-default-handler (event &rest args) (let ((chess-engine-handling-event t) - (game (chess-engine-game nil)) - (position (chess-engine-position nil))) + (game (chess-engine-game nil))) (cond ((eq event 'move) (if (null game) - (if position - (let ((ply - (if (stringp (car args)) - (or (chess-algebraic-to-ply position (car args)) - (message "Received invalid move from engine: %s" - (car args))) - (car args)))) - (if ply - (setq chess-engine-position (chess-ply-next-pos ply))) - t)) + (when (car args) + (setq chess-engine-position (chess-ply-next-pos (car args))) + t) (if (chess-game-data game 'active) - (let ((ply - (if (stringp (car args)) - (or (chess-algebraic-to-ply position (car args)) - (message "Received invalid move from engine: %s" - (car args))) - (car args)))) - (when ply - ;; if the game index is still 0, then our opponent - ;; is white, and we need to pass over the move - (when (and game (chess-game-data game 'my-color) - (= (chess-game-index game) 0)) - (message "Your opponent played the first move, you are 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-engine-do-move ply)) + (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 game + (not chess-engine-inhibit-auto-pass) + (chess-game-data game 'my-color) + (= (chess-game-index game) 0)) + (message "Your opponent played the first move, you are 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-engine-do-move (car args)) t)))) ((eq event 'pass) @@ -127,28 +130,22 @@ t)) ((eq event 'setup-pos) - (let ((position (if (stringp (car args)) - (chess-fen-to-pos (car args)) - (car args)))) - (when position - (chess-engine-set-start-position nil position t) - t))) + (when (car args) + (chess-engine-set-start-position nil (car args) t) + t)) ((eq event 'setup-game) - (let ((new-game (if (stringp (car args)) - (chess-pgn-to-game (car args)) - (car args)))) - (when new-game - (if (null game) - (chess-engine-set-game nil new-game) - (let ((chess-game-inhibit-events t)) - (chess-engine-copy-game nil new-game) - (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))) - (chess-game-run-hooks game 'orient)) - t))) + (when (car args) + (if (null game) + (chess-engine-set-game nil (car args)) + (let ((chess-game-inhibit-events t)) + (chess-engine-copy-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))) + (chess-game-run-hooks game 'orient)) + t)) ((eq event 'quit) (message "Your opponent has quit playing") @@ -162,23 +159,7 @@ (chess-game-set-data game 'active nil) t))))) -(defun chess-engine-set-start-position (engine &optional position my-color) - (chess-with-current-buffer engine - (let ((game (chess-engine-game nil))) - (if (null game) - (chess-engine-set-position nil (or position - chess-starting-position)) - (let ((chess-game-inhibit-events t)) - (if position - (progn - (chess-game-set-start-position game position) - (chess-game-set-data game 'my-color my-color)) - (chess-game-set-start-position game chess-starting-position) - (chess-game-set-data game 'my-color t)) - (chess-game-set-data game 'active t)) - (chess-game-run-hooks game 'orient))))) - -(defun chess-engine-create (module &optional user-handler &rest args) +(defun chess-engine-create (module &optional response-handler &rest args) (let ((regexp-alist (intern-soft (concat (symbol-name module) "-regexp-alist"))) (handler (intern-soft (concat (symbol-name module) "-handler")))) @@ -187,7 +168,7 @@ (setq chess-engine-regexp-alist (symbol-value regexp-alist) chess-engine-event-handler handler chess-engine-response-handler - (or user-handler 'chess-engine-default-handler)) + (or response-handler 'chess-engine-default-handler)) (when (processp proc) (unless (memq (process-status proc) '(run open)) (error "Failed to start chess engine process")) @@ -206,7 +187,8 @@ (let ((buf (or engine (current-buffer)))) (when (buffer-live-p buf) (chess-engine-command engine 'destroy) - (remove-hook 'kill-buffer-hook 'chess-engine-on-kill t) + (with-current-buffer buf + (remove-hook 'kill-buffer-hook 'chess-engine-on-kill t)) (kill-buffer buf)))) (defun chess-engine-command (engine event &rest args) @@ -226,6 +208,15 @@ (chess-with-current-buffer engine )) +(defun chess-engine-set-response-handler (engine &optional response-handler) + (chess-with-current-buffer engine + (setq chess-engine-response-handler + (or response-handler 'chess-engine-default-handler)))) + +(defun chess-engine-response-handler (engine) + (chess-with-current-buffer engine + chess-engine-response-handler)) + (defun chess-engine-set-position (engine position) (chess-with-current-buffer engine (if chess-engine-game @@ -240,15 +231,32 @@ (chess-game-pos chess-engine-game)) chess-engine-position))) +(defun chess-engine-set-start-position (engine &optional position my-color) + (chess-with-current-buffer engine + (let ((game (chess-engine-game nil))) + (if (null game) + (chess-engine-set-position nil (or position + chess-starting-position)) + (let ((chess-game-inhibit-events t)) + (if position + (progn + (chess-game-set-start-position game position) + (chess-game-set-data game 'my-color my-color)) + (chess-game-set-start-position game chess-starting-position) + (chess-game-set-data game 'my-color t)) + (chess-game-set-data game 'active t)) + (chess-game-run-hooks game 'orient))))) + (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-engine-position nil) - (chess-game-add-hook game 'chess-engine-event-handler engine) - (unless no-setup - (chess-engine-command nil 'setup-game game)))) + (when game + (chess-game-add-hook game 'chess-engine-event-handler engine) + (unless no-setup + (chess-engine-command nil 'setup-game game))))) (defsubst chess-engine-set-game* (engine game) "This function is a special variant of `chess-engine-set-game'. @@ -297,6 +305,10 @@ function in all cases; this is merely a bandwidth-saver." (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-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 0e641fe..dbf529d 100644 --- a/chess-gnuchess.el +++ b/chess-gnuchess.el @@ -23,22 +23,23 @@ (make-variable-buffer-local 'chess-gnuchess-bad-board) (defvar chess-gnuchess-regexp-alist - (list (cons (concat "My move is : \\(" chess-algebraic-regexp "\\)") - (function - (lambda () - (funcall chess-engine-response-handler 'move - (match-string 1))))) - (cons "Illegal move:" - (function - (lambda () - (signal 'chess-illegal "Illegal move")))) - (cons "Board is wrong!" - (function - (lambda () - ;; gnuchess didn't like the given position, which - ;; means it won't play against it unless we send a - ;; "go" after the user's move - (setq chess-gnuchess-bad-board t)))))) + (list + (cons (concat "My move is : \\(" chess-algebraic-regexp "\\)") + (function + (lambda () + (funcall chess-engine-response-handler 'move + (chess-engine-convert-algebraic (match-string 1)))))) + (cons "Illegal move:" + (function + (lambda () + (signal 'chess-illegal "Illegal move")))) + (cons "Board is wrong!" + (function + (lambda () + ;; gnuchess didn't like the given position, which + ;; means it won't play against it unless we send a + ;; "go" after the user's move + (setq chess-gnuchess-bad-board t)))))) (defun chess-gnuchess-handler (event &rest args) (cond diff --git a/chess-link.el b/chess-link.el new file mode 100644 index 0000000..b804c91 --- /dev/null +++ b/chess-link.el @@ -0,0 +1,79 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; A module for connecting two engines. If one is a protocol +;; transport (like chess-network), and the other is a computing engine +;; (like chess-gnuchess), this will allow you to expose a bot over the +;; channel. +;; +;; $Revision$ + +(require 'chess) +(require 'chess-engine) + +(defun chess-link-response-handler (event &rest args) + "This function handles responses from the bot's computing engine." + (let* ((game (chess-engine-game nil)) + (first-engine (chess-game-data game 'first-engine)) + (second-engine (chess-game-data game 'second-engine))) + (cond + ((eq event 'connect) + (chess-engine-command nil 'accept)) + + (t + (let ((chess-engine-inhibit-auto-pass t)) + (apply 'chess-engine-default-handler event args)) + + ;; but now transfer the event to the other engine + (apply 'chess-engine-command + (if (eq (current-buffer) first-engine) + second-engine + first-engine) event args))))) + +(defun chess-link-connect (first-engine second-engine) + "Connect two engines, so that they rely events back and forth." + (chess-engine-set-response-handler first-engine + 'chess-link-response-handler) + (chess-engine-set-response-handler second-engine + 'chess-link-response-handler)) + +;;;###autoload +(defun chess-link (first-engine-type second-engine-type) + "Play out a game between two engines, and watch the progress. +If you want to run an engine as a bot, make the transport the first +engine, and the computer the second engine." + (interactive "sFirst engine: \nsSecond engine: ") + (setq first-engine-type (intern (concat "chess-" first-engine-type)) + second-engine-type (intern (concat "chess-" second-engine-type))) + (require chess-default-display) + (let* ((my-color t) ; we start out as white always + (display (chess-display-create chess-default-display my-color)) + (game (chess-game-create))) + (chess-game-set-data game 'my-color my-color) + (chess-display-set-game display game) + (chess-display-set-main display) + (condition-case err + (when (and (require first-engine-type) + (require second-engine-type)) + (let ((first-engine (chess-engine-create first-engine-type)) + (second-engine (chess-engine-create second-engine-type))) + + (chess-engine-set-game* first-engine game) + (chess-game-set-data game 'first-engine first-engine) + (chess-engine-command first-engine 'ready) + + (chess-engine-set-game* second-engine game) + (chess-game-set-data game 'second-engine second-engine) + (chess-link-connect first-engine second-engine) + (chess-engine-command second-engine 'ready) + + ;; tell the first engine to start moving + (chess-engine-command first-engine 'pass)) + + (chess-display-update display t)) + (error + (chess-display-destroy display) + (error (error-message-string err)))))) + +(provide 'chess-link) + +;;; chess-link.el ends here diff --git a/chess-network.el b/chess-network.el index b48f776..a4befa2 100644 --- a/chess-network.el +++ b/chess-network.el @@ -9,43 +9,44 @@ (require 'chess-algebraic) (defvar chess-network-regexp-alist - (list (cons (concat chess-algebraic-regexp "$") - (function - (lambda () - (funcall chess-engine-response-handler 'move - (match-string 0))))) - (cons "chess match\\(\\s-+\\(.+\\)\\)?$" - (function - (lambda () - (funcall chess-engine-response-handler 'connect - (match-string 2))))) - (cons "accept\\(\\s-+\\(.+\\)\\)?$" - (function - (lambda () - (funcall chess-engine-response-handler 'accept - (match-string 2))))) - (cons "fen\\s-+\\(.+\\)" - (function - (lambda () - (funcall chess-engine-response-handler 'setup-pos - (match-string 1))))) - (cons "pgn\\s-+\\(.+\\)" - (function - (lambda () - (funcall chess-engine-response-handler 'setup-game - (match-string 1))))) - (cons "pass$" - (function - (lambda () - (funcall chess-engine-response-handler 'pass)))) - (cons "quit$" - (function - (lambda () - (funcall chess-engine-response-handler 'quit)))) - (cons "resign$" - (function - (lambda () - (funcall chess-engine-response-handler 'resign)))))) + (list + (cons (concat chess-algebraic-regexp "$") + (function + (lambda () + (funcall chess-engine-response-handler 'move + (chess-engine-convert-algebraic (match-string 0)))))) + (cons "chess match\\(\\s-+\\(.+\\)\\)?$" + (function + (lambda () + (funcall chess-engine-response-handler 'connect + (match-string 2))))) + (cons "accept\\(\\s-+\\(.+\\)\\)?$" + (function + (lambda () + (funcall chess-engine-response-handler 'accept + (match-string 2))))) + (cons "fen\\s-+\\(.+\\)" + (function + (lambda () + (funcall chess-engine-response-handler 'setup-pos + (chess-engine-convert-fen (match-string 1)))))) + (cons "pgn\\s-+\\(.+\\)" + (function + (lambda () + (funcall chess-engine-response-handler 'setup-game + (chess-engine-convert-pgn (match-string 1)))))) + (cons "pass$" + (function + (lambda () + (funcall chess-engine-response-handler 'pass)))) + (cons "quit$" + (function + (lambda () + (funcall chess-engine-response-handler 'quit)))) + (cons "resign$" + (function + (lambda () + (funcall chess-engine-response-handler 'resign)))))) (defun chess-network-handler (event &rest args) "Initialize the network chess engine." @@ -129,8 +129,10 @@ minibuffer, which works well for Emacspeak users." (chess-display-set-main display) (let ((engine-module (if arg - (intern (or (read-string "Engine module to play against: ") - "chess-none")) + (intern + (or (concat "chess-" + (read-string "Engine module to play against: ")) + "chess-none")) chess-default-engine))) (let ((engine-module (or engine chess-default-engine))) (let ((engine (chess-engine-create engine-module))) |