eschulte pushed a commit to branch go
in repository elpa.
commit 1f4a34494e0bf535234bfac3aa7c2977e34a27d5
Author: Eric Schulte <eric.schu...@gmx.com>
Date: Tue May 22 21:56:00 2012 -0400
starting to transition to generic board interface
---
sgf-tests.el | 125 +++++++++++++++++++++++++++++++++++-----------------------
sgf-trans.el | 3 +-
sgf.el | 49 ++++++++++++++++++-----
3 files changed, 115 insertions(+), 62 deletions(-)
diff --git a/sgf-tests.el b/sgf-tests.el
index c174a60..5e91d69 100644
--- a/sgf-tests.el
+++ b/sgf-tests.el
@@ -32,6 +32,8 @@
(require 'sgf-gtp)
(require 'ert)
+
+;;; sgf2el tests
(ert-deftest sgf-parse-simple-tree ()
(let* ((str "(;GM[1]FF[4]
SZ[19]
@@ -81,6 +83,8 @@
(let ((sgf (sgf2el-file-to-el "sgf-files/jp-ming-5.sgf")))
(should (= 247 (length sgf)))))
+
+;;; board tests
(ert-deftest sgf-empty-board-to-string-test ()
(let ((board (make-vector (* 19 19) nil))
(string (concat " A B C D E F G H J K L M N O P Q R S T\n"
@@ -137,29 +141,6 @@
(board-to-string board)
(should t)))
-(defmacro with-sgf-file (file &rest body)
- (declare (indent 1))
- `(let* ((sgf (sgf2el-file-to-el ,file))
- (buffer (display-sgf sgf)))
- (unwind-protect
- (with-current-buffer buffer ,@body)
- (set-default 'sgf-index '(0))
- (should (kill-buffer buffer)))))
-(def-edebug-spec parse-many (file body))
-
-(ert-deftest sgf-display-fresh-sgf-buffer ()
- (with-sgf-file "sgf-files/3-4-joseki.sgf"
- (should *board*)
- (should *sgf*)
- (should *index*)))
-
-(ert-deftest sgf-independent-points-properties ()
- (with-sgf-file "sgf-files/3-4-joseki.sgf"
- (let ((points-length (length (assoc :points (sgf-ref sgf '(0))))))
- (right 4)
- (should (= points-length
- (length (assoc :points (sgf-ref sgf '(0)))))))))
-
(ert-deftest sgf-neighbors ()
(let ((board (make-board 19)))
(should (= 2 (length (neighbors board 0))))
@@ -171,33 +152,8 @@
(cons (stones-for *board* :B)
(stones-for *board* :W)))
-(ert-deftest sgf-singl-stone-capture ()
- (with-sgf-file "sgf-files/1-capture.sgf"
- (right 3) (should (tree-equal (stone-counts) '(2 . 0)))))
-
-(ert-deftest sgf-remove-dead-stone-ko ()
- (with-sgf-file "sgf-files/ko.sgf"
- (should (tree-equal (stone-counts) '(0 . 0))) (right 1)
- (should (tree-equal (stone-counts) '(1 . 0))) (right 1)
- (should (tree-equal (stone-counts) '(1 . 1))) (right 1)
- (should (tree-equal (stone-counts) '(2 . 1))) (right 1)
- (should (tree-equal (stone-counts) '(2 . 2))) (right 1)
- (should (tree-equal (stone-counts) '(3 . 2))) (right 1)
- (should (tree-equal (stone-counts) '(2 . 3))) (right 1)
- (should (tree-equal (stone-counts) '(3 . 2))) (right 1)
- (should (tree-equal (stone-counts) '(2 . 3)))))
-
-(ert-deftest sgf-two-stone-capture ()
- (with-sgf-file "sgf-files/2-capture.sgf"
- (right 8) (should (tree-equal (stone-counts) '(6 . 0)))))
-
-(ert-deftest sgf-parse-empty-properties ()
- (with-sgf-file "sgf-files/w-empty-properties.sgf"
- (should (remove-if-not (lambda (prop)
- (let ((val (cdr prop)))
- (and (sequencep val) (= 0 (length val)))))
- (car sgf)))))
-
+
+;;; GTP and gnugo tests
(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)))
@@ -274,3 +230,72 @@
(should (string= "" (gtp-command *gnugo* "black A1")))
(should (string= "" (sgf->move *gnugo* '(:B :pos . (0 . 1)))))
(should (string= b2 (gtp-command *gnugo* "showboard"))))))
+
+
+;;; SGF tests
+(defmacro with-sgf-from-file (file &rest body)
+ (declare (indent 1))
+ `(let (*sgf*)
+ (progn
+ (setf *sgf* (make-instance 'sgf))
+ (setf (self *sgf*) (sgf2el-file-to-el ,file))
+ ,@body)))
+
+(ert-deftest sgf-test-sgf-class-creation ()
+ (with-sgf-from-file "sgf-files/jp-ming-5.sgf"
+ (should (tree-equal (index *sgf*) '(0)))
+ (should (tree-equal (current *sgf*) (root *sgf*)))
+ (should (string= "Famous Blood Vomiting Game" (sgf<-name *sgf*)))
+ (should (= 19 (sgf<-size *sgf*)))))
+
+
+;;; SGF and board tests
+(defmacro with-sgf-file (file &rest body)
+ (declare (indent 1))
+ `(let (*sgf* buffer)
+ (unwind-protect
+ (progn
+ (setf *sgf* (make-instance 'sgf))
+ (setf (self *sgf*) (sgf2el-file-to-el ,file))
+ (setf buffer (sgf-board-display *sgf*))
+ (with-current-buffer buffer ,@body))
+ (should (kill-buffer buffer)))))
+(def-edebug-spec parse-many (file body))
+
+(ert-deftest sgf-display-fresh-sgf-buffer ()
+ (with-sgf-file "sgf-files/3-4-joseki.sgf"
+ (should *board*)))
+
+(ert-deftest sgf-independent-points-properties ()
+ (with-sgf-file "sgf-files/3-4-joseki.sgf"
+ (let ((points-length (length (assoc :points (sgf-ref sgf '(0))))))
+ (right 4)
+ (should (= points-length
+ (length (assoc :points (sgf-ref sgf '(0)))))))))
+
+(ert-deftest sgf-singl-stone-capture ()
+ (with-sgf-file "sgf-files/1-capture.sgf"
+ (right 3) (should (tree-equal (stone-counts) '(2 . 0)))))
+
+(ert-deftest sgf-remove-dead-stone-ko ()
+ (with-sgf-file "sgf-files/ko.sgf"
+ (should (tree-equal (stone-counts) '(0 . 0))) (right 1)
+ (should (tree-equal (stone-counts) '(1 . 0))) (right 1)
+ (should (tree-equal (stone-counts) '(1 . 1))) (right 1)
+ (should (tree-equal (stone-counts) '(2 . 1))) (right 1)
+ (should (tree-equal (stone-counts) '(2 . 2))) (right 1)
+ (should (tree-equal (stone-counts) '(3 . 2))) (right 1)
+ (should (tree-equal (stone-counts) '(2 . 3))) (right 1)
+ (should (tree-equal (stone-counts) '(3 . 2))) (right 1)
+ (should (tree-equal (stone-counts) '(2 . 3)))))
+
+(ert-deftest sgf-two-stone-capture ()
+ (with-sgf-file "sgf-files/2-capture.sgf"
+ (right 8) (should (tree-equal (stone-counts) '(6 . 0)))))
+
+(ert-deftest sgf-parse-empty-properties ()
+ (with-sgf-file "sgf-files/w-empty-properties.sgf"
+ (should (remove-if-not (lambda (prop)
+ (let ((val (cdr prop)))
+ (and (sequencep val) (= 0 (length val)))))
+ (car sgf)))))
diff --git a/sgf-trans.el b/sgf-trans.el
index a439713..416fb2c 100644
--- a/sgf-trans.el
+++ b/sgf-trans.el
@@ -42,9 +42,10 @@
(defgeneric sgf->resign (back-end resign) "Send RESIGN to BACK-END.")
(defgeneric sgf->undo (back-end undo) "Send UNDO to BACK-END.")
(defgeneric sgf->comment (back-end comment) "Send COMMENT to BACK-END.")
+(defgeneric sgf<-size (back-end) "Get size from BACK-END")
+(defgeneric sgf<-name (back-end) "Get a game name from BACK-END.")
(defgeneric sgf<-alt (back-end) "Get an alternative from
BACK-END.")
(defgeneric sgf<-move (back-end) "Get POS from BACK-END.")
-(defgeneric sgf<-board (back-end) "Get SIZE from BACK-END.")
(defgeneric sgf<-comment (back-end) "Get COMMENT from BACK-END.")
(provide 'sgf-trans)
diff --git a/sgf.el b/sgf.el
index 99e017a..1b18b2c 100644
--- a/sgf.el
+++ b/sgf.el
@@ -58,18 +58,45 @@
;;; Class and interface
(defclass sgf nil
- ((sgf :initarg :sgf :accessor sgf :initform nil)
- (index :initarg :index :accessor index :initform nil))
+ ((self :initarg :self :accessor self :initform nil)
+ (index :initarg :index :accessor index :initform '(0)))
"Class for the SGF back end.")
-(defmethod sgf->move ((sgf sgf) move))
-(defmethod sgf->board ((sgf sgf) size))
-(defmethod sgf->resign ((sgf sgf) resign))
-(defmethod sgf->undo ((sgf sgf) undo))
-(defmethod sgf->comment ((sgf sgf) comment))
-(defmethod sgf<-alt ((sgf sgf)))
-(defmethod sgf<-move ((sgf sgf)))
-(defmethod sgf<-board ((sgf sgf)))
-(defmethod sgf<-comment ((sgf sgf)))
+(defmethod current ((sgf sgf))
+ (sgf-ref (self sgf) (index sgf)))
+
+(defmethod root ((sgf sgf))
+ (sgf-ref (self sgf) '(0)))
+
+(defmethod sgf->move ((sgf sgf) move))
+
+(defmethod sgf->board ((sgf sgf) size))
+
+(defmethod sgf->resign ((sgf sgf) resign))
+
+(defmethod sgf->undo ((sgf sgf) undo)
+ (decf (car (last (index sgf))))
+ (alistp (current sgf)))
+
+;; (defmethod sgf->comment ((sgf sgf) comment)
+;; ;; TODO: need a setf method for current
+;; (push (cons :C comment) (current sgf)))
+
+(defmethod sgf<-size ((sgf sgf))
+ (or (aget (root sgf) :S)
+ (aget (root sgf) :SZ)))
+
+(defmethod sgf<-name ((sgf sgf))
+ (or (aget (root sgf) :GN)
+ (aget (root sgf) :EV)))
+
+(defmethod sgf<-alt ((sgf sgf)))
+
+(defmethod sgf<-move ((sgf sgf))
+ (incf (car (last (index sgf))))
+ (alistp (current sgf)))
+
+(defmethod sgf<-comment ((sgf sgf))
+ (aget (current sgf) :C))
(provide 'sgf)
