[elpa] 70/255: bringing in some files from my old go-mode

[Eric Schulte]

eschulte pushed a commit to branch go
in repository elpa.

commit 332c626f95bfe569c9a01a9d9ab0ea729b61b334
Author: Eric Schulte <address@hidden>
Date:   Tue May 22 16:50:55 2012 -0400

    bringing in some files from my old go-mode
---
 sgf-gnugo.el |  102 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 sgf-gtp.el   |   76 +++++++++++++++++++++++++++++++++++++++++++
 sgf-tests.el |   11 ++++++
 3 files changed, 189 insertions(+), 0 deletions(-)

diff --git a/sgf-gnugo.el b/sgf-gnugo.el
new file mode 100644
index 0000000..229df31
--- /dev/null
+++ b/sgf-gnugo.el
@@ -0,0 +1,102 @@
+;;; sgf-gnugo.el --- functions for interaction with a gnugo process using gtp
+
+;; Copyright (C) 2008 2012 Eric Schulte <address@hidden>
+
+;;; Liscence:
+
+;; Author: Eric Schulte <address@hidden>
+;; Created: 2012-05-15
+;; Version: 0.1
+;; Keywords: game go sgf gtp gnugo
+
+;; This file is not (yet) part of GNU Emacs.
+;; However, it is distributed under the same license.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Comments:
+
+;; Interaction with gnugo
+
+;;; CODE:
+(require 'comint)
+
+(defun sgf-gnugo-gtp-commands ()
+  "Return a list of the gnugo GTP commands."
+  (split-string
+   (substring
+    (shell-command-to-string
+     (format "echo list_commands | %s --mode gtp" sgf-gnugo-program))
+    2 -2) "\n"))
+
+(defvar sgf-gnugo-program "gnugo"
+  "path to gnugo executable")
+
+(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"
+                (if 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)
+  "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))
+
+(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)
+    (comint-send-input)
+    (sgf-gnugo-wait-for-output)))
+
+(defun sgf-gnugo-wait-for-output ()
+  "Wait until output arrives"
+  (save-excursion
+    (set-buffer sgf-gnugo-buffer)
+    (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)))
+      (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))))
+
+(provide 'sgf-gnugo)
+;;; sgf-gnugo.el ends here
diff --git a/sgf-gtp.el b/sgf-gtp.el
new file mode 100644
index 0000000..dc82c99
--- /dev/null
+++ b/sgf-gtp.el
@@ -0,0 +1,76 @@
+;;; sgf-gtp.el --- translate between sgf and GTP
+
+;; Copyright (C) 2008 2012 Eric Schulte <address@hidden>
+
+;; Author: Eric Schulte <address@hidden>
+;; Created: 2012-05-15
+;; Version: 0.1
+;; Keywords: game go sgf gtp gnugo
+
+;; This file is not (yet) part of GNU Emacs.
+;; However, it is distributed under the same license.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;; Commentary:
+
+;; 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.
+
+;; Code:
+(defun sgf-gtp-char-to-gtp (char)
+  (flet ((err () (error "sgf-gtp: invalid char %s" char)))
+    (cond
+     ((< char ?A)  (err))
+     ((< char ?I)  (1+ (- char ?A)))
+     ((<= char ?T) (- char ?A))
+     ((< char ?a)  (err))
+     ((< char ?i)  (1+ (- char ?a)))
+     ((<= 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-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)))))
+
+(provide 'sgf-gtp)
+;;; sgf-gtp.el ends here
diff --git a/sgf-tests.el b/sgf-tests.el
index 1196bf3..4472712 100644
--- a/sgf-tests.el
+++ b/sgf-tests.el
@@ -29,6 +29,7 @@
 (require 'sgf-util)
 (require 'sgf2el)
 (require 'sgf-board)
+(require 'sgf-gtp)
 (require 'ert)
 
 (ert-deftest sgf-parse-simple-tree ()
@@ -195,3 +196,13 @@
                              (let ((val (cdr prop)))
                                (and (sequencep val) (= 0 (length val)))))
                            (car sgf)))))
+
+(ert-deftest sgf-test-sgf-gtp-char-to-gtp ()
+  (should (= 1  (sgf-gtp-char-to-gtp ?A)))
+  (should (= 8  (sgf-gtp-char-to-gtp ?H)))
+  (should (= 9  (sgf-gtp-char-to-gtp ?J)))
+  (should (= 19 (sgf-gtp-char-to-gtp ?T)))
+  (should (= 1  (sgf-gtp-char-to-gtp ?a)))
+  (should (= 8  (sgf-gtp-char-to-gtp ?h)))
+  (should (= 9  (sgf-gtp-char-to-gtp ?j)))
+  (should (= 19 (sgf-gtp-char-to-gtp ?t))))