[elpa] 79/255: communicating with gnugo through gtp generics

[Eric Schulte]

eschulte pushed a commit to branch go
in repository elpa.

commit b8a7c7237331c0097c81257966ca61717a139229
Author: Eric Schulte <address@hidden>
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"))))))