Coded engines as a separate library. Still work to be done here.

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))
diff --git a/chess.el b/chess.el
index 7d8bedb..31e0bd3 100644
--- a/chess.el
+++ b/chess.el
@@ -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)
diff --git a/chess.texi b/chess.texi
index 723dce9..752a24f 100644
--- a/chess.texi
+++ b/chess.texi
@@ -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