[elpa] 165/255: working on placing backgrounds behind pieces

[Eric Schulte]

eschulte pushed a commit to branch go
in repository elpa.

commit 16ebc506282138f89b42cad34ccace8c60c37a1f
Author: Eric Schulte <address@hidden>
Date:   Tue Jun 5 14:31:35 2012 -0600

    working on placing backgrounds behind pieces
---
 go-board-faces.el |   80 ++++++++++++++++++++++++++++------------------------
 go-board.el       |   45 +++++++++++++++--------------
 2 files changed, 66 insertions(+), 59 deletions(-)

diff --git a/go-board-faces.el b/go-board-faces.el
index 9ab904e..4fd2035 100644
--- a/go-board-faces.el
+++ b/go-board-faces.el
@@ -103,49 +103,55 @@
               ((rect (width . 25) (height . 25) (fill . "#dcb35c")))
               ,@body)))
 
-(defmacro go-board-side (path)
-  `(go-board-image ((path (stroke . "#000") (stroke-width . 1) (d . ,path)))))
-
-(defun go-board-add-image (point image)
-  (let ((ov (make-overlay point (1+ point))))
-    (overlay-put ov 'display image)
-    (push ov go-board-image-overlays)))
-
-(defvar go-board-image-black
-  (go-board-image
-   ((defs)
-    ((radialGradient (id . "$rg") (cx . ".3") (cy . ".3") (r . ".8"))
-     ((stop (offset . 0)   (stop-color . "#777")))
-     ((stop (offset . 0.3) (stop-color . "#222")))
-     ((stop (offset . 1)   (stop-color . "#000")))))
-   ((circle (cx . 12.5) (cy . 12.5) (r . 6.125) (fill . "url(#$rg)")))))
-
-(defvar go-board-image-white
-  (go-board-image
-   ((defs)
-    ((radialGradient (id . "$rg") (cx . ".47") (cy . ".49") (r . ".48"))
-     ((stop (offset . 0.7) (stop-color . "#FFF")))
-     ((stop (offset . 0.9) (stop-color . "#DDD")))
-     ((stop (offset . 1)   (stop-color . "#777")))))
-   ((circle (cx . 12.5) (cy . 12.5) (r . 6.125) (fill . "url(#$rg)")))))
-
-(defvar go-board-image-background
-  (go-board-image
-   ((path (stroke . "#000") (stroke-width . 1) (d . "M0,12.5H25M12.5,0V25")))))
+(defmacro go-board-image-sides (name &rest base)
+  `(progn
+     ,@(mapcar
+        (lambda (p)
+          `(defvar ,(sym-cat 'go-board-image name (car p))
+             (go-board-image
+              ,(when (cdr p)
+                 `((path (stroke . "#000") (stroke-width . 1) (d . ,(cdr p)))))
+              ,@base)))
+        '((left         . "M12,12.5H25M12.5,0V25")
+          (right        . "M0,12.5H13M12.5,0V25")
+          (top          . "M0,12.5H25M12.5,12V25")
+          (bottom       . "M0,12.5H25M12.5,0V12.5")
+          (top-left     . "M12,12.5H25M12.5,12V25")
+          (top-right    . "M0,12.5H13M12.5,12V25")
+          (bottom-left  . "M12,12.5H25M12.5,0V13")
+          (bottom-right . "M0,12.5H13M12.5,0V13")
+          (nil          . "M0,12.5H25M12.5,0V25")))))
 
 (defvar go-board-image-hoshi
   (go-board-image
    ((path (stroke . "#000") (stroke-width . 1) (d . "M0,12.5H25M12.5,0V25")))
    ((circle (cx . 12.5) (cy . 12.5) (r . 2.5)))))
 
