1 files changed, 69 insertions, 0 deletions
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