eschulte pushed a commit to branch go
in repository elpa.
commit 099a98bba8fe7ec682be9fc7a89118c9f259fd93
Author: Eric Schulte <[email protected]>
Date: Wed May 16 23:49:18 2012 -0400
saving the board configuration with each sgf step
This involves both defining a setf method to set values at the current
point in the sgf file, as well as defining a backing store for board
information which won't change when the board changes.
---
sgf.el | 63 +++++++++++++++++++++++++++++++++++++++++----------------------
1 files changed, 41 insertions(+), 22 deletions(-)
diff --git a/sgf.el b/sgf.el
index 7b0096c..98fd973 100644
--- a/sgf.el
+++ b/sgf.el
@@ -277,6 +277,17 @@
(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 update-display ()
(unless *sgf* (error "sgf: buffer has not associated sgf data"))
(delete-region (point-min) (point-max))
@@ -309,6 +320,8 @@
(setq *sgf* game)
(setq *board* (make-board size))
(setq *index* '(0))
+ (push (cons :pieces (board-to-pieces *board*))
+ (sgf-ref *sgf* *index*))
(update-display))
(pop-to-buffer buffer)))
@@ -319,6 +332,15 @@
(setq index (cdr index)))
part))
+(defun set-sgf-ref (sgf index new)
+ (eval `(setf ,(if (listp index)
+ (reduce (lambda (acc el) (list 'nth el acc))
+ index :initial-value 'sgf)
+ `(nth ,accessor 'sgf))
+ ',new)))
+
+(defsetf sgf-ref set-sgf-ref)
+
(defun up ())
(defun down ())
@@ -329,8 +351,10 @@
(unless (sgf-ref *sgf* *index*)
(update-display)
(error "sgf: no more backwards moves."))
- (revert-moves *board* (sgf-ref *sgf* *index*))
- (decf (car (last *index*))))
+ (decf (car (last *index*)))
+ (setq *board* (pieces-to-board
+ (aget :pieces (sgf-ref *sgf* *index*))
+ (length *board*))))
(update-display)))
(defun right (&optional num)
@@ -341,10 +365,18 @@
(decf (car (last *index*)))
(update-display)
(error "sgf: no more forward moves."))
- (clean-board *board*)
- (apply-moves *board* (sgf-ref *sgf* *index*)))
+ (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*))))
(update-display)))
+(sgf-ref *game* '(0))
+
;;; Board manipulation functions
(defun move-type (move)
@@ -366,24 +398,11 @@
(:move (set (car move) (cdr move)))
(:label (mapcar (lambda (data) (set (car move) data)) (cdr move)))))))
-(defun revert-moves (board moves)
- (flet ((unset (data)
- (setf (aref board (pos-to-index (aget :pos data)
- (board-size board)))
- nil)))
- (dolist (move moves board)
- (case (move-type move)
- (:move (unset (cdr move)))
- (:label (mapcar #'unset (cdr move)))))))
-
-(defun clean-board (board)
- ;; TODO: need to remove dead stones, need a board-wide-check and sweep
- (flet ((alive-p (board point) t))
- (dotimes (point (length board))
- (when (aref board point)
- (unless (and (member (aref board point) '(:b :w))
- (alive-p board point))
- (setf (aref board point) nil))))))
+(defun clear-labels (board)
+ (dotimes (point (length board))
+ (when (aref board point)
+ (unless (member (aref board point) '(:b :w))
+ (setf (aref board point) nil)))))
;;; Display mode
