diff options
| -rw-r--r-- | chess-algebraic.el | 1 | ||||
| -rw-r--r-- | chess-crafty.el | 69 | ||||
| -rw-r--r-- | chess-engine.el | 209 | ||||
| -rw-r--r-- | chess-engines.el | 56 | ||||
| -rw-r--r-- | chess-game.el | 5 | ||||
| -rw-r--r-- | chess.el | 6 | ||||
| -rw-r--r-- | chess.texi | 39 |
7 files changed, 325 insertions, 60 deletions
diff --git a/chess-algebraic.el b/chess-algebraic.el index bee9731..c960d4a 100644 --- a/chess-algebraic.el +++ b/chess-algebraic.el @@ -98,6 +98,7 @@ This regexp handles both long and short form.") (list (if (equal mate "#") ':checkmate ':check)))) + (assert changes) (apply 'chess-ply-create position changes)))) (defun chess-ply-to-algebraic (ply &optional long search-func) diff --git a/chess-crafty.el b/chess-crafty.el new file mode 100644 index 0000000..5418d36 --- /dev/null +++ b/chess-crafty.el @@ -0,0 +1,69 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Play against crafty! +;; +;; $Revision$ + +(require 'chess-engine) +(require 'chess-fen) +(require 'chess-algebraic) + +(defvar chess-crafty-regexp-alist + (list (cons + (concat "\\s-*\\(White\\|Black\\)\\s-*([0-9]+):\\s-+\\(" + chess-algebraic-regexp "\\)\\s-*$") + (function + (lambda () + (let ((position (chess-engine-position nil))) + (if (string= (if (chess-pos-side-to-move position) + "White" "Black") + (match-string 1)) + (funcall chess-engine-response-handler 'move + (chess-algebraic-to-ply position + (match-string 2)))))))) + (cons "Illegal move:\\s-*\\(.*\\)" + (function + (lambda () + (signal 'chess-illegal (match-string 1))))))) + +(defun chess-crafty-handler (event &rest args) + (cond + ((eq event 'initialize) + (let (proc) + (message "Starting chess program 'crafty'...") + (setq proc (start-process "chess-process" (current-buffer) + (or (executable-find "crafty") + (executable-find "wcrafty")))) + (message "Starting chess program 'crafty'...done") + (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 'shutdown) + (chess-engine-send nil "quit\n")) + ((eq event 'setup) + (chess-engine-send nil (format "setboard %s\n" + (chess-pos-to-fen (car args))))) + ((eq event 'pass) + (chess-engine-send nil "go\n")) + ((eq event 'move) + (cond + ((chess-engine-game nil) + (chess-game-move (chess-engine-game nil) (car args))) + (t + (apply 'chess-pos-move (car args)))) + (chess-engine-send nil (concat (chess-ply-to-algebraic + (car args) nil + (chess-engine-search-function nil)) + "\n"))))) + +;;; chess-crafty.el ends here diff --git a/chess-engine.el b/chess-engine.el new file mode 100644 index 0000000..3bbfb91 --- /dev/null +++ b/chess-engine.el @@ -0,0 +1,209 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Obtain movements and other information from a subprocess +;; +;; $Revision$ + +;;; Commentary: + +(require 'chess-session) +(require 'chess-game) + +(defgroup chess-engine nil + "Code for reading movements and other commands from a subprocess." + :group 'chess) + +(defvar chess-engine-regexp-alist nil) +(defvar chess-engine-event-handler nil) +(defvar chess-engine-response-handler nil) +(defvar chess-engine-session nil) +(defvar chess-engine-position nil) +(defvar chess-engine-game nil) +(defvar chess-engine-search-function 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-session) +(make-variable-buffer-local 'chess-engine-position) +(make-variable-buffer-local 'chess-engine-game) +(make-variable-buffer-local 'chess-engine-search-function) + +(defvar chess-engine-last-pos nil) +(defvar chess-engine-working nil) + +(make-variable-buffer-local 'chess-engine-last-pos) +(make-variable-buffer-local 'chess-engine-working) + +;;; Code: + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; User interface +;; + +(defmacro chess-with-current-buffer (buffer &rest body) + `(let ((buf ,buffer)) + (if buf + (with-current-buffer buf + ,@body) + ,@body))) + +(defun chess-engine-default-handler (event &rest args) + (cond + ((eq event 'move) + (cond + ((chess-engine-session nil) + (apply 'chess-session-event (chess-engine-session nil) event args)) + ((chess-engine-game nil) + (chess-game-move (chess-engine-game nil) (car args))) + (t + (apply 'chess-pos-move (chess-ply-pos (car args)) + (chess-ply-changes (car args)))))))) + +(defun chess-engine-create (module &optional user-handler session search-func) + (let ((regexp-alist (intern-soft (concat (symbol-name module) + "-regexp-alist"))) + (handler (intern-soft (concat (symbol-name module) "-handler")))) + (with-current-buffer (generate-new-buffer " *chess-engine*") + (setq chess-engine-regexp-alist (symbol-value regexp-alist) + chess-engine-event-handler handler + chess-engine-response-handler (or 'chess-engine-default-handler + user-handler)) + (let ((proc (funcall handler 'initialize))) + (unless (and proc (memq (process-status proc) '(run open))) + (error "Failed to start chess engine process")) + (set-process-buffer proc (current-buffer)) + (set-process-filter proc 'chess-engine-filter)) + (chess-engine-set-game nil (chess-game-create nil search-func)) + (current-buffer)))) + +(defun chess-engine-destroy (engine) + (let ((buf (or display (current-buffer)))) + (if (buffer-live-p buf) + (kill-buffer buf)))) + +(defun chess-engine-command (engine event &rest args) + (chess-with-current-buffer engine + (apply chess-engine-event-handler event args))) + +(defun chess-engine-search-function (engine) + (chess-with-current-buffer engine + chess-engine-search-function)) + +(defun chess-engine-set-search-function (engine search-func) + (chess-with-current-buffer engine + (if chess-engine-game + (chess-game-search-function chess-engine-game) + (or chess-engine-search-function + 'chess-standard-search-position)))) + +(defun chess-engine-session (engine) + (chess-with-current-buffer engine + chess-engine-session)) + +(defun chess-engine-set-option (engine option value) + (chess-with-current-buffer engine + )) + +(defun chess-engine-option (engine option) 'ponder 'search-depth 'wall-clock + (chess-with-current-buffer engine + )) + +(defun chess-engine-set-position (engine position) + (chess-with-current-buffer engine + (setq chess-engine-game nil + chess-engine-position position) + (chess-engine-command nil 'setup position))) + +(defun chess-engine-position (engine) + (chess-with-current-buffer engine + (or (and chess-engine-game + (chess-game-pos chess-engine-game)) + chess-engine-position))) + +(defun chess-engine-set-game (engine game) + (chess-with-current-buffer engine + (setq chess-engine-game game + chess-engine-position nil) + (chess-engine-command nil 'setup (chess-game-pos game)))) + +(defun chess-engine-game (engine) + (chess-with-current-buffer engine + chess-engine-game)) + +(defun chess-engine-index (engine) + (chess-with-current-buffer engine + (if chess-engine-game + (chess-game-index chess-engine-game)))) + +(defun chess-engine-move (engine ply) + (chess-with-current-buffer engine + (chess-engine-command engine 'move ply))) + +(defun chess-engine-pass (engine ply) + (chess-with-current-buffer engine + (chess-engine-command engine 'pass))) + +(defun chess-engine-send (engine string) + (chess-with-current-buffer engine + (process-send-string (get-buffer-process (current-buffer)) string))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Module method +;; + +;;;###autoload +(defun chess-engine (session buffer event &rest args) + "Handle any commands being sent to this instance of this module." + (if (eq event 'initialize) + (chess-engine-create (car args) 'chess-engine-session-callback session) + (ignore + (cond + ((eq event 'shutdown) + (chess-engine-destroy engine)) + + ((eq event 'setup) + (chess-engine-set-game engine (car args))) + + ((eq event 'pass) + (chess-engine-pass engine)))))) + +(defun chess-engine-filter (proc string) + "Process filter for receiving text from a chess process." + (let ((buf (process-buffer proc))) + (when (buffer-live-p buf) + (with-current-buffer buf + (let ((moving (= (point) (process-mark proc)))) + (save-excursion + ;; Insert the text, advancing the process marker. + (goto-char (process-mark proc)) + (insert string) + (set-marker (process-mark proc) (point))) + (if moving (goto-char (process-mark proc)))) + (unless chess-engine-working + (setq chess-engine-working t) + (unwind-protect + (progn + (if chess-engine-last-pos + (goto-char chess-engine-last-pos) + (goto-char (point-min))) + (beginning-of-line) + (while (not (eobp)) + (condition-case err + (let ((triggers chess-engine-regexp-alist)) + (while triggers + ;; this could be accelerated by joining + ;; together the regexps + (if (looking-at (caar triggers)) + (funcall (cdar triggers))) + (setq triggers (cdr triggers)))) + (chess-illegal (error-message-string err))) + (forward-line))) + (setq chess-engine-last-pos (point) + chess-engine-working nil))))))) + +(provide 'chess-engine) + +;;; chess-engine.el ends here diff --git a/chess-engines.el b/chess-engines.el deleted file mode 100644 index c014972..0000000 --- a/chess-engines.el +++ /dev/null @@ -1,56 +0,0 @@ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Play against popular chess engines -;; -;; $Revision$ - -(require 'chess-process) - -(define-chess-engine crafty (&rest args) - (list (list - (concat "\\s-*\\(White\\|Black\\)\\s-*([0-9]+):\\s-+\\(" - chess-algebraic-regexp "\\)\\s-*$") - (function - (lambda (color move) - (if (string= (if (chess-game-side-to-move chess-process-game) - "White" "Black") - color) - (chess-session-event - chess-current-session 'move - (chess-algebraic-to-ply - (chess-game-pos chess-process-game) move))))) - 1 2) - '("Illegal move:\\s-*\\(.*\\)" - (signal 'chess-illegal (match-string 1)))) - (init (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")) - (shutdown "quit") - (move (chess-game-ply-to-algebraic chess-process-game (car args))) - (pass "go")) - -(define-chess-engine gnuchess (&rest args) - (list (list - (concat "My move is : \\(" chess-algebraic-regexp "\\)") - (function - (lambda (move) - (chess-session-event chess-current-session 'move - (chess-algebraic-to-ply - (chess-game-pos chess-process-game) move)))) - 1) - '("Illegal move:\\s-*\\(.*\\)" - (signal 'chess-illegal (match-string 1)))) - (shutdown "quit") - (move (chess-game-ply-to-algebraic chess-process-game (car args))) - (pass "go")) - -;;; chess-engines.el ends here diff --git a/chess-game.el b/chess-game.el index 034bbe9..1177b18 100644 --- a/chess-game.el +++ b/chess-game.el @@ -101,8 +101,9 @@ the game's FEN tag). SEARCH-FUNC specifies the function used to test the legality of moves. TAGS is the starting set of game tags (which can always be changed later using the various tag-related methods)." - (let ((game (list tags (or search-func - 'chess-standard-search-position)))) + (let ((game (list tags + (or search-func 'chess-standard-search-position) + (or position (chess-pos-create))))) (dolist (tag (cons (cons "Date" (format-time-string "%Y.%m.%d")) chess-game-default-tags)) (unless (chess-game-tag game (car tag)) @@ -134,7 +134,11 @@ a0 243 (ignore (let ((color (not (chess-session-data session 'my-color)))) (message "You are now playing %s" (if color "White" "Black")) - (chess-session-set-data session 'my-color (not color))))))) + (chess-session-set-data session 'my-color (not color))))) + + ((eq event 'move) + (chess-game-move (chess-session-data session 'current-game) + (car args))))) (aset chess-puzzle-locations 3 puzzle-engine))))))) (provide 'chess) @@ -520,7 +520,44 @@ moves. @end menu @node Chess engines, , Ply sources, Ply sources -@section Chess engines +@section Engines + +@defun chess-engine-create style callback &optional session +@end defun + +@defun chess-engine-set-option engine option value +@end defun + +@defun chess-engine-option engine option +@end defun + +@c 'ponder +@c 'search-depth +@c 'wall-clock + +@defun chess-engine-destroy engine +@end defun + +@defun chess-engine-set-position engine position ; uses 'edit' command +@end defun + +@defun chess-engine-position engine +@end defun + +@defun chess-engine-set-game engine game +@end defun + +@defun chess-engine-game engine +@end defun + +@defun chess-engine-index engine +@end defun + +@defun chess-engine-move engine ply +@end defun + +@defun chess-engine-command engine string +@end defun @unnumbered Concept Index |