[elpa] 74/255: sending sgf commands to gnugo

[Eric Schulte]

eschulte pushed a commit to branch go
in repository elpa.

commit ca8c2922c2e87dc18eea8c0a6342543fc47ce549
Author: Eric Schulte <address@hidden>
Date:   Tue May 22 17:41:50 2012 -0400

    sending sgf commands to gnugo
---
 sgf-gnugo.el |   10 +++++-----
 sgf-gtp.el   |   51 +++++++++++++++++++++++----------------------------
 2 files changed, 28 insertions(+), 33 deletions(-)

diff --git a/sgf-gnugo.el b/sgf-gnugo.el
index d5a1564..0673f30 100644
--- a/sgf-gnugo.el
+++ b/sgf-gnugo.el
@@ -57,7 +57,7 @@
                  sgf-gnugo-process-name
                  sgf-gnugo-program nil
                  "--mode" "gtp" "--quiet"
-                (if options (split-string options))))
+                (when options (split-string options))))
     (set-buffer sgf-gnugo-buffer)
     (comint-mode)
     ;; just to refresh everything
@@ -72,7 +72,6 @@
 (defun sgf-gnugo-input-command (command)
   "Pass COMMAND to the gnugo process running in `sgf-gnugo-buffer'"
   (save-excursion
-    (message (format "buffer-%s" sgf-gnugo-buffer))
     (set-buffer sgf-gnugo-buffer)
     (goto-char (process-mark (get-buffer-process (current-buffer))))
     (insert command)
@@ -86,15 +85,16 @@
     (while (progn
             (goto-char comint-last-input-end)
             (not (re-search-forward "^= *[^\000]+?\n\n" nil t)))
-      (if (re-search-forward "^? *\\([^\000]+?\\)\n\n" nil t)
-         (error (match-string 1)))
+      (when (re-search-forward "^? *\\([^\000]+?\\)\n\n" nil t)
+        (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)
     (comint-show-output)
-    (buffer-substring (+ 2 (point)) (- (point-max) 2))))
+    (org-babel-clean-text-properties
+     (buffer-substring (+ 2 (point)) (- (point-max) 2)))))
 
 (provide 'sgf-gnugo)
 ;;; sgf-gnugo.el ends here
diff --git a/sgf-gtp.el b/sgf-gtp.el
index dc82c99..4e7f938 100644
--- a/sgf-gtp.el
+++ b/sgf-gtp.el
@@ -32,7 +32,9 @@
 ;; The GMP command set may be implemented as an extension.
 
 ;; Code:
-(defun sgf-gtp-char-to-gtp (char)
+(require 'cl)
+
+(defun sgf-gtp-char-to-pos (char)
   (flet ((err () (error "sgf-gtp: invalid char %s" char)))
     (cond
      ((< char ?A)  (err))
@@ -43,34 +45,27 @@
      ((<= char ?t) (- char ?a))
      (t (err)))))
 
-(defun sgf-gtp-point-to-gtp (point-string)
-  (format "%s%d"
-         (substring point-string 0 1)
-         (sgf-gtp-char-to-gtp (elt point-string 1))))
+(defun sgf-num-to-gtp-char (num)
+  (flet ((err () (error "sgf-gtp: invalid num %s" num)))
+    (cond
+     ((< num 1)   (err))
+     ((< num 9)   (+ ?A (1- num)))
+     ((< num 19)  (+ ?A num))
+     (t (err)))))
+
+(defun sgf-pos-to-gtp (pos)
+  (format "%c%d" (sgf-num-to-gtp-char (car pos)) (1+ (cdr pos))))
 
-(defun sgf-gtp-command-to-sgf (command)
-  "Convert a gtp command to an sgf element"
-  (interactive)
-  (unless (listp node)
-    (error "sgf-gtp: node is not a cons cell"))
-  (let ((symbol (car node))
-       (value (cdr node)))
-    (if (listp symbol) ; recurse
-       (flatten (delq nil (mapcar 'sgf-gtp-node-to-gtp node)))
-      (if (symbolp symbol)
-         (list
-          (case symbol
-           (':B
-            (format "black %s" (sgf-gtp-point-to-gtp-point value)))
-           (':W
-            (format "white %s" (sgf-gtp-point-to-gtp-point value)))
-           (':SZ
-            (format "boardsize %s" value))
-           (':KM
-            (format "komi %s" value))
-           (t
-            nil)))
-       (error "sgf-gtp: %S is not a symbol" symbol)))))
+(defun sgf-to-gtp-command (element)
+  "Convert an sgf ELEMENT to a gtp command."
+  (let ((key (car element))
+       (val (cdr element)))
+    (case key
+      (:B       (format "black %s" (sgf-pos-to-gtp (aget (list val) :pos))))
+      (:W       (format "white %s" (sgf-pos-to-gtp (aget (list val) :pos))))
+      ((:SZ :S) (format "boardsize %s" val))
+      (:KM      (format "komi %s" val))
+      (t        nil))))
 
 (provide 'sgf-gtp)
 ;;; sgf-gtp.el ends here