eschulte pushed a commit to branch go
in repository elpa.
commit 92ee7adbaaca124b5862e7ec16ccd1fcf948cafd
Author: Eric Schulte <eric.schu...@gmx.com>
Date: Tue May 22 21:26:55 2012 -0400
organization
---
sgf-board.el | 166 +++++++++++++++++++++++++++++-----------------------------
1 files changed, 83 insertions(+), 83 deletions(-)
diff --git a/sgf-board.el b/sgf-board.el
index bebb3a6..0bb1f13 100644
--- a/sgf-board.el
+++ b/sgf-board.el
@@ -27,7 +27,7 @@
;;; Code:
(require 'sgf-util)
-(require 'sgf2el)
+(require 'sgf-trans)
(defvar *board* nil "Holds the board local to a GO buffer.")
@@ -38,6 +38,88 @@
(defvar white-piece "O")
+;;; Board manipulation functions
+(defun make-board (size) (make-vector (* size size) nil))
+
+(defun board-size (board) (round (sqrt (length board))))
+
+(defun pos-to-index (pos size)
+ (+ (car pos) (* (cdr pos) size)))
+
+(defun move-type (move)
+ (cond
+ ((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))))
+ (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)))
+ (: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))))
+
+
;;; Visualization
(defun board-header (board)
(let ((size (board-size board)))
@@ -145,88 +227,6 @@
(pop-to-buffer buffer)))
-;;; Board manipulation functions
-(defun make-board (size) (make-vector (* size size) nil))
-
-(defun board-size (board) (round (sqrt (length board))))
-
-(defun pos-to-index (pos size)
- (+ (car pos) (* (cdr pos) size)))
-
-(defun move-type (move)
- (cond
- ((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))))
- (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)))
- (: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))))
-
-
;;; User input
(defvar sgf-board-actions '(move resign undo comment)
"List of actions which may be taken on an SGF board.")
