[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] 179/255: track and display prisoners
From: |
Eric Schulte |
Subject: |
[elpa] 179/255: track and display prisoners |
Date: |
Sun, 16 Mar 2014 01:02:44 +0000 |
eschulte pushed a commit to branch go
in repository elpa.
commit 690068aaec0596e3ba3dae5388c609ea57cc101a
Author: Eric Schulte <address@hidden>
Date: Sun Jun 10 18:46:39 2012 -0600
track and display prisoners
---
back-ends/gnugo.el | 6 +++
go-api.el | 2 +
go-board.el | 107 ++++++++++++++++++++++++++++++++--------------------
3 files changed, 74 insertions(+), 41 deletions(-)
diff --git a/back-ends/gnugo.el b/back-ends/gnugo.el
index 7cea52d..dd1a676 100644
--- a/back-ends/gnugo.el
+++ b/back-ends/gnugo.el
@@ -90,4 +90,10 @@
(defmethod gtp-command ((gnugo gnugo) command)
(gnugo-command-to-string gnugo command))
+(defmethod go-player-name ((gnugo gnugo) color)
+ "GNU GO")
+
+(defmethod set-player-name ((gnugo gnugo) color name)
+ (signal 'unsupported-back-end-command (list gnugo :set-player-name name)))
+
(provide 'gnugo)
diff --git a/go-api.el b/go-api.el
index 4f213c8..6238fb1 100644
--- a/go-api.el
+++ b/go-api.el
@@ -64,6 +64,8 @@
(defgeneric-w-setf go-color "Access current BACK-END turn color.")
(defgeneric-w-setf go-player-name "Access current BACK-END player name.")
(defgeneric-w-setf go-player-time "Access current BACK-END player time.")
+(defgeneric-w-setf
+ go-player-prisoners "Access current BACK-END player prisoners.")
;; sending messages to the back-end
(defgeneric go-undo (back-end) "Send undo to BACK-END.")
diff --git a/go-board.el b/go-board.el
index dca6173..8c784b6 100644
--- a/go-board.el
+++ b/go-board.el
@@ -32,8 +32,8 @@
(defvar *history* nil "Holds the board history for a GO buffer.")
(defvar *size* nil "Holds the board size.")
(defvar *turn* nil "Holds the color of the current turn.")
-(defvar *black* nil "Holds info on black player.")
-(defvar *white* nil "Holds info on white player.")
+(defvar *black* nil "Plist of info on black player.")
+(defvar *white* nil "Plist of info on white player.")
(defvar *back-end* nil "Holds the primary back-end connected to a board.")
(defvar *trackers* nil "Holds a list of back-ends which should track the
game.")
(defvar *autoplay* nil "Should `*back-end*' automatically respond to moves.")
@@ -57,6 +57,15 @@
(defun board-size (board) (round (sqrt (length board))))
+(defun go-player-get (color property)
+ (plist-get (case color (:W *white*) (:B *black*)) property))
+
+(defun go-player-set (color property value)
+ (let ((player (case color (:W *white*) (:B *black*))))
+ (plist-put player property value)))
+
+(defsetf go-player-get go-player-set)
+
(defun move-type (move)
(cond
((member (car move) '(:B :W)) :move)
@@ -137,6 +146,7 @@
(dotimes (n (length board) board)
(when (and (equal (aref board n) color) (not (alive-p board n)))
(push n cull)))
+ (incf (go-player-get (other-color color) :prisoners) (length cull))
(dolist (n cull cull) (setf (aref board n) nil))))
(defun board-to-pieces (board)
@@ -173,9 +183,12 @@
(or (= 3 n)
(= 4 (- size n))
(= n (/ (- size 1) 2))))
+ ((= size 13)
+ (or (= 3 n)
+ (= 9 n)))
((= size 9)
(or (= 2 n)
- (= 4 n)))))
+ (= 6 n)))))
(put (str prop val) (put-text-property 0 (length str) prop val
str)))
(let* ((val (aref board (pos-to-index pos size)))
(str (cond
@@ -245,26 +258,35 @@
(let ((start (or start (point-min)))
(end (or end (point-max))))
(dolist (point (range start end))
- (let ((back (case (cdr (get-text-property point :type))
- (:tl 'top-left)
- (:tr 'top-right)
- (:bl 'bottom-left)
- (:br 'bottom-right)
- (:t 'top)
- (:b 'bottom)
- (:l 'left)
- (:r 'right)
- (:offboard 'offboard))))
- (case (car (get-text-property point :type))
- (:header nil)
- (:filler (ov point 'filler back))
- (:hoshi (ov point 'hoshi))
- (:white (ov point 'white back))
- (:black (ov point 'black back))
- (:background (if go-board-use-images
- (hide point)
- (ov point 'background)))
- (:background-1 (ov point 'background back))))))))
+ (if (get-text-property point :turn)
+ (font-lock-prepend-text-property point (1+ point) 'face 'underline)
+ (let ((back (case (cdr (get-text-property point :type))
+ (:tl 'top-left)
+ (:tr 'top-right)
+ (:bl 'bottom-left)
+ (:br 'bottom-right)
+ (:t 'top)
+ (:b 'bottom)
+ (:l 'left)
+ (:r 'right)
+ (:offboard 'offboard))))
+ (case (car (get-text-property point :type))
+ (:header nil)
+ (:filler (ov point 'filler back))
+ (:hoshi (ov point 'hoshi))
+ (:white (ov point 'white back))
+ (:black (ov point 'black back))
+ (:background (if go-board-use-images
+ (hide point)
+ (ov point 'background)))
+ (:background-1 (ov point 'background back)))))))))
+
+(defun player-to-string (color)
+ (format "%10s: %3d"
+ (let ((name (go-player-get color :name)))
+ (put-text-property 0 (length name) :turn (equal *turn* color) name)
+ name)
+ (go-player-get color :prisoners)))
(defun update-display (buffer)
(with-current-buffer buffer
@@ -272,8 +294,9 @@
(delete-region (point-min) (point-max))
(insert "\n"
(board-to-string
- (pieces-to-board (car *history*) *size*))
- "\n\n")
+ (pieces-to-board (car *history*) *size*)) "\n\n"
+ (player-to-string :W) "\n"
+ (player-to-string :B) "\n")
(let ((comment (ignoring-unsupported (go-comment *back-end*))))
(when comment
(insert (make-string (+ 6 (* 2 *size*)) ?=)
@@ -292,8 +315,8 @@
(mapcar (lambda (tr) (setf (go-name tr) name)) trackers)))
(set (make-local-variable '*back-end*) back-end)
(set (make-local-variable '*turn*) :B)
- (set (make-local-variable '*black*) nil)
- (set (make-local-variable '*white*) nil)
+ (set (make-local-variable '*black*) '(:name "black" :prisoners 0))
+ (set (make-local-variable '*white*) '(:name "white" :prisoners 0))
(set (make-local-variable '*size*) (go-size back-end))
(set (make-local-variable '*autoplay*) nil)
(set (make-local-variable '*go-board-overlays*) nil)
@@ -351,8 +374,8 @@
(move (cons *turn* (cons :pos pos))))
(with-backends back
(setf (go-move back) move))
- (apply-turn-to-board (list move))
- (setf *turn* (other-color *turn*)))
+ (setf *turn* (other-color *turn*))
+ (apply-turn-to-board (list move)))
(when *autoplay* (go-board-next)))
(defun go-board-resign ()
@@ -382,11 +405,11 @@
(let ((move (go-move *back-end*)))
(if (equal move :pass)
(message "pass")
+ (setf *turn* (other-color *turn*))
(apply-turn-to-board
(cons move (ignoring-unsupported (go-labels *back-end*)))))
(with-trackers tr (setf (go-move tr) move))
- (goto-char (point-of-pos (cddr move))))
- (setf *turn* (other-color *turn*))))
+ (goto-char (point-of-pos (cddr move))))))
(defun go-board-mouse-move (ev)
(interactive "e")
@@ -443,10 +466,10 @@
(defmethod set-go-move ((board board) move)
(with-board board
+ (setf *turn* (other-color *turn*))
(apply-turn-to-board (list move))
(goto-char (point-of-pos (cddr move)))
- (with-trackers tr (setf (go-move tr) move))
- (setf *turn* (other-color *turn*))))
+ (with-trackers tr (setf (go-move tr) move))))
(defmethod go-labels ((board board))
(signal 'unsupported-back-end-command (list board :labels)))
@@ -473,20 +496,22 @@
(with-board board (setq *turn* color)))
(defmethod go-player-name ((board board) color)
- (with-board board (car (case color (:W *white*) (:B *black*)))))
+ (with-board board (go-player-get color :name)))
(defmethod set-go-player-name ((board board) color name)
- (with-board board
- (let ((player (case color (:W *white*) (:B *black*))))
- (setf (car player) name))))
+ (with-board board (go-player-set color :name name)))
(defmethod go-player-time ((board board) color)
- (with-board board (cdr (case color (:W *white*) (:B *black*)))))
+ (with-board board (go-player-get color :time)))
(defmethod set-go-player-time ((board board) color time)
- (with-board board
- (let ((player (case color (:W *white*) (:B *black*))))
- (setf (cdr player) time))))
+ (with-board board (go-player-set color :time time)))
+
+(defmethod go-player-prisoners ((board board) color)
+ (with-board board (go-player-get color :prisoners)))
+
+(defmethod set-go-player-prisoners ((board board) color prisoners)
+ (with-board board (go-player-set color :prisoners prisoners)))
;; non setf'able generic functions
(defmethod go-undo ((board board))
- [elpa] 170/255: fix spacing of labels when using image for display, (continued)
- [elpa] 170/255: fix spacing of labels when using image for display, Eric Schulte, 2014/03/15
- [elpa] 174/255: quit the main back-end as well, Eric Schulte, 2014/03/15
- [elpa] 160/255: removing stones/ directory, Eric Schulte, 2014/03/15
- [elpa] 175/255: support for playing different types of games, Eric Schulte, 2014/03/15
- [elpa] 157/255: images of stones, Eric Schulte, 2014/03/15
- [elpa] 177/255: future tasks, Eric Schulte, 2014/03/15
- [elpa] 182/255: reverse order of sizes, Eric Schulte, 2014/03/15
- [elpa] 172/255: re-organized how files are loaded, Eric Schulte, 2014/03/15
- [elpa] 156/255: chunking responses from IGS server into full lines, Eric Schulte, 2014/03/15
- [elpa] 183/255: explicit connection method for back-end objects, Eric Schulte, 2014/03/15
- [elpa] 179/255: track and display prisoners,
Eric Schulte <=
- [elpa] 184/255: safer and automatic quitting, Eric Schulte, 2014/03/15
- [elpa] 186/255: better interactive debugging, Eric Schulte, 2014/03/15
- [elpa] 191/255: don't throw error when backend passes, Eric Schulte, 2014/03/15
- [elpa] 185/255: remove dependencies on org-mode functions, Eric Schulte, 2014/03/15
- [elpa] 176/255: task managment, Eric Schulte, 2014/03/15
- [elpa] 178/255: process igs "tell" messages, Eric Schulte, 2014/03/15
- [elpa] 181/255: NOTES #+option, Eric Schulte, 2014/03/15
- [elpa] 193/255: calculate the final score, Eric Schulte, 2014/03/15
- [elpa] 194/255: notes on scaling image sizes, Eric Schulte, 2014/03/15
- [elpa] 198/255: don't mutate hidden state, Eric Schulte, 2014/03/15