eschulte pushed a commit to branch go
in repository elpa.
commit b8a7c7237331c0097c81257966ca61717a139229
Author: Eric Schulte <eric.schu...@gmx.com>
Date: Tue May 22 21:03:45 2012 -0400
communicating with gnugo through gtp generics
---
sgf-gnugo.el | 60 +++++++++++++++++++++++--------------------------
sgf-gtp.el | 10 +++++++-
sgf-tests.el | 70 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
3 files changed, 106 insertions(+), 34 deletions(-)
diff --git a/sgf-gnugo.el b/sgf-gnugo.el
index f713c48..6d59095 100644
--- a/sgf-gnugo.el
+++ b/sgf-gnugo.el
@@ -47,42 +47,31 @@
(defvar sgf-gnugo-process-name "gnugo"
"name for the gnugo process")
-(defvar sgf-gnugo-buffer nil
- "comint buffer holding the gnugo processes")
-
(defun sgf-gnugo-start-process (&optional options)
- (interactive)
- (unless (comint-check-proc sgf-gnugo-buffer)
- (setf sgf-gnugo-buffer
- (apply 'make-comint
- sgf-gnugo-process-name
- sgf-gnugo-program nil
- "--mode" "gtp" "--quiet"
- (when options (split-string options))))
- (set-buffer sgf-gnugo-buffer)
- (comint-mode)
- ;; just to refresh everything
- (sgf-gnugo-input-command "showboard")))
-
-(defun sgf-gnugo-command-to-string (command)
+ (let ((buffer (apply 'make-comint
+ sgf-gnugo-process-name
+ sgf-gnugo-program nil
+ "--mode" "gtp" "--quiet"
+ (when options (split-string options)))))
+ (with-current-buffer buffer (comint-mode))
+ buffer))
+
+(defun sgf-gnugo-command-to-string (gnugo command)
"Send command to gnugo process and return gnugo's results as a string"
(interactive "sgnugo command: ")
- (sgf-gnugo-input-command command)
- (sgf-gnugo-last-output))
+ (sgf-gnugo-input-command gnugo command)
+ (sgf-gnugo-last-output gnugo))
-(defun sgf-gnugo-input-command (command)
- "Pass COMMAND to the gnugo process running in `sgf-gnugo-buffer'"
- (save-excursion
- (set-buffer sgf-gnugo-buffer)
+(defun sgf-gnugo-input-command (gnugo command)
+ "Pass COMMAND to the gnugo process running in the buffer of GNUGO."
+ (with-current-buffer (buffer gnugo)
(goto-char (process-mark (get-buffer-process (current-buffer))))
(insert command)
- (comint-send-input)
- (sgf-gnugo-wait-for-output)))
+ (comint-send-input))
+ (sgf-gnugo-wait-for-output gnugo))
-(defun sgf-gnugo-wait-for-output ()
- "Wait until output arrives"
- (save-excursion
- (set-buffer sgf-gnugo-buffer)
+(defun sgf-gnugo-wait-for-output (gnugo)
+ (with-current-buffer (buffer gnugo)
(while (progn
(goto-char comint-last-input-end)
(not (re-search-forward "^= *[^\000]+?\n\n" nil t)))
@@ -90,12 +79,19 @@
(error (match-string 1)))
(accept-process-output (get-buffer-process (current-buffer))))))
-(defun sgf-gnugo-last-output ()
- (save-window-excursion
- (set-buffer sgf-gnugo-buffer)
+(defun sgf-gnugo-last-output (gnugo)
+ (with-current-buffer (buffer gnugo)
(comint-show-output)
(org-babel-clean-text-properties
(buffer-substring (+ 2 (point)) (- (point-max) 2)))))
+
+;;; gtp interface
+(defclass gnugo (gtp)
+ ((buffer :initarg :buffer :accessor buffer :initform nil)))
+
+(defmethod gtp-command ((gnugo gnugo) command)
+ (sgf-gnugo-command-to-string gnugo command))
+
(provide 'sgf-gnugo)
;;; sgf-gnugo.el ends here
diff --git a/sgf-gtp.el b/sgf-gtp.el
index 7c9d0b7..57fddb5 100644
--- a/sgf-gtp.el
+++ b/sgf-gtp.el
@@ -47,7 +47,7 @@
(t (err)))))
(defun sgf-pos-to-gtp (pos)
- (format "%c%d" (num-to-char (car pos)) (1+ (cdr pos))))
+ (format "%c%d" (num-to-char (1+ (car pos))) (1+ (cdr pos))))
(defun sgf-to-gtp-command (element)
"Convert an sgf ELEMENT to a gtp command."
@@ -60,5 +60,13 @@
(:KM (format "komi %s" val))
(t nil))))
+(defclass gtp nil nil "Class for the GTP SGF GO backend.")
+
+(defgeneric gtp-command (back-end command)
+ "Send gtp COMMAND to OBJECT and return any output.")
+
+(defmethod sgf->move ((gtp gtp) move)
+ (gtp-command gtp (sgf-to-gtp-command move)))
+
(provide 'sgf-gtp)
;;; sgf-gtp.el ends here
diff --git a/sgf-tests.el b/sgf-tests.el
index 4472712..c174a60 100644
--- a/sgf-tests.el
+++ b/sgf-tests.el
@@ -141,7 +141,8 @@
(declare (indent 1))
`(let* ((sgf (sgf2el-file-to-el ,file))
(buffer (display-sgf sgf)))
- (unwind-protect (with-current-buffer buffer ,@body)
+ (unwind-protect
+ (with-current-buffer buffer ,@body)
(set-default 'sgf-index '(0))
(should (kill-buffer buffer)))))
(def-edebug-spec parse-many (file body))
@@ -206,3 +207,70 @@
(should (= 8 (sgf-gtp-char-to-gtp ?h)))
(should (= 9 (sgf-gtp-char-to-gtp ?j)))
(should (= 19 (sgf-gtp-char-to-gtp ?t))))
+
+(defmacro with-gnugo (&rest body)
+ `(let (*gnugo*)
+ (unwind-protect
+ (progn
+ (setf *gnugo* (make-instance 'gnugo))
+ (setf (buffer *gnugo*) (sgf-gnugo-start-process))
+ ,@body)
+ (let ((kill-buffer-query-functions nil))
+ (should (kill-buffer (buffer *gnugo*)))))))
+
+(ert-deftest sgf-test-gnugo-interaction-through-gtp ()
+ (let ((b1 (concat
+ "\n"
+ " A B C D E F G H J K L M N O P Q R S T\n"
+ "19 . . . . . . . . . . . . . . . . . . . 19\n"
+ "18 . . . . . . . . . . . . . . . . . . . 18\n"
+ "17 . . . . . . . . . . . . . . . . . . . 17\n"
+ "16 . . . + . . . . . + . . . . . + . . . 16\n"
+ "15 . . . . . . . . . . . . . . . . . . . 15\n"
+ "14 . . . . . . . . . . . . . . . . . . . 14\n"
+ "13 . . . . . . . . . . . . . . . . . . . 13\n"
+ "12 . . . . . . . . . . . . . . . . . . . 12\n"
+ "11 . . . . . . . . . . . . . . . . . . . 11 "
+ "WHITE (O) has captured 0 stones\n"
+ "10 . . . + . . . . . + . . . . . + . . . 10 "
+ "BLACK (X) has captured 0 stones\n"
+ " 9 . . . . . . . . . . . . . . . . . . . 9\n"
+ " 8 . . . . . . . . . . . . . . . . . . . 8\n"
+ " 7 . . . . . . . . . . . . . . . . . . . 7\n"
+ " 6 . . . . . . . . . . . . . . . . . . . 6\n"
+ " 5 . . . . . . . . . . . . . . . . . . . 5\n"
+ " 4 . . . + . . . . . + . . . . . + . . . 4\n"
+ " 3 . . . . . . . . . . . . . . . . . . . 3\n"
+ " 2 . . . . . . . . . . . . . . . . . . . 2\n"
+ " 1 . . . . . . . . . . . . . . . . . . . 1\n"
+ " A B C D E F G H J K L M N O P Q R S T"))
+ (b2 (concat
+ "\n"
+ " A B C D E F G H J K L M N O P Q R S T\n"
+ "19 . . . . . . . . . . . . . . . . . . . 19\n"
+ "18 . . . . . . . . . . . . . . . . . . . 18\n"
+ "17 . . . . . . . . . . . . . . . . . . . 17\n"
+ "16 . . . + . . . . . + . . . . . + . . . 16\n"
+ "15 . . . . . . . . . . . . . . . . . . . 15\n"
+ "14 . . . . . . . . . . . . . . . . . . . 14\n"
+ "13 . . . . . . . . . . . . . . . . . . . 13\n"
+ "12 . . . . . . . . . . . . . . . . . . . 12\n"
+ "11 . . . . . . . . . . . . . . . . . . . 11 "
+ "WHITE (O) has captured 0 stones\n"
+ "10 . . . + . . . . . + . . . . . + . . . 10 "
+ "BLACK (X) has captured 0 stones\n"
+ " 9 . . . . . . . . . . . . . . . . . . . 9\n"
+ " 8 . . . . . . . . . . . . . . . . . . . 8\n"
+ " 7 . . . . . . . . . . . . . . . . . . . 7\n"
+ " 6 . . . . . . . . . . . . . . . . . . . 6\n"
+ " 5 . . . . . . . . . . . . . . . . . . . 5\n"
+ " 4 . . . + . . . . . + . . . . . + . . . 4\n"
+ " 3 . . . . . . . . . . . . . . . . . . . 3\n"
+ " 2 X . . . . . . . . . . . . . . . . . . 2\n"
+ " 1 X . . . . . . . . . . . . . . . . . . 1\n"
+ " A B C D E F G H J K L M N O P Q R S T")))
+ (with-gnugo
+ (should (string= b1 (gtp-command *gnugo* "showboard")))
+ (should (string= "" (gtp-command *gnugo* "black A1")))
+ (should (string= "" (sgf->move *gnugo* '(:B :pos . (0 . 1)))))
+ (should (string= b2 (gtp-command *gnugo* "showboard"))))))
