emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] 57/255: splitting sgf.el into board test and utility files


From: Eric Schulte
Subject: [elpa] 57/255: splitting sgf.el into board test and utility files
Date: Sun, 16 Mar 2014 01:02:19 +0000

eschulte pushed a commit to branch go
in repository elpa.

commit 9df76c482c36a4e2d6ca27ce352681b255a2b51d
Author: Eric Schulte <address@hidden>
Date:   Mon May 21 19:31:04 2012 -0400

    splitting sgf.el into board test and utility files
---
 sgf-board.el |  314 ++++++++++++++++++++++++++
 sgf-tests.el |  208 +++++++++++++++++
 sgf-util.el  |   46 ++++
 sgf.el       |  699 ----------------------------------------------------------
 4 files changed, 568 insertions(+), 699 deletions(-)

diff --git a/sgf-board.el b/sgf-board.el
new file mode 100644
index 0000000..9fe575d
--- /dev/null
+++ b/sgf-board.el
@@ -0,0 +1,314 @@
+;;; sgf-board.el --- Smart Game Format GO board visualization
+
+;; Copyright (C) 2012 Eric Schulte <address@hidden>
+
+;; Author: Eric Schulte <address@hidden>
+;; Created: 2012-05-15
+;; Version: 0.1
+;; Keywords: game go sgf
+
+;; 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.
+
+;;; Code:
+(eval-when-compile (require 'cl))
+
+
+;;; Visualization
+;; - make buffer to show a board, and notes, etc...
+;; - keep an index into the sgf file
+;; - write functions for building boards from sgf files (forwards and 
backwards)
+;; - sgf movement keys
+(defvar *board* nil "Holds the board local to a GO buffer.")
+
+(defvar *sgf*   nil "Holds the sgf data structure local to a GO buffer.")
+
+(defvar *index* nil "Index into the sgf local to a GO buffer.")
+
+(defun make-board (size) (make-vector (* size size) nil))
+
+(defun board-size (board) (round (sqrt (length board))))
+
+(defvar black-piece "X")
+
+(defvar white-piece "O")
+
+(defun board-header (board)
+  (let ((size (board-size board)))
+    (concat "    "
+            (mapconcat (lambda (n)
+                         (let ((char (+ ?A n)))
+                           (when (>= char ?I)
+                             (setq char (+ 1 char)))
+                           (string char)))
+                       (range size) " "))))
+
+(defun pos-to-index (pos size)
+  (+ (car pos) (* (cdr pos) size)))
+
+(defun board-pos-to-string (board pos)
+  (let ((size (board-size board)))
+    (flet ((emph (n)
+                 (cond
+                  ((= size 19)
+                   (or (= 3 n)
+                       (= 4 (- size n))
+                       (= n (/ (- size 1) 2))))
+                  ((= size 9)
+                   (or (= 2 n)
+                       (= 4 n))))))
+      (let ((val (aref board (pos-to-index pos size))))
+        (cond
+         ((equal val :w) white-piece)
+         ((equal val :b) black-piece)
+         ((and (stringp val) (= 1 (length val)) val))
+         (t  (if (and (emph (car pos)) (emph (cdr pos))) "+" ".")))))))
+
+(defun board-row-to-string (board row)
+  (let* ((size (board-size board))
+         (label (format "%3d" (- size row)))
+         (row-body (mapconcat
+                    (lambda (n)
+                      (board-pos-to-string board (cons row n)))
+                    (range size) " ")))
+    (concat label " " row-body label)))
+
+(defun board-body-to-string (board)
+  (mapconcat (lambda (m) (board-row-to-string board m))
+             (range (board-size board)) "\n"))
+
+(defun board-to-string (board)
+  (let ((header (board-header board))
+        (body (board-body-to-string board)))
+    (mapconcat #'identity (list header body header) "\n")))
+
+(defun board-to-pieces (board)
+  (let (pieces)
+    (dotimes (n (length board) pieces)
+      (let ((val (aref board n)))
+        (when val (push (cons val n) pieces))))))
+
+(defun pieces-to-board (pieces size)
+  (let ((board (make-vector size nil)))
+    (dolist (piece pieces board)
+      (setf (aref board (cdr piece)) (car piece)))))
+
+(defun clean-comment (comment)
+  (let ((replacements '(("\\(" . "(")
+                        ("\\)" . ")")
+                        ("\\[" . "[")
+                        ("\\]" . "]"))))
+    (dolist (pair replacements comment)
+      (setq comment (replace-regexp-in-string
+                     (regexp-quote (car pair)) (cdr pair) comment)))))
+
+(defun update-display ()
+  (unless *sgf* (error "sgf: buffer has not associated sgf data"))
+  (delete-region (point-min) (point-max))
+  (goto-char (point-min))
+  (insert
+   "\n"
+   (board-to-string *board*)
+   "\n\n")
+  (let ((comment (second (assoc "C" (sgf-ref *sgf* *index*)))))
+    (when comment
+      (insert (make-string (+ 6 (* 2 (board-size *board*))) ?=)
+              "\n\n")
+      (insert (clean-comment comment))))
+  (goto-char (point-min)))
+
+(defun display-sgf (game)
+  (let ((buffer (generate-new-buffer "*sgf*")))
+    (with-current-buffer buffer
+      (sgf-mode)
+      (set (make-local-variable '*sgf*)   game)
+      (set (make-local-variable '*index*) '(0 1))
+      (let* ((root (sgf-ref *sgf* *index*))
+             (name (format (or (second (assoc "GN" root))
+                               (second (assoc "EV" root)))))
+             (size (aget "S" root)))
+        (unless size
+          (error "sgf: game has no associated size"))
+        (when name (rename-buffer name 'unique))
+        (set (make-local-variable '*board*) (make-board size))
+        (push (cons :pieces (board-to-pieces *board*))
+              (sgf-ref *sgf* *index*))
+        (update-display)))
+    (pop-to-buffer buffer)))
+
+(defun display-sgf-file (path)
+  (interactive "f")
+  (display-sgf (read-from-file path)))
+
+(defun sgf-ref (sgf index)
+  (let ((part sgf))
+    (while (car index)
+      (setq part (nth (car index) part))
+      (setq index (cdr index)))
+    part))
+
+(defun set-sgf-ref (sgf index new)
+  (eval `(setf ,(reduce (lambda (acc el) (list 'nth el acc))
+                        index :initial-value 'sgf)
+               ',new)))
+
+(defsetf sgf-ref set-sgf-ref)
+
+(defun get-create-pieces ()
+  (if (aget :pieces (sgf-ref *sgf* *index*))
+      (setf *board* (pieces-to-board
+                     (aget :pieces (sgf-ref *sgf* *index*))
+                     (length *board*)))
+    (clear-labels *board*)
+    (apply-moves *board* (sgf-ref *sgf* *index*))
+    (push (cons :pieces (board-to-pieces *board*))
+          (sgf-ref *sgf* *index*))))
+
+(defun up (&optional num)
+  (interactive "p")
+  (prog1 (dotimes (n num n)
+           (unless (sgf-ref *sgf* *index*)
+             (update-display)
+             (error "sgf: no more upwards moves."))
+           (decf (car (last *index* 2)))
+           (setq *board* (pieces-to-board
+                          (aget :pieces (sgf-ref *sgf* *index*))
+                          (length *board*))))
+    (update-display)))
+
+(defun down (&optional num)
+  (interactive "p")
+  (prog1 (dotimes (n num n)
+           (incf (car (last *index* 2)))
+           (setf (car (last *index*)) 0)
+           (unless (sgf-ref *sgf* *index*)
+             (update-display)
+             (error "sgf: no more downwards moves."))
+           (get-create-pieces))
+    (update-display)))
+
+(defun left (&optional num)
+  (interactive "p")
+  (prog1 (dotimes (n num n)
+           (unless (sgf-ref *sgf* *index*)
+             (update-display)
+             (error "sgf: no more backwards moves."))
+           (decf (car (last *index*)))
+           (setq *board* (pieces-to-board
+                          (aget :pieces (sgf-ref *sgf* *index*))
+                          (length *board*))))
+    (update-display)))
+
+(defun right (&optional num)
+  (interactive "p")
+  (prog1 (dotimes (n num n)
+           (incf (car (last *index*)))
+           (unless (sgf-ref *sgf* *index*)
+             (decf (car (last *index*)))
+             (update-display)
+             (error "sgf: no more forward moves."))
+           (get-create-pieces))
+    (update-display)))
+
+
+;;; Board manipulation functions
+(defun move-type (move)
+  (cond
+   ((member (car move) '("B"  "W"))  :move)
+   ((member (car move) '("LB" "LW")) :label)))
+
+(defun apply-moves (board moves)
+  (flet ((bset (val data)
+               (setf (aref board (pos-to-index (aget :pos data)
+                                               (board-size board)))
+                     (cond ((string= "B"  val)  :b)
+                           ((string= "W"  val)  :w)
+                           ((string= "LB" val) (aget :label data))
+                           ((string= "LW" val) (aget :label data))
+                           (t nil)))))
+    (dolist (move moves board)
+      (case (move-type move)
+        (:move
+         (bset (car move) (cdr move))
+         (let ((color (if (string= "B" (car move)) :b :w)))
+           (remove-dead *board* (other-color color))
+           (remove-dead *board* color)))
+        (:label
+         (dolist (data (cdr move)) (bset (car move) data)))))))
+
+(defun clear-labels (board)
+  (dotimes (point (length board))
+    (when (aref board point)
+      (unless (member (aref board point) '(:b :w))
+        (setf (aref board point) nil)))))
+
+(defun stones-for (board color)
+  (let ((count 0))
+    (dotimes (n (length board) count)
+      (when (equal color (aref board n)) (incf count)))))
+
+(defun neighbors (board piece)
+  (let ((size (board-size board))
+        neighbors)
+    (when (not (= (mod piece size) (1- size))) (push (1+ piece) neighbors))
+    (when (not (= (mod piece size) 0))         (push (1- piece) neighbors))
+    (when (< (+ piece size) (length board))    (push (+ piece size) neighbors))
+    (when (> (- piece size) 0)                 (push (- piece size) neighbors))
+    neighbors))
+
+(defun alive-p (board piece &optional already)
+  (let* ((val (aref board piece))
+         (enemy (other-color val))
+         (neighbors (remove-if (lambda (n) (member n already))
+                               (neighbors board piece)))
+         (neighbor-vals (mapcar (lambda (n) (aref board n)) neighbors))
+         (friendly-neighbors (delete nil (map 'list (lambda (n v)
+                                                      (when (equal v val) n))
+                                              neighbors neighbor-vals)))
+         (already (cons piece already)))
+    (or (some (lambda (v) (not (or (equal v enemy) ; touching open space
+                              (equal v val))))
+              neighbor-vals)
+        (some (lambda (n) (alive-p board n already)) ; touching alive dragon
+              friendly-neighbors))))
+
+(defun remove-dead (board color)
+  ;; must remove one color at a time for ko situations
+  (let (cull)
+    (dotimes (n (length board) board)
+      (when (and (equal (aref board n) color) (not (alive-p board n)))
+        (push n cull)))
+    (dolist (n cull cull) (setf (aref board n) nil))))
+
+
+;;; Display mode
+(defvar sgf-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "<right>") 'right)
+    (define-key map (kbd "<left>")  'left)
+    (define-key map (kbd "<up>")    'up)
+    (define-key map (kbd "<down>")  'down)
+    (define-key map (kbd "q") (lambda () (interactive)
+                                (kill-buffer (current-buffer))))
+    map)
+  "Keymap for `sgf-mode'.")
+
+(define-derived-mode sgf-mode nil "SGF"
+  "Major mode for editing text written for viewing SGF files.")
+
+(provide 'sgf-board)
diff --git a/sgf-tests.el b/sgf-tests.el
new file mode 100644
index 0000000..94eb25e
--- /dev/null
+++ b/sgf-tests.el
@@ -0,0 +1,208 @@
+;;; sgf2el.el --- conversion between sgf and emacs-lisp
+
+;; Copyright (C) 2012 Eric Schulte <address@hidden>
+
+;; Author: Eric Schulte <address@hidden>
+;; Created: 2012-05-15
+;; Version: 0.1
+;; Keywords: game go sgf
+
+;; 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.
+
+;;; Code:
+(require 'sgf-util)
+(require 'sgf2el)
+(require 'sgf-board)
+(require 'ert)
+
+(ert-deftest sgf-parse-prop-tests ()
+  (flet ((should= (a b) (should (tree-equal a b :test #'string=))))
+    (should= (parse-props "B[pq]") '(("B" "pq")))
+    (should= (parse-props "GM[1]") '(("GM" "1")))
+    (should= (parse-props "GM[1]\nB[pq]\tB[pq]")
+             '(("GM" "1") ("B" "pq") ("B" "pq")))
+    (should (= (length (cdar (parse-props "TB[as][bs][cq][cr][ds][ep]")))
+               6))))
+
+(ert-deftest sgf-parse-multiple-small-nodes-test ()
+  (let* ((str ";B[pq];W[dd];B[pc];W[eq];B[cp];W[cm];B[do];W[hq];B[qn];W[cj]")
+         (nodes (parse-nodes str)))
+    (should (= (length nodes) 10))
+    (should (tree-equal (car nodes) '(("B" "pq")) :test #'string=))))
+
+(ert-deftest sgf-parse-one-large-node-test ()
+  (let* ((str ";GM[1]FF[4]
+               SZ[19]
+               GN[GNU Go 3.7.11 load and print]
+               DT[2008-12-14]
+               KM[0.0]HA[0]RU[Japanese]AP[GNU Go:3.7.11]AW[ja][oa]
+               [pa][db][eb]")
+         (node (car (parse-nodes str))))
+    (should (= (length node) 10))
+    (should (= (length (cdar (last node))) 5))))
+
+(ert-deftest sgf-parse-simple-tree ()
+  (let* ((str "(;GM[1]FF[4]
+               SZ[19]
+               GN[GNU Go 3.7.11 load and print]
+               DT[2008-12-14]
+               KM[0.0]HA[0]RU[Japanese]AP[GNU Go:3.7.11]AW[ja][oa]
+               [pa][db][eb])")
+         (tree (parse-trees str)))
+    (should (= 1  (length tree)))
+    (should (= 10 (length (first tree))))))
+
+(ert-deftest sgf-parse-nested-tree ()
+  (let* ((str "(;GM[1]FF[4]
+               SZ[19]
+               GN[GNU Go 3.7.11 load and print]
+               DT[2008-12-14]
+               KM[0.0]HA[0]RU[Japanese]AP[GNU Go:3.7.11]
+               (;AW[ja][oa][pa][db][eb] ;AB[fa][ha][ia][qa][cb]))")
+         (tree (parse-trees str)))
+    (should (= 3 (length tree)))
+    (should (= 9 (length (first tree))))
+    (should (= 6 (length (car (second tree)))))
+    (should (= 6 (length (car (third tree)))))))
+
+(ert-deftest sgf-parse-file-test ()
+  (let ((game (read-from-file "sgf-files/jp-ming-5.sgf")))
+    (should (= 247 (length game)))))
+
+(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"
+                        " 19 . . . . . . . . . . . . . . . . . . . 19\n"
+                        " 18 . . . . . . . . . . . . . . . . . . . 18\n"
+                        " 17 . . . . . . . . . . . . . . . . . . . 17\n"
+                        " 16 . . . + . . . . . + . . . . . + . . . 16\n"
+                        " 15 . . . . . . . . . . . . . . . . . . . 15\n"
+                        " 14 . . . . . . . . . . . . . . . . . . . 14\n"
+                        " 13 . . . . . . . . . . . . . . . . . . . 13\n"
+                        " 12 . . . . . . . . . . . . . . . . . . . 12\n"
+                        " 11 . . . . . . . . . . . . . . . . . . . 11\n"
+                        " 10 . . . + . . . . . + . . . . . + . . . 10\n"
+                        "  9 . . . . . . . . . . . . . . . . . . .  9\n"
+                        "  8 . . . . . . . . . . . . . . . . . . .  8\n"
+                        "  7 . . . . . . . . . . . . . . . . . . .  7\n"
+                        "  6 . . . . . . . . . . . . . . . . . . .  6\n"
+                        "  5 . . . . . . . . . . . . . . . . . . .  5\n"
+                        "  4 . . . + . . . . . + . . . . . + . . .  4\n"
+                        "  3 . . . . . . . . . . . . . . . . . . .  3\n"
+                        "  2 . . . . . . . . . . . . . . . . . . .  2\n"
+                        "  1 . . . . . . . . . . . . . . . . . . .  1\n"
+                        "    A B C D E F G H J K L M N O P Q R S T")))
+    (should (string= string (board-to-string board)))))
+
+(ert-deftest sgf-non-empty-board-to-string-test ()
+  (let* ((joseki (read-from-file "sgf-files/3-4-joseki.sgf"))
+         (root (car joseki))
+         (rest (cdr joseki))
+         (board (make-board (aget "S" root)))
+         (string (concat "    A B C D E F G H J K L M N O P Q R S T\n"
+                         " 19 . . . . . . . . . . . . . . . . . . . 19\n"
+                         " 18 . . . . . . . . . . . . . . . . . . . 18\n"
+                         " 17 . . . . . . . . . . . . . . . . . . . 17\n"
+                         " 16 . . . + . . . . . + . . . . . + . . . 16\n"
+                         " 15 . . . . . . . . . . . . . . . . . . . 15\n"
+                         " 14 . . . . . . . . . . . . . . . . . . . 14\n"
+                         " 13 . . . . . . . . . . . . . . . . . . . 13\n"
+                         " 12 . . . . . . . . . . . . . . . . . . . 12\n"
+                         " 11 . . . . . . . . . . . . . . . . . . . 11\n"
+                         " 10 . . X + . . . . . + . . . . . + . . . 10\n"
+                         "  9 . . . . . . . . . . . . . . . . . . .  9\n"
+                         "  8 . . . . . . . . . . . . . . . . . . .  8\n"
+                         "  7 . . . . . . . . . . . . . . . . . . .  7\n"
+                         "  6 . . . . . . . . . . . . . . . . . . .  6\n"
+                         "  5 . . . X . . . . . . . . . . . . . . .  5\n"
+                         "  4 . . X + O . O . . + . . . . . + . . .  4\n"
+                         "  3 . . . X O . . . . . O . . . . . . . .  3\n"
+                         "  2 . . . X . . . . . . . . . . . . . . .  2\n"
+                         "  1 . . . . . . . . . . . . . . . . . . .  1\n"
+                         "    A B C D E F G H J K L M N O P Q R S T")))
+    (dolist (moves rest)
+      (apply-moves board moves))
+    (board-to-string board)
+    (should t)))
+
+(defmacro with-sgf-file (file &rest body)
+  (declare (indent 1))
+  `(let* ((sgf    (read-from-file ,file))
+          (buffer (display-sgf sgf)))
+     (unwind-protect (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 local-board)
+    (should local-sgf)
+    (should local-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))))
+    (should (= 2 (length (neighbors board (length board)))))
+    (should (= 4 (length (neighbors board (/ (length board) 2)))))
+    (should (= 3 (length (neighbors board 1))))))
+
+(ert-deftest sgf-singl-stone-capture ()
+  (flet ((counts () (cons (stones-for local-board :b)
+                          (stones-for local-board :w))))
+    (with-sgf-file "sgf-files/1-capture.sgf"
+      (right 3) (should (tree-equal (counts) '(2 . 0))))))
+
+(ert-deftest sgf-remove-dead-stone-ko ()
+  (flet ((counts () (cons (stones-for local-board :b)
+                          (stones-for local-board :w))))
+    (with-sgf-file "sgf-files/ko.sgf"
+      (should (tree-equal (counts) '(0 . 0))) (right 1)
+      (should (tree-equal (counts) '(1 . 0))) (right 1)
+      (should (tree-equal (counts) '(1 . 1))) (right 1)
+      (should (tree-equal (counts) '(2 . 1))) (right 1)
+      (should (tree-equal (counts) '(2 . 2))) (right 1)
+      (should (tree-equal (counts) '(3 . 2))) (right 1)
+      (should (tree-equal (counts) '(2 . 3))) (right 1)
+      (should (tree-equal (counts) '(3 . 2))) (right 1)
+      (should (tree-equal (counts) '(2 . 3))))))
+
+(ert-deftest sgf-two-stone-capture ()
+  (flet ((counts () (cons (stones-for local-board :b)
+                          (stones-for local-board :w))))
+    (with-sgf-file "sgf-files/2-capture.sgf"
+      (right 8) (should (tree-equal (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)))))
+
+(ert-deftest sgf-paren-matching ()
+  (let ((str "(a (b) [c \\] ) ] d)"))
+    (should (= (closing-paren str) (length str)))
+    (should (= (closing-paren str 3) 6))))
diff --git a/sgf-util.el b/sgf-util.el
new file mode 100644
index 0000000..91f17b3
--- /dev/null
+++ b/sgf-util.el
@@ -0,0 +1,46 @@
+;;; sgf-util.el --- utility functions for sgf-mode
+
+;; Copyright (C) 2012 Eric Schulte <address@hidden>
+
+;; Author: Eric Schulte <address@hidden>
+;; Created: 2012-05-15
+;; Version: 0.1
+;; Keywords: game go sgf
+
+;; 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.
+
+;;; Code:
+(defun aget (key list) (cdr (assoc key list)))
+
+(defun range (a &optional b)
+  (block nil
+    (let (tmp)
+      (unless b
+        (cond ((> a 0) (decf a))
+              ((= a 0) (return nil))
+              ((> 0 a) (incf a)))
+        (setq b a a 0))
+      (if (> a b) (setq tmp a a b b tmp))
+      (let ((res (number-sequence a b)))
+        (if tmp (nreverse res) res)))))
+
+(defun other-color (color)
+  (if (equal color :B) :W :B))
+
+(provide 'sgf-util)
diff --git a/sgf.el b/sgf.el
deleted file mode 100644
index e3a5699..0000000
--- a/sgf.el
+++ /dev/null
@@ -1,699 +0,0 @@
-;;; sgf.el --- Smart Game Format (focused on GO)
-
-;; Copyright (C) 2012 Eric Schulte <address@hidden>
-
-;; Author: Eric Schulte <address@hidden>
-;; Created: 2012-05-15
-;; Version: 0.1
-;; Keywords: game go
-
-;; 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 implements a reader, writer and visualizer for sgf files.
-;; The sgf format is defined at http://www.red-bean.com/sgf/sgf4.html.
-
-;;; Syntax:
-
-;; BNF
-;;
-;; Collection = GameTree { GameTree }
-;; GameTree   = "(" Sequence { GameTree } ")"
-;; Sequence   = Node { Node }
-;; Node       = ";" { Property }
-;; Property   = PropIdent PropValue { PropValue }
-;; PropIdent  = UcLetter { UcLetter }
-;; PropValue  = "[" CValueType "]"
-;; CValueType = (ValueType | Compose)
-;; ValueType  = (None | Number | Real | Double | Color | SimpleText |
-;;             Text | Point  | Move | Stone)
-
-;; Property Value Types
-;;
-;; UcLetter   = "A".."Z"
-;; Digit      = "0".."9"
-;; None       = ""
-;; Number     = [("+"|"-")] Digit { Digit }
-;; Real       = Number ["." Digit { Digit }]
-;; Double     = ("1" | "2")
-;; Color      = ("B" | "W")
-;; SimpleText = { any character (handling see below) }
-;; Text       = { any character (handling see below) }
-;; Point      = game-specific
-;; Move       = game-specific
-;; Stone      = game-specific
-;; Compose    = ValueType ":" ValueType
-
-;;; Comments:
-
-;; - an sgf tree is just a series of nested lists.
-;; - a pointer into the tree marks the current location
-;; - navigation using normal Sexp movement
-;; - games build such trees as they go
-;; - a board is just one interface into such a tree
-
-;;; Notes:
-
-;; Save the board layout associated with each node in the sgf file,
-;; and only make new boards if there is not already a known board
-;; layout for a node.  That way there is no worry about replacing
-;; removed stones when moving backwards in a game.
-
-;;; Code:
-(require 'cl)
-
-
-;;; Utility
-(defun aget (key list) (cdr (assoc key list)))
-
-(defun range (a &optional b)
-  (block nil
-    (let (tmp)
-      (unless b
-        (cond ((> a 0) (decf a))
-              ((= a 0) (return nil))
-              ((> 0 a) (incf a)))
-        (setq b a a 0))
-      (if (> a b) (setq tmp a a b b tmp))
-      (let ((res (number-sequence a b)))
-        (if tmp (nreverse res) res)))))
-
-(defun other-color (color)
-  (if (equal color :b) :w :b))
-
-
-;;; Parsing
-(defmacro parse-many (regexp string &rest body)
-  (declare (indent 2))
-  `(let (res (start 0))
-     (flet ((collect (it) (push it res)))
-       (while (string-match ,regexp ,string start)
-         (setq start (match-end 0))
-         (save-match-data ,@body))
-       (nreverse res))))
-(def-edebug-spec parse-many (regexp string body))
-
-(defvar parse-prop-val-re
-  "[[:space:]\n\r]*\\[\\([^\000]*?[^\\]?\\)\\]")
-
-(defvar parse-prop-re
-  (format "[[:space:]\n\r]*\\([[:alpha:]]+\\(%s\\)+\\)" parse-prop-val-re))
-
-(defvar parse-node-re
-  (format "[[:space:]\n\r]*;\\(\\(%s\\)+\\)" parse-prop-re))
-
-(defvar parse-tree-part-re
-  (format "[[:space:]\n\r]*(\\(%s\\)[[:space:]\n\r]*[()]" parse-node-re))
-
-(defun parse-prop-ident (str)
-  (let ((end (if (and (<= ?A (aref str 1))
-                      (< (aref str 1) ?Z))
-                 2 1)))
-    (values (substring str 0 end)
-            (substring str end))))
-
-(defun parse-prop-vals (str)
-  (parse-many parse-prop-val-re str
-    (collect (match-string 1 str))))
-
-(defun parse-prop (str)
-  (multiple-value-bind (id rest) (parse-prop-ident str)
-    (cons id (parse-prop-vals rest))))
-
-(defun parse-props (str)
-  (parse-many parse-prop-re str
-    (multiple-value-bind (id rest) (parse-prop-ident (match-string 1 str))
-      (collect (cons id (parse-prop-vals rest))))))
-
-(defun parse-nodes (str)
-  (parse-many parse-node-re str
-    (collect (parse-props (match-string 1 str)))))
-
-(defun closing-paren (str &optional index)
-  ;; return index of closing paren watching out for []
-  (save-match-data
-    (let ((paren-open 0) (square-open 0) char last)
-      (loop for n from (or index 0) to (1- (length str))
-         do
-         (setq last char char (aref str n))
-         (cond
-          ((and (= char ?\[) (not (= last ?\\)))  (incf square-open))
-          ((and (= char ?\]) (not (= last ?\\)))  (decf square-open))
-          ((and (= char ?\() (zerop square-open)) (incf paren-open))
-          ((and (= char ?\)) (zerop square-open)) (decf paren-open)))
-         when (zerop paren-open) return (1+ n)))))
-
-(defun parse-trees (str)
-  (let (cont-p)
-    (flet ((my-collect (el) (setq res (append (nreverse el) res))))
-      (parse-many parse-tree-part-re str
-        (let ((m-end (match-end 0)))
-          (setq cont-p (string= "(" (substring str (1- m-end) m-end)))
-          (collect (parse-nodes (match-string 1 str)))
-          (setq start
-                (if cont-p
-                    (let* ((start (1- m-end))
-                           (end (closing-paren str start)))
-                      (unless end (error "sgf: parsing w/o end at %d" start))
-                      (collect (parse-trees (substring str start end)))
-                      (1+ end))
-                  m-end)))))))
-
-(defun read-from-buffer (buffer)
-  (process (parse-trees (with-current-buffer buffer (buffer-string)))))
-
-(defun read-from-file (file)
-  (with-temp-buffer
-    (insert-file-contents-literally file)
-    (read-from-buffer (current-buffer))))
-
-
-;;; Processing
-(defvar sgf-property-alist nil
-  "A-list of property names and the function to interpret their values.")
-
-(defun process (raw)
-  (unless (listp raw) (error "sgf: can't process atomic sgf element."))
-  (if (listp (car raw))
-      (mapcar #'process raw)
-      (let ((func (aget (car raw) sgf-property-alist)))
-        (if func (cons (car raw) (funcall func (cdr raw))) raw))))
-
-(defun process-date (date-args)
-  (parse-time-string
-   (if (> 1 (length date-args))
-       (mapconcat #'number-to-string date-args " ")
-       (car date-args))))
-(add-to-list 'sgf-property-alist (cons "DT" #'process-date))
-
-(defun process-board-size (size-args)
-  (string-to-number (car size-args)))
-(add-to-list 'sgf-property-alist (cons "S" #'process-board-size))
-
-(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))))
-
-(defun process-move (move-args)
-  (list (cons :pos (process-position (car move-args)))))
-(add-to-list 'sgf-property-alist (cons "B" #'process-move))
-(add-to-list 'sgf-property-alist (cons "W" #'process-move))
-
-(defun process-label (label-args)
-  (mapcar (lambda (l-arg)
-            (if (string-match "\\([[:alpha:]]+\\):\\(.*\\)" l-arg)
-                (list
-                 (cons :label (match-string 2 l-arg))
-                 (cons :pos (process-position (match-string 1 l-arg))))
-                (error "sgf: malformed label %S" l-arg)))
-          label-args))
-(add-to-list 'sgf-property-alist (cons "LB" #'process-label))
-(add-to-list 'sgf-property-alist (cons "LW" #'process-label))
-
-
-;;; Visualization
-;; - make buffer to show a board, and notes, etc...
-;; - keep an index into the sgf file
-;; - write functions for building boards from sgf files (forwards and 
backwards)
-;; - sgf movement keys
-
-(defvar local-board nil "Holds the board local to a GO buffer.")
-
-(defvar local-sgf   nil "Holds the sgf data structure local to a GO buffer.")
-
-(defvar local-index nil "Index into the sgf local to a GO buffer.")
-
-(defun make-board (size) (make-vector (* size size) nil))
-
-(defun board-size (board) (round (sqrt (length board))))
-
-(defvar black-piece "X")
-
-(defvar white-piece "O")
-
-(defun board-header (board)
-  (let ((size (board-size board)))
-    (concat "    "
-            (mapconcat (lambda (n)
-                         (let ((char (+ ?A n)))
-                           (when (>= char ?I)
-                             (setq char (+ 1 char)))
-                           (string char)))
-                       (range size) " "))))
-
-(defun pos-to-index (pos size)
-  (+ (car pos) (* (cdr pos) size)))
-
-(defun board-pos-to-string (board pos)
-  (let ((size (board-size board)))
-    (flet ((emph (n)
-             (cond
-               ((= size 19)
-                (or (= 3 n)
-                    (= 4 (- size n))
-                    (= n (/ (- size 1) 2))))
-               ((= size 9)
-                (or (= 2 n)
-                    (= 4 n))))))
-      (let ((val (aref board (pos-to-index pos size))))
-        (cond
-          ((equal val :w) white-piece)
-          ((equal val :b) black-piece)
-          ((and (stringp val) (= 1 (length val)) val))
-          (t  (if (and (emph (car pos)) (emph (cdr pos))) "+" ".")))))))
-
-(defun board-row-to-string (board row)
-  (let* ((size (board-size board))
-         (label (format "%3d" (- size row)))
-         (row-body (mapconcat
-                    (lambda (n)
-                      (board-pos-to-string board (cons row n)))
-                    (range size) " ")))
-    (concat label " " row-body label)))
-
-(defun board-body-to-string (board)
-  (mapconcat (lambda (m) (board-row-to-string board m))
-             (range (board-size board)) "\n"))
-
-(defun board-to-string (board)
-  (let ((header (board-header board))
-        (body (board-body-to-string board)))
-    (mapconcat #'identity (list header body header) "\n")))
-
-(defun board-to-pieces (board)
-  (let (pieces)
-    (dotimes (n (length board) pieces)
-      (let ((val (aref board n)))
-        (when val (push (cons val n) pieces))))))
-
-(defun pieces-to-board (pieces size)
-  (let ((board (make-vector size nil)))
-    (dolist (piece pieces board)
-      (setf (aref board (cdr piece)) (car piece)))))
-
-(defun clean-comment (comment)
-  (let ((replacements '(("\\(" . "(")
-                        ("\\)" . ")")
-                        ("\\[" . "[")
-                        ("\\]" . "]"))))
-    (dolist (pair replacements comment)
-      (setq comment (replace-regexp-in-string
-                     (regexp-quote (car pair)) (cdr pair) comment)))))
-
-(defun update-display ()
-  (unless local-sgf (error "sgf: buffer has not associated sgf data"))
-  (delete-region (point-min) (point-max))
-  (goto-char (point-min))
-  (insert
-   "\n"
-   (board-to-string local-board)
-   "\n\n")
-  (let ((comment (second (assoc "C" (sgf-ref local-sgf local-index)))))
-    (when comment
-      (insert (make-string (+ 6 (* 2 (board-size local-board))) ?=)
-              "\n\n")
-      (insert (clean-comment comment))))
-  (goto-char (point-min)))
-
-(defun display-sgf (game)
-  (let ((buffer (generate-new-buffer "*sgf*")))
-    (with-current-buffer buffer
-      (sgf-mode)
-      (set (make-local-variable 'local-sgf)   game)
-      (set (make-local-variable 'local-index) '(0 1))
-      (let* ((root (sgf-ref local-sgf local-index))
-             (name (format (or (second (assoc "GN" root))
-                               (second (assoc "EV" root)))))
-             (size (aget "S" root)))
-        (unless size
-          (error "sgf: game has no associated size"))
-        (when name (rename-buffer name 'unique))
-        (set (make-local-variable 'local-board) (make-board size))
-        (push (cons :pieces (board-to-pieces local-board))
-              (sgf-ref local-sgf local-index))
-        (update-display)))
-    (pop-to-buffer buffer)))
-
-(defun display-sgf-file (path)
-  (interactive "f")
-  (display-sgf (read-from-file path)))
-
-(defun sgf-ref (sgf index)
-  (let ((part sgf))
-    (while (car index)
-      (setq part (nth (car index) part))
-      (setq index (cdr index)))
-    part))
-
-(defun set-sgf-ref (sgf index new)
-  (eval `(setf ,(reduce (lambda (acc el) (list 'nth el acc))
-                        index :initial-value 'sgf)
-               ',new)))
-
-(defsetf sgf-ref set-sgf-ref)
-
-(defun get-create-pieces ()
-  (if (aget :pieces (sgf-ref local-sgf local-index))
-      (setf local-board (pieces-to-board
-                         (aget :pieces (sgf-ref local-sgf local-index))
-                         (length local-board)))
-    (clear-labels local-board)
-    (apply-moves local-board (sgf-ref local-sgf local-index))
-    (push (cons :pieces (board-to-pieces local-board))
-          (sgf-ref local-sgf local-index))))
-
-(defun up (&optional num)
-  (interactive "p")
-  (prog1 (dotimes (n num n)
-           (unless (sgf-ref local-sgf local-index)
-             (update-display)
-             (error "sgf: no more upwards moves."))
-           (decf (car (last local-index 2)))
-           (setq local-board (pieces-to-board
-                              (aget :pieces (sgf-ref local-sgf local-index))
-                              (length local-board))))
-    (update-display)))
-
-(defun down (&optional num)
-  (interactive "p")
-  (prog1 (dotimes (n num n)
-           (incf (car (last local-index 2)))
-           (setf (car (last local-index)) 0)
-           (unless (sgf-ref local-sgf local-index)
-             (update-display)
-             (error "sgf: no more downwards moves."))
-           (get-create-pieces))
-    (update-display)))
-
-(defun left (&optional num)
-  (interactive "p")
-  (prog1 (dotimes (n num n)
-           (unless (sgf-ref local-sgf local-index)
-             (update-display)
-             (error "sgf: no more backwards moves."))
-           (decf (car (last local-index)))
-           (setq local-board (pieces-to-board
-                              (aget :pieces (sgf-ref local-sgf local-index))
-                              (length local-board))))
-    (update-display)))
-
-(defun right (&optional num)
-  (interactive "p")
-  (prog1 (dotimes (n num n)
-           (incf (car (last local-index)))
-           (unless (sgf-ref local-sgf local-index)
-             (decf (car (last local-index)))
-             (update-display)
-             (error "sgf: no more forward moves."))
-           (get-create-pieces))
-    (update-display)))
-
-
-;;; Board manipulation functions
-(defun move-type (move)
-  (cond
-    ((member (car move) '("B"  "W"))  :move)
-    ((member (car move) '("LB" "LW")) :label)))
-
-(defun apply-moves (board moves)
-  (flet ((bset (val data)
-           (setf (aref board (pos-to-index (aget :pos data)
-                                           (board-size board)))
-                 (cond ((string= "B"  val)  :b)
-                       ((string= "W"  val)  :w)
-                       ((string= "LB" val) (aget :label data))
-                       ((string= "LW" val) (aget :label data))
-                       (t nil)))))
-    (dolist (move moves board)
-      (case (move-type move)
-        (:move
-         (bset (car move) (cdr move))
-         (let ((color (if (string= "B" (car move)) :b :w)))
-           (remove-dead local-board (other-color color))
-           (remove-dead local-board color)))
-        (:label
-         (dolist (data (cdr move)) (bset (car move) data)))))))
-
-(defun clear-labels (board)
-  (dotimes (point (length board))
-    (when (aref board point)
-      (unless (member (aref board point) '(:b :w))
-        (setf (aref board point) nil)))))
-
-(defun stones-for (board color)
-  (let ((count 0))
-    (dotimes (n (length board) count)
-      (when (equal color (aref board n)) (incf count)))))
-
-(defun neighbors (board piece)
-  (let ((size (board-size board))
-        neighbors)
-    (when (not (= (mod piece size) (1- size))) (push (1+ piece) neighbors))
-    (when (not (= (mod piece size) 0))         (push (1- piece) neighbors))
-    (when (< (+ piece size) (length board))    (push (+ piece size) neighbors))
-    (when (> (- piece size) 0)                 (push (- piece size) neighbors))
-    neighbors))
-
-(defun alive-p (board piece &optional already)
-  (let* ((val (aref board piece))
-         (enemy (other-color val))
-         (neighbors (remove-if (lambda (n) (member n already))
-                               (neighbors board piece)))
-         (neighbor-vals (mapcar (lambda (n) (aref board n)) neighbors))
-         (friendly-neighbors (delete nil (map 'list (lambda (n v)
-                                                      (when (equal v val) n))
-                                              neighbors neighbor-vals)))
-         (already (cons piece already)))
-    (or (some (lambda (v) (not (or (equal v enemy) ; touching open space
-                                   (equal v val))))
-              neighbor-vals)
-        (some (lambda (n) (alive-p board n already)) ; touching alive dragon
-              friendly-neighbors))))
-
-(defun remove-dead (board color)
-  ;; must remove one color at a time for ko situations
-  (let (cull)
-    (dotimes (n (length board) board)
-      (when (and (equal (aref board n) color) (not (alive-p board n)))
-        (push n cull)))
-    (dolist (n cull cull) (setf (aref board n) nil))))
-
-
-;;; Display mode
-(defvar sgf-mode-map
-  (let ((map (make-sparse-keymap)))
-    (define-key map (kbd "<right>") 'right)
-    (define-key map (kbd "<left>")  'left)
-    (define-key map (kbd "<up>")    'up)
-    (define-key map (kbd "<down>")  'down)
-    (define-key map (kbd "q") (lambda () (interactive)
-                                (kill-buffer (current-buffer))))
-    map)
-  "Keymap for `sgf-mode'.")
-
-(define-derived-mode sgf-mode nil "SGF"
-  "Major mode for editing text written for viewing SGF files.")
-
-
-;;; Tests
-(require 'ert)
-
-(ert-deftest sgf-parse-prop-tests ()
-  (flet ((should= (a b) (should (tree-equal a b :test #'string=))))
-    (should= (parse-props "B[pq]") '(("B" "pq")))
-    (should= (parse-props "GM[1]") '(("GM" "1")))
-    (should= (parse-props "GM[1]\nB[pq]\tB[pq]")
-             '(("GM" "1") ("B" "pq") ("B" "pq")))
-    (should (= (length (cdar (parse-props "TB[as][bs][cq][cr][ds][ep]")))
-               6))))
-
-(ert-deftest sgf-parse-multiple-small-nodes-test ()
-  (let* ((str ";B[pq];W[dd];B[pc];W[eq];B[cp];W[cm];B[do];W[hq];B[qn];W[cj]")
-         (nodes (parse-nodes str)))
-    (should (= (length nodes) 10))
-    (should (tree-equal (car nodes) '(("B" "pq")) :test #'string=))))
-
-(ert-deftest sgf-parse-one-large-node-test ()
-  (let* ((str ";GM[1]FF[4]
-               SZ[19]
-               GN[GNU Go 3.7.11 load and print]
-               DT[2008-12-14]
-               KM[0.0]HA[0]RU[Japanese]AP[GNU Go:3.7.11]AW[ja][oa]
-               [pa][db][eb]")
-         (node (car (parse-nodes str))))
-    (should (= (length node) 10))
-    (should (= (length (cdar (last node))) 5))))
-
-(ert-deftest sgf-parse-simple-tree ()
-  (let* ((str "(;GM[1]FF[4]
-               SZ[19]
-               GN[GNU Go 3.7.11 load and print]
-               DT[2008-12-14]
-               KM[0.0]HA[0]RU[Japanese]AP[GNU Go:3.7.11]AW[ja][oa]
-               [pa][db][eb])")
-         (tree (parse-trees str)))
-    (should (= 1  (length tree)))
-    (should (= 10 (length (first tree))))))
-
-(ert-deftest sgf-parse-nested-tree ()
-  (let* ((str "(;GM[1]FF[4]
-               SZ[19]
-               GN[GNU Go 3.7.11 load and print]
-               DT[2008-12-14]
-               KM[0.0]HA[0]RU[Japanese]AP[GNU Go:3.7.11]
-               (;AW[ja][oa][pa][db][eb] ;AB[fa][ha][ia][qa][cb]))")
-         (tree (parse-trees str)))
-    (should (= 3 (length tree)))
-    (should (= 9 (length (first tree))))
-    (should (= 6 (length (car (second tree)))))
-    (should (= 6 (length (car (third tree)))))))
-
-(ert-deftest sgf-parse-file-test ()
-  (let ((game (read-from-file "sgf-files/jp-ming-5.sgf")))
-    (should (= 247 (length game)))))
-
-(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"
-                        " 19 . . . . . . . . . . . . . . . . . . . 19\n"
-                        " 18 . . . . . . . . . . . . . . . . . . . 18\n"
-                        " 17 . . . . . . . . . . . . . . . . . . . 17\n"
-                        " 16 . . . + . . . . . + . . . . . + . . . 16\n"
-                        " 15 . . . . . . . . . . . . . . . . . . . 15\n"
-                        " 14 . . . . . . . . . . . . . . . . . . . 14\n"
-                        " 13 . . . . . . . . . . . . . . . . . . . 13\n"
-                        " 12 . . . . . . . . . . . . . . . . . . . 12\n"
-                        " 11 . . . . . . . . . . . . . . . . . . . 11\n"
-                        " 10 . . . + . . . . . + . . . . . + . . . 10\n"
-                        "  9 . . . . . . . . . . . . . . . . . . .  9\n"
-                        "  8 . . . . . . . . . . . . . . . . . . .  8\n"
-                        "  7 . . . . . . . . . . . . . . . . . . .  7\n"
-                        "  6 . . . . . . . . . . . . . . . . . . .  6\n"
-                        "  5 . . . . . . . . . . . . . . . . . . .  5\n"
-                        "  4 . . . + . . . . . + . . . . . + . . .  4\n"
-                        "  3 . . . . . . . . . . . . . . . . . . .  3\n"
-                        "  2 . . . . . . . . . . . . . . . . . . .  2\n"
-                        "  1 . . . . . . . . . . . . . . . . . . .  1\n"
-                        "    A B C D E F G H J K L M N O P Q R S T")))
-    (should (string= string (board-to-string board)))))
-
-(ert-deftest sgf-non-empty-board-to-string-test ()
-  (let* ((joseki (read-from-file "sgf-files/3-4-joseki.sgf"))
-         (root (car joseki))
-         (rest (cdr joseki))
-         (board (make-board (aget "S" root)))
-         (string (concat "    A B C D E F G H J K L M N O P Q R S T\n"
-                         " 19 . . . . . . . . . . . . . . . . . . . 19\n"
-                         " 18 . . . . . . . . . . . . . . . . . . . 18\n"
-                         " 17 . . . . . . . . . . . . . . . . . . . 17\n"
-                         " 16 . . . + . . . . . + . . . . . + . . . 16\n"
-                         " 15 . . . . . . . . . . . . . . . . . . . 15\n"
-                         " 14 . . . . . . . . . . . . . . . . . . . 14\n"
-                         " 13 . . . . . . . . . . . . . . . . . . . 13\n"
-                         " 12 . . . . . . . . . . . . . . . . . . . 12\n"
-                         " 11 . . . . . . . . . . . . . . . . . . . 11\n"
-                         " 10 . . X + . . . . . + . . . . . + . . . 10\n"
-                         "  9 . . . . . . . . . . . . . . . . . . .  9\n"
-                         "  8 . . . . . . . . . . . . . . . . . . .  8\n"
-                         "  7 . . . . . . . . . . . . . . . . . . .  7\n"
-                         "  6 . . . . . . . . . . . . . . . . . . .  6\n"
-                         "  5 . . . X . . . . . . . . . . . . . . .  5\n"
-                         "  4 . . X + O . O . . + . . . . . + . . .  4\n"
-                         "  3 . . . X O . . . . . O . . . . . . . .  3\n"
-                         "  2 . . . X . . . . . . . . . . . . . . .  2\n"
-                         "  1 . . . . . . . . . . . . . . . . . . .  1\n"
-                         "    A B C D E F G H J K L M N O P Q R S T")))
-    (dolist (moves rest)
-      (apply-moves board moves))
-    (board-to-string board)
-    (should t)))
-
-(defmacro with-sgf-file (file &rest body)
-  (declare (indent 1))
-  `(let* ((sgf    (read-from-file ,file))
-          (buffer (display-sgf sgf)))
-     (unwind-protect (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 local-board)
-    (should local-sgf)
-    (should local-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))))
-    (should (= 2 (length (neighbors board (length board)))))
-    (should (= 4 (length (neighbors board (/ (length board) 2)))))
-    (should (= 3 (length (neighbors board 1))))))
-
-(ert-deftest sgf-singl-stone-capture ()
-  (flet ((counts () (cons (stones-for local-board :b)
-                          (stones-for local-board :w))))
-    (with-sgf-file "sgf-files/1-capture.sgf"
-      (right 3) (should (tree-equal (counts) '(2 . 0))))))
-
-(ert-deftest sgf-remove-dead-stone-ko ()
-  (flet ((counts () (cons (stones-for local-board :b)
-                          (stones-for local-board :w))))
-    (with-sgf-file "sgf-files/ko.sgf"
-      (should (tree-equal (counts) '(0 . 0))) (right 1)
-      (should (tree-equal (counts) '(1 . 0))) (right 1)
-      (should (tree-equal (counts) '(1 . 1))) (right 1)
-      (should (tree-equal (counts) '(2 . 1))) (right 1)
-      (should (tree-equal (counts) '(2 . 2))) (right 1)
-      (should (tree-equal (counts) '(3 . 2))) (right 1)
-      (should (tree-equal (counts) '(2 . 3))) (right 1)
-      (should (tree-equal (counts) '(3 . 2))) (right 1)
-      (should (tree-equal (counts) '(2 . 3))))))
-
-(ert-deftest sgf-two-stone-capture ()
-  (flet ((counts () (cons (stones-for local-board :b)
-                          (stones-for local-board :w))))
-    (with-sgf-file "sgf-files/2-capture.sgf"
-      (right 8) (should (tree-equal (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)))))
-
-(ert-deftest sgf-paren-matching ()
-  (let ((str "(a (b) [c \\] ) ] d)"))
-    (should (= (closing-paren str) (length str)))
-    (should (= (closing-paren str 3) 6))))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]