eschulte pushed a commit to branch go
in repository elpa.
commit 17b998e237a75594d5fe6ed969a49be8a24c9674
Author: Eric Schulte <eric.schu...@gmx.com>
Date: Tue May 22 22:10:32 2012 -0400
more transition
---
sgf-board.el | 106 +++++++++++++++++++++++-----------------------------------
sgf-tests.el | 7 ++--
2 files changed, 46 insertions(+), 67 deletions(-)
diff --git a/sgf-board.el b/sgf-board.el
index 0bb1f13..7cdb913 100644
--- a/sgf-board.el
+++ b/sgf-board.el
@@ -29,9 +29,9 @@
(require 'sgf-util)
(require 'sgf-trans)
-(defvar *board* nil "Holds the board local to a GO buffer.")
+(defvar *history* nil "Holds the board history for a GO buffer.")
-(defvar *backends* nil "Holds the back-ends connected to a board.")
+(defvar *back-ends* nil "Holds the back-ends connected to a board.")
(defvar black-piece "X")
@@ -56,22 +56,22 @@
(defun apply-moves (board moves)
(flet ((bset (val data)
- (let ((data (if (listp (car data)) data (list data))))
- (setf (aref board (pos-to-index (aget data :pos)
- (board-size board)))
- (case val
- (:B :B)
- (:W :W)
- (:LB (aget data :label))
- (:LW (aget data :label))
- (t nil))))))
+ (let ((data (if (listp (car data)) data (list data))))
+ (setf (aref board (pos-to-index (aget data :pos)
+ (board-size board)))
+ (case val
+ (:B :B)
+ (:W :W)
+ (:LB (aget data :label))
+ (:LW (aget data :label))
+ (t nil))))))
(dolist (move moves board)
(case (move-type move)
(:move
(bset (car move) (cdr move))
(let ((color (if (equal :B (car move)) :B :W)))
- (remove-dead *board* (other-color color))
- (remove-dead *board* color)))
+ (remove-dead board (other-color color))
+ (remove-dead board color)))
(:label
(dolist (data (cdr move)) (bset (car move) data)))))))
@@ -119,6 +119,17 @@
(push n cull)))
(dolist (n cull cull) (setf (aref board n) nil))))
+(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)))))
+
;;; Visualization
(defun board-header (board)
@@ -167,63 +178,30 @@
(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 get-create-pieces ()
- (let ((pieces (aget (sgf-ref *sgf* *index*) :pieces)))
- (if pieces
- (when (listp pieces) pieces)
- (clear-labels *board*)
- (apply-moves *board* (sgf-ref *sgf* *index*))
- (setq pieces (board-to-pieces *board*))
- (push (cons :pieces pieces) (sgf-ref *sgf* *index*))
- pieces)))
-
(defun update-display ()
- (unless *sgf* (error "sgf: buffer has not associated sgf data"))
(delete-region (point-min) (point-max))
(goto-char (point-min))
- (setq *board* (pieces-to-board (get-create-pieces) (length *board*)))
(insert
"\n"
- (board-to-string *board*)
+ (board-to-string (car *history*))
"\n\n")
- (let ((comment (aget (sgf-ref *sgf* *index*) :C)))
+ (let ((comment (sgf<-comment (car *back-ends*))))
(when comment
- (insert (make-string (+ 6 (* 2 (board-size *board*))) ?=)
- "\n\n")
- (insert comment)))
+ (insert
+ (make-string (+ 6 (* 2 (board-size (car *history*)))) ?=)
+ "\n\n"
+ comment)))
(goto-char (point-min)))
-(defun display (game)
- (let ((buffer (generate-new-buffer "*sgf*")))
+(defun sgf-board-display (back-end)
+ (let ((buffer (generate-new-buffer "*GO*")))
(with-current-buffer buffer
- (sgf-mode)
- (set (make-local-variable '*sgf*) game)
- (set (make-local-variable '*index*) '(0))
- ;; TODO: this shouldn't be required
- (unless (tree-equal *index* '(0))
- (setq *index* '(0))
- (setf (car *index*) 0))
- (let* ((root (sgf-ref *sgf* *index*))
- (name (or (aget root :GN)
- (aget root :EV)))
- (size (or (aget root :S) (aget root :SZ)
- (unless (tree-equal *index* '(0))
- (error "sgf: bad index %S" *index*))
- (error "sgf: game has no associated size"))))
- (when name (rename-buffer name 'unique))
- (set (make-local-variable '*board*) (make-board size))
- (update-display)))
+ (set (make-local-variable '*back-ends*) (list back-end))
+ (set (make-local-variable '*history*) nil)
+ (push (make-board (sgf<-size back-end)) *history*)
+ (sgf-board-mode))
+ (when (sgf<-name back-end)
+ (rename-buffer (sgf<-name back-end) 'unique))
(pop-to-buffer buffer)))
@@ -245,7 +223,7 @@
(defun sgf-board-act-move (&optional pos)
(interactive)
(unless pos
- (let ((size (if *board* (board-size *board*) 19)))
+ (let ((size (board-size (car *history*))))
(setq pos
(cons
(char-to-num
@@ -275,7 +253,7 @@
;;; Display mode
-(defvar sgf-mode-map
+(defvar sgf-board-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "<right>") 'right)
(define-key map (kbd "<left>") 'left)
@@ -284,9 +262,9 @@
(define-key map (kbd "q") (lambda () (interactive)
(kill-buffer (current-buffer))))
map)
- "Keymap for `sgf-mode'.")
+ "Keymap for `sgf-board-mode'.")
-(define-derived-mode sgf-mode nil "SGF"
+(define-derived-mode sgf-board-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
index 5e91d69..e3378fc 100644
--- a/sgf-tests.el
+++ b/sgf-tests.el
@@ -149,8 +149,8 @@
(should (= 3 (length (neighbors board 1))))))
(defun stone-counts ()
- (cons (stones-for *board* :B)
- (stones-for *board* :W)))
+ (cons (stones-for (car *history*) :B)
+ (stones-for (car *history*) :W)))
;;; GTP and gnugo tests
@@ -264,7 +264,8 @@
(ert-deftest sgf-display-fresh-sgf-buffer ()
(with-sgf-file "sgf-files/3-4-joseki.sgf"
- (should *board*)))
+ (should *history*)
+ (should *back-ends*)))
(ert-deftest sgf-independent-points-properties ()
(with-sgf-file "sgf-files/3-4-joseki.sgf"
