[elpa] 244/255: igs-pipe handles resignation and comments

[Eric Schulte]

eschulte pushed a commit to branch go
in repository elpa.

commit 0e2d5f2a99c9669c7e5cc02b51dccab4bffd32bd
Author: Eric Schulte <address@hidden>
Date:   Fri Aug 9 16:39:11 2013 -0600

    igs-pipe handles resignation and comments
---
 back-ends/gtp-pipe.el |   35 ++++++++++++++++++++++++++++++-----
 back-ends/gtp.el      |   15 +++++++++++++++
 go-board.el           |    2 +-
 3 files changed, 46 insertions(+), 6 deletions(-)

diff --git a/back-ends/gtp-pipe.el b/back-ends/gtp-pipe.el
index f2ab93d..fe01623 100644
--- a/back-ends/gtp-pipe.el
+++ b/back-ends/gtp-pipe.el
@@ -33,6 +33,9 @@
 (defvar *gtp-pipe-board* nil
   "Board associated with the current gtp pipe process.")
 
+(defvar *gtp-pipe-last* nil
+  "Last move of the current game.")
+
 (defun gtp-pipe-start (command)
   "Connect a `gtp-pipe' instance to the process created by COMMAND.
 Pass \"netcat -lp 6666\" as COMMAND to listen on a local port, or
@@ -44,12 +47,23 @@ port."
 (defun gtp-pipe-process-filter (proc string)
   (go-re-cond string
     ("^\\(black\\|white\\) \\(.*\\)$"
-     (setf (go-move *gtp-pipe-board*)
-           (gtp-to-pos (go-re-cond (match-string 1 string)
-                         ("black" :B)
-                         ("white" :W))
-                       (match-string 2 string))))
+     (let ((color (match-string 1 string))
+           (action (match-string 2 string)))
+       (go-re-cond action
+         ("^pass"   (go-pass   *gtp-pipe-board*))
+         ("^resign" (go-resign *gtp-pipe-board*))
+         (t (let ((move (gtp-to-pos (go-re-cond 
+                                        ("black" :B)
+                                      ("white" :W))
+                                    (match-string 2 string))))
+              (setf *gtp-pipe-last* move)
+              (setf (go-move *gtp-pipe-board*) move))))))
+    ("^genmove_\\(black\\|white\\)" (message "gtp-pipe: %s's turn"
+                                             (match-string 1 string)))
+    ("^last_move" (go-to-gtp-command *gtp-pipe-last*))
+    ("^quit" (message "gtp-pipe: QUIT") (go-quit *gtp-pipe-board*))
     ("^undo" (go-undo *gtp-pipe-board*))
+    ("^string \\(.*\\)$" (message "gtp-pipe: %S" (match-string 1 string)))
     (t (message "gtp-pipe unknown command: %S" string))))
 
 
@@ -65,6 +79,7 @@ port."
                            (car cmd-&-args) nil (cdr cmd-&-args))))
           (with-current-buffer buf
             (comint-mode)
+            (set (make-local-variable '*gtp-pipe-last*) nil)
             (set (make-local-variable '*gtp-pipe-board*)
                  (save-excursion
                    (make-instance 'board
@@ -80,6 +95,16 @@ port."
     (insert command)
     (comint-send-input)))
 
+(defmethod go-comment ((gtp-pipe gtp-pipe))
+  (signal 'unsupported-back-end-command (list gtp-pipe :comment)))
+
+(defmethod set-go-comment ((gtp-pipe gtp-pipe) comment)
+  (gtp-command gtp-pipe (format "string %s" comment)))
+
+(defmethod go-color ((gtp-pipe gtp-pipe))
+  (with-current-buffer (buffer gtp-pipe)
+    (go-color *gtp-pipe-board*)))
+
 (defmethod go-name ((gtp-pipe gtp-pipe)) "GTP pipe")
 (defmethod go-size ((gtp-pipe gtp-pipe))
   (read-from-minibuffer "GTP board size: " nil nil 'read))
diff --git a/back-ends/gtp.el b/back-ends/gtp.el
index cbb247b..daeb3f0 100644
--- a/back-ends/gtp.el
+++ b/back-ends/gtp.el
@@ -30,6 +30,21 @@
 ;; This file should be useful for translating between sgf and the GO
 ;; text protocol (GTP) see http://www.lysator.liu.se/~gunnar/gtp/.
 ;; The GMP command set may be implemented as an extension.
+;;
+;; see http://www.lysator.liu.se/~gunnar/gtp/gtp2-spec-draft2/gtp2-spec.html
+;;
+;; The following commands are required by GTP
+;; - protocol_version
+;; - name
+;; - version
+;; - known_command
+;; - list_commands
+;; - quit
+;; - boardsize
+;; - clear_board
+;; - komi
+;; - play
+;; - genmove
 
 ;; Code:
 (require 'go-api)
diff --git a/go-board.el b/go-board.el
index ed47196..b82712f 100644
--- a/go-board.el
+++ b/go-board.el
@@ -389,7 +389,7 @@
 
 (defun go-board-resign ()
   (interactive)
-  (with-backends back (go-reset back)))
+  (with-backends back (go-resign back)))
 
 (defun go-board-mark-point (point mark)
   (mapc (lambda (ov) (go-board-mark ov mark)) (overlays-at point)))