[elpa] 75/255: stubbing out board interaction functions

[Eric Schulte]

eschulte pushed a commit to branch go
in repository elpa.

commit 4f390ef4e0267f4971a9f5ede4f9718727d3db9e
Author: Eric Schulte <address@hidden>
Date:   Tue May 22 18:24:41 2012 -0400

    stubbing out board interaction functions
---
 sgf-board.el |   47 +++++++++++++++++++++++++++++++++++++++++++++++
 sgf-gtp.el   |   11 ++---------
 sgf-util.el  |   14 ++++++++++++++
 sgf2el.el    |   11 ++---------
 4 files changed, 65 insertions(+), 18 deletions(-)

diff --git a/sgf-board.el b/sgf-board.el
index 8f2c6ea..3c052b5 100644
--- a/sgf-board.el
+++ b/sgf-board.el
@@ -304,6 +304,53 @@
     (dolist (n cull cull) (setf (aref board n) nil))))
 
 
+;;; User input
+(defvar sgf-board-actions '(move resign undo comment)
+  "List of actions which may be taken on an SGF board.")
+
+(defun sgf-board-act ()
+  "Send a command to the current SGF board."
+  (interactive)
+  (let ((command (org-icompleting-read
+                  "Action: " (mapcar #'symbol-name sgf-board-actions))))
+    (case (intern command)
+      (move    (message "make a move"))
+      (resign  (message "game over"))
+      (undo    (message "loser"))
+      (comment (message "what?")))))
+
+(defun sgf-board-act-move (&optional pos)
+  (interactive)
+  (unless pos
+    (let ((size (if *board* (board-size *board*) 19)))
+      (setq pos
+            (cons
+             (char-to-num
+              (aref (downcase
+                     (org-icompleting-read
+                      "X pos: "
+                      (mapcar #'string
+                              (mapcar #'num-to-char (range 1 size)))))
+                    0))
+             (1- (string-to-number
+                  (org-icompleting-read
+                   "Y pos: "
+                   (mapcar #'number-to-string (range 1 size)))))))))
+  (message "move: %S" pos))
+
+(defun sgf-board-act-resign ()
+  (interactive)
+  (message "resign"))
+
+(defun sgf-board-act-undo (&optional num)
+  (interactive "p")
+  (message "undo: %S" num))
+
+(defun sgf-board-act-comment (&optional comment)
+  (interactive "MComment: ")
+  (message "comment: %S" comment))
+
+
 ;;; Display mode
 (defvar sgf-mode-map
   (let ((map (make-sparse-keymap)))
diff --git a/sgf-gtp.el b/sgf-gtp.el
index 4e7f938..4371610 100644
--- a/sgf-gtp.el
+++ b/sgf-gtp.el
@@ -33,6 +33,7 @@
 
 ;; Code:
 (require 'cl)
+(require 'sgf-util)
 
 (defun sgf-gtp-char-to-pos (char)
   (flet ((err () (error "sgf-gtp: invalid char %s" char)))
@@ -45,16 +46,8 @@
      ((<= char ?t) (- char ?a))
      (t (err)))))
 
-(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))))
+  (format "%c%d" (num-to-char (car pos)) (1+ (cdr pos))))
 
 (defun sgf-to-gtp-command (element)
   "Convert an sgf ELEMENT to a gtp command."
diff --git a/sgf-util.el b/sgf-util.el
index a77d4cf..89d989d 100644
--- a/sgf-util.el
+++ b/sgf-util.el
@@ -51,4 +51,18 @@
        (listp (car list))
        (not (listp (caar list)))))
 
+(defun num-to-char (num)
+  (flet ((err () (error "sgf: invalid num %s" num)))
+    (cond
+     ((< num 1) (err))
+     ((< num 9) (+ ?A (1- num)))
+     (t         (+ ?A num)))))
+
+(defun char-to-num (char)
+  (cond
+   ((or (< char ?A) (< ?z char))
+    (error "sgf: invalid char %s" char))
+   ((< char ?a) (+ 26 (- char ?A)))
+   (t           (- char ?a))))
+
 (provide 'sgf-util)
diff --git a/sgf2el.el b/sgf2el.el
index 326ed0e..0727cff 100644
--- a/sgf2el.el
+++ b/sgf2el.el
@@ -149,16 +149,9 @@
                       (car date-args)))))
 (add-to-list 'sgf2el-special-properties (cons :DT #'process-date))
 
-(defun char-to-pos (char)
-  (cond
-   ((or (< char ?A) (< ?z char))
-    (error "sgf: invalid char %s" char))
-   ((< char ?a) (+ 26 (- char ?A)))
-   (t           (- char ?a))))
-
 (defun process-position (position-string)
-  (cons (char-to-pos (aref position-string 0))
-        (char-to-pos (aref position-string 1))))
+  (cons (char-to-num (aref position-string 0))
+        (char-to-num (aref position-string 1))))
 
 (defun process-move (move-args)
   (list (cons :pos (process-position (car move-args)))))