eschulte pushed a commit to branch go
in repository elpa.
commit 12729371d0690760f6bef5584b763473d5ffdfe6
Author: Eric Schulte <[email protected]>
Date: Tue Jun 5 10:26:41 2012 -0600
moving towards using images
But having more weird display problems in which Emacs wants to collapse
contiguous identical overlays.
---
go-board-faces.el | 5 +----
go-board.el | 25 ++++++++++++++++++++-----
go-tests.el | 1 +
3 files changed, 22 insertions(+), 9 deletions(-)
diff --git a/go-board-faces.el b/go-board-faces.el
index f3c70a6..9ab904e 100644
--- a/go-board-faces.el
+++ b/go-board-faces.el
@@ -76,9 +76,6 @@
;;; Images
-(defvar go-board-image-overlays nil
- "List of overlays carrying the images of points on a GO board.")
-
(defun go-board-svg-trans (list)
(if (and (listp list) (listp (car list)))
(concat (format "<%s%s" (caar list) (if (cdar list) " " ""))
@@ -132,7 +129,7 @@
((stop (offset . 1) (stop-color . "#777")))))
((circle (cx . 12.5) (cy . 12.5) (r . 6.125) (fill . "url(#$rg)")))))
-(defvar go-board-image-back
+(defvar go-board-image-background
(go-board-image
((path (stroke . "#000") (stroke-width . 1) (d . "M0,12.5H25M12.5,0V25")))))
diff --git a/go-board.el b/go-board.el
index a36884a..4a19094 100644
--- a/go-board.el
+++ b/go-board.el
@@ -41,6 +41,10 @@
(defvar black-piece "X")
(defvar white-piece "O")
+(defvar go-board-use-images nil)
+(defvar *go-board-overlays* nil
+ "List of overlays carrying GO board painting information.")
+
;;; Board manipulation functions
(defun make-board (size) (make-vector (* size size) nil))
@@ -203,15 +207,23 @@
(defun go-board-paint (&optional start end)
(interactive "r")
(flet ((ov (point face)
- (overlay-put (make-overlay point (1+ point)) 'face face)))
+ (let ((ovly (make-overlay point (1+ point))))
+ (overlay-put ovly 'go-pt point)
+ (overlay-put ovly 'face (intern (concat "go-board-"
+ (symbol-name
face))))
+ (when go-board-use-images
+ (overlay-put ovly 'display
+ (eval (intern (concat "go-board-image-"
+ (symbol-name face))))))
+ (push ovly go-board-overlays))))
(let ((start (or start (point-min)))
(end (or end (point-max))))
(dolist (point (range start end))
(case (get-text-property point :type)
- (:background (ov point 'go-board-background))
- (:hoshi (ov point 'go-board-hoshi))
- (:white (ov point 'go-board-white))
- (:black (ov point 'go-board-black)))))))
+ (:background (ov point 'background))
+ (:hoshi (ov point 'hoshi))
+ (:white (ov point 'white))
+ (:black (ov point 'black)))))))
(defun update-display (buffer)
(with-current-buffer buffer
@@ -242,10 +254,13 @@
(set (make-local-variable '*black*) nil)
(set (make-local-variable '*white*) nil)
(set (make-local-variable '*size*) (go-size back-end))
+ (set (make-local-variable '*autoplay*) nil)
+ (set (make-local-variable '*go-board-overlays*) nil)
(mapcar (lambda (tr) (setf (go-size tr) *size*)) trackers)
(set (make-local-variable '*history*)
(list (board-to-pieces (make-board *size*))))
(set (make-local-variable '*trackers*) trackers)
+ (set (make-local-variable '*trackers*) trackers)
(update-display (current-buffer)))
(pop-to-buffer buffer)))
diff --git a/go-tests.el b/go-tests.el
index aa8a23c..dbff230 100644
--- a/go-tests.el
+++ b/go-tests.el
@@ -29,6 +29,7 @@
(require 'ert)
(require 'go)
(require 'go-board)
+(require 'go-board-faces)
(require 'gtp)
(require 'gnugo)
(require 'sgf)
