eschulte pushed a commit to branch go
in repository elpa.
commit 696c58541e342eb008ee6a78ad5b1d8993cbdac0
Author: Eric Schulte <eric.schu...@gmx.com>
Date: Tue May 22 14:35:08 2012 -0400
misc
---
sgf-board.el | 70 ++++++++++++++++++++++++++++++++++------------------------
sgf-util.el | 8 +++++-
sgf2el.el | 26 ++++++++++++---------
3 files changed, 62 insertions(+), 42 deletions(-)
diff --git a/sgf-board.el b/sgf-board.el
index 10d50a4..c5abaa3 100644
--- a/sgf-board.el
+++ b/sgf-board.el
@@ -105,10 +105,32 @@
(dolist (piece pieces board)
(setf (aref board (cdr piece)) (car piece)))))
+(defun sgf-board-options ()
+ (let ((count 0))
+ (mapcar (lambda (alt)
+ (prog1 (if (alistp alt)
+ count
+ (if (alistp (car alt))
+ (list count 0)
+ :other))
+ (incf count)))
+ (sgf-nthcdr *sgf* *index*))))
+
+(defun get-create-pieces ()
+ (let ((pieces (aget (sgf-ref sgf-sgf sgf-index) :pieces)))
+ (if pieces
+ (when (listp pieces) pieces)
+ (clear-labels sgf-board)
+ (apply-moves sgf-board (sgf-ref sgf-sgf sgf-index))
+ (setq pieces (board-to-pieces sgf-board))
+ (push (cons :pieces pieces) (sgf-ref sgf-sgf sgf-index))
+ pieces)))
+
(defun update-display ()
(unless sgf-sgf (error "sgf: buffer has not associated sgf data"))
(delete-region (point-min) (point-max))
(goto-char (point-min))
+ (setq sgf-board (pieces-to-board (get-create-pieces) (length sgf-board)))
(insert
"\n"
(board-to-string sgf-board)
@@ -139,8 +161,6 @@
(error "sgf: game has no associated size"))))
(when name (rename-buffer name 'unique))
(set (make-local-variable 'sgf-board) (make-board size))
- (push (cons :pieces (board-to-pieces sgf-board))
- (sgf-ref sgf-sgf sgf-index))
(update-display)))
(pop-to-buffer buffer)))
@@ -148,65 +168,54 @@
(interactive "f")
(display-sgf (sgf2el-file-to-el path)))
-(defun get-create-pieces ()
- (if (aget (sgf-ref sgf-sgf sgf-index) :pieces)
- (setf sgf-board (pieces-to-board
- (aget (sgf-ref sgf-sgf sgf-index) :pieces)
- (length sgf-board)))
- (clear-labels sgf-board)
- (apply-moves sgf-board (sgf-ref sgf-sgf sgf-index))
- (push (cons :pieces (board-to-pieces sgf-board))
- (sgf-ref sgf-sgf sgf-index))))
-
(defun up (&optional num)
(interactive "p")
(prog1 (dotimes (n num n)
- (unless (sgf-ref sgf-sgf sgf-index)
+ (unless (alistp (sgf-ref sgf-sgf sgf-index))
(update-display)
(error "sgf: no more upwards moves."))
(decf (car (last sgf-index 2)))
- (setq sgf-board (pieces-to-board
- (aget (sgf-ref sgf-sgf sgf-index) :pieces)
- (length sgf-board))))
- (update-display)))
+ (update-display))))
(defun down (&optional num)
(interactive "p")
(prog1 (dotimes (n num n)
(incf (car (last sgf-index 2)))
(setf (car (last sgf-index)) 0)
- (unless (sgf-ref sgf-sgf sgf-index)
+ (unless (alistp (sgf-ref sgf-sgf sgf-index))
(update-display)
(error "sgf: no more downwards moves."))
- (get-create-pieces))
- (update-display)))
+ (update-display))))
(defun left (&optional num)
(interactive "p")
(prog1 (dotimes (n num n)
- (unless (sgf-ref sgf-sgf sgf-index)
+ (unless (alistp (sgf-ref sgf-sgf sgf-index))
(update-display)
(error "sgf: no more backwards moves."))
(decf (car (last sgf-index)))
- (let ((pieces (aget (sgf-ref sgf-sgf sgf-index) :pieces)))
- (setq sgf-board (pieces-to-board
- (if (listp pieces) pieces nil)
- (length sgf-board)))))
- (update-display)))
+ (update-display))))
(defun right (&optional num)
(interactive "p")
(prog1 (dotimes (n num n)
(incf (car (last sgf-index)))
- (unless (sgf-ref sgf-sgf sgf-index)
+ (unless (alistp (sgf-ref sgf-sgf sgf-index))
(decf (car (last sgf-index)))
(update-display)
(error "sgf: no more forward moves."))
- (get-create-pieces))
- (update-display)))
+ (update-display))))
;;; Board manipulation functions
+(defun sgf-nthcdr (sgf index)
+ (let ((part sgf))
+ (while (cdr index)
+ (setq part (nth (car index) part))
+ (setq index (cdr index)))
+ (setq part (nthcdr (car index) part))
+ part))
+
(defun sgf-ref (sgf index)
(let ((part sgf))
(while (car index)
@@ -226,6 +235,9 @@
((member (car move) '(:B :W)) :move)
((member (car move) '(:LB :LW)) :label)))
+(defun other-color (color)
+ (if (equal color :B) :W :B))
+
(defun apply-moves (board moves)
(flet ((bset (val data)
(let ((data (if (listp (car data)) data (list data))))
diff --git a/sgf-util.el b/sgf-util.el
index 5c86295..a77d4cf 100644
--- a/sgf-util.el
+++ b/sgf-util.el
@@ -40,11 +40,15 @@
(let ((res (number-sequence a b)))
(if tmp (nreverse res) res)))))
+(defun take (num list) (subseq list 0 num))
+
(defmacro until (test &rest body)
(declare (indent 1))
`(while (not ,test) ,@body))
-(defun other-color (color)
- (if (equal color :B) :W :B))
+(defun alistp (list)
+ (and (listp list)
+ (listp (car list))
+ (not (listp (caar list)))))
(provide 'sgf-util)
diff --git a/sgf2el.el b/sgf2el.el
index 6fcdfb2..be1c685 100644
--- a/sgf2el.el
+++ b/sgf2el.el
@@ -92,11 +92,6 @@
(when last-node (insert ")")))
(message "parsing DONE")))
-(defmacro sgf2el-set-to-var (var &optional buffer)
- "Assign the value of the board in BUFFER to VAR."
- `(let ((buffer ,(or buffer (current-buffer))))
- (setq ,var (save-excursion (goto-char (point-min)) (read buffer)))))
-
(defun sgf2el-normalize (&optional buffer)
"Cleanup the formatting of the elisp sgf data in BUFFER."
(interactive)
@@ -121,20 +116,29 @@
(emacs-lisp-mode))
(pop-to-buffer buffer)))
-(defun sgf2el-current-buffer-to-el ()
- (sgf2el-region (point-min) (point-max))
- (goto-char (point-min))
- (read (current-buffer)))
+(defun sgf2el-read (&optional buf)
+ (with-current-buffer (or buf (current-buffer))
+ (goto-char (point-min))
+ (read (current-buffer))))
+
+(defun sgf2el-buffer-to-el (&optional bufffer)
+ "Convert the sgf contents of BUFFER to emacs lisp."
+ (interactive "b")
+ (with-current-buffer (or bufffer (current-buffer))
+ (sgf2el-region (point-min) (point-max))
+ (sgf2el-read)))
(defun sgf2el-str-to-el (str)
"Convert a string of sgf into the equivalent Emacs Lisp."
- (with-temp-buffer (insert str) (sgf2el-current-buffer-to-el)))
+ (interactive)
+ (with-temp-buffer (insert str) (sgf2el-buffer-to-el)))
(defun sgf2el-file-to-el (file)
+ "Convert the sgf contents of FILE to emacs lisp."
(interactive "f")
(with-temp-buffer
(insert-file-contents-literally file)
- (sgf2el-current-buffer-to-el)))
+ (sgf2el-buffer-to-el)))
;;; Specific property converters