-(defvar go-board-image-left         (go-board-side "M12,12.5H25M12.5,0V25"))
-(defvar go-board-image-right        (go-board-side "M0,12.5H13M12.5,0V25"))
-(defvar go-board-image-top          (go-board-side "M0,12.5H25M12.5,12V25"))
-(defvar go-board-image-bottom       (go-board-side "M0,12.5H25M12.5,0V12.5"))
-(defvar go-board-image-top-left     (go-board-side "M12,12.5H25M12.5,12V25"))
-(defvar go-board-image-top-right    (go-board-side "M0,12.5H13M12.5,12V25"))
-(defvar go-board-image-bottom-left  (go-board-side "M12,12.5H25M12.5,0V13"))
-(defvar go-board-image-bottom-right (go-board-side "M0,12.5H13M12.5,0V13"))
+(defvar go-board-image-black-svg
+  '(((defs)
+     ((radialGradient (id . "$rg") (cx . ".3") (cy . ".3") (r . ".8"))
+      ((stop (offset . 0)   (stop-color . "#777")))
+      ((stop (offset . 0.3) (stop-color . "#222")))
+      ((stop (offset . 1)   (stop-color . "#000")))))
+    ((circle (cx . 12.5) (cy . 12.5) (r . 6.125) (fill . "url(#$rg)")))))
+
+(defvar go-board-image-white-svg
+  '(((defs)
+     ((radialGradient (id . "$rg") (cx . ".47") (cy . ".49") (r . ".48"))
+      ((stop (offset . 0.7) (stop-color . "#FFF")))
+      ((stop (offset . 0.9) (stop-color . "#DDD")))
+      ((stop (offset . 1)   (stop-color . "#777")))))
+    ((circle (cx . 12.5) (cy . 12.5) (r . 6.125) (fill . "url(#$rg)")))))
+
+(defvar go-board-image-black
+  (eval (cons 'go-board-image go-board-image-black-svg)))
+
+(defvar go-board-image-white
+  (eval (cons 'go-board-image go-board-image-white-svg)))
+
+(go-board-image-sides background)
+(eval `(go-board-image-sides black ,@go-board-image-black-svg))
+(eval `(go-board-image-sides white ,@go-board-image-white-svg))
 
 (defmacro go-board-image-label (label)
   `(go-board-image
diff --git a/go-board.el b/go-board.el
index 5213f7a..3b60680 100644
--- a/go-board.el
+++ b/go-board.el
@@ -216,17 +216,18 @@
         (body   (board-body-to-string board)))
     (mapconcat #'identity (list header body header) "\n")))
 
+(defun sym-cat (&rest syms)
+  (intern (mapconcat #'symbol-name (delq nil syms) "-")))
+
 (defun go-board-paint (&optional start end)
   (interactive "r")
-  (flet ((ov (point face)
+  (flet ((ov (point face &optional back)
              (let ((ovly (make-overlay point (1+ point))))
                (overlay-put ovly 'go-pt point)
-               (overlay-put ovly 'face (intern (concat "go-board-"
-                                                           (symbol-name 
face))))
+               (overlay-put ovly 'face (sym-cat 'go-board face))
                (when go-board-use-images
                  (overlay-put ovly 'display
-                              (eval (intern (concat "go-board-image-"
-                                                    (symbol-name face))))))
+                              (eval (sym-cat 'go-board 'image face back))))
                (push ovly go-board-overlays)))
          (hide (point)
                (let ((ovly (make-overlay point (1+ point))))
@@ -235,23 +236,23 @@
     (let ((start (or start (point-min)))
           (end   (or end   (point-max))))
       (dolist (point (range start end))
-        (case (car (get-text-property point :type))
-          (:hoshi        (ov point 'hoshi))
-          (:white        (ov point 'white))
-          (:black        (ov point 'black))
-          (:background  (if go-board-use-images
-                            (hide point)
-                          (ov point 'background)))
-          (:background-1 (ov point (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)
-                                     (t   'background)))))))))
+        (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))))
+          (case (car (get-text-property point :type))
+            (: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 update-display (buffer)
   (with-current-buffer buffer