beginning to translate svg images into elisp

eschulte · Jun 5, 2012 · f4e92f7 · f4e92f7
1 parent b07cfc7
commit f4e92f7
Show file tree

Hide file tree

Showing 2 changed files with 100 additions and 2 deletions.
diff --git a/NOTES b/NOTES
@@ -1,9 +1,13 @@
 # -*- mode:org -*-
 
 * better looking board
-could try to make wider characters or could just use images
+See [[info:elisp#Image%20Descriptors][info:elisp#Image Descriptors]], can just use the text svg data
+directly, no need for files.  Also look at [[info:elisp#Pointer%20Shape][info:elisp#Pointer Shape]]
+for controlling the shape of the map.
 
-For images look at these images (go with wikipedia svg images).
+: '(image :type 'svg :data )
+
+** For images look at these images (go with wikipedia svg images).
 - http://en.wikipedia.org/wiki/File:Go_b.svg
 - http://en.wikipedia.org/wiki/File:Go_w.svg
 - or at ruby go http://rubygo.rubyforge.org/

diff --git a/go-board-faces.el b/go-board-faces.el
@@ -74,4 +74,98 @@
   '((t (:background "#cd9c67" :foreground "white")))
   "white piece on white territory")
 
+
+;;; 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)
+  (concat (format "<%s%s" (caar list) (if (cdar list) " " ""))
+          (mapconcat (lambda (pair) (format "%s=\"%s\"" (car pair) (cdr pair)))
+                     (cdar list) " ")
+          (if (cdr list)
+              (concat ">"
+                      (mapconcat #'go-board-svg-trans (cdr list) " ")
+                      (format "</%s>" (caar list)))
+            "/>")))
+
+(defmacro go-board-wrap (body)
+  (declare (indent 0))
+  `(concat "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"
+           (go-board-svg-trans ',body)))
+
+(defvar go-board-image-black
+  `(image
+    :type svg :ascent center :data
+    ,(go-board-wrap
+       ((svg (xmlns . "http://www.w3.org/2000/svg")
+             (xmlns:xlink . "http://www.w3.org/1999/xlink")
+             (width . 25) (height . 25) (version . 1.0))
+        ((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")))))
+        ((rect (width . 25) (height . 25) (fill . "#dcb35c")))
+        ((circle (cx . 12.5) (cy . 12.5) (r . 6.125) (fill . "url(#$rg)")))))))
+
+(defvar go-board-image-white
+  `(image
+    :type svg :ascent center :data
+    ,(concat
+      "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"
+      "<svg xmlns=\"http://www.w3.org/2000/svg\" "
+      "xmlns:xlink=\"http://www.w3.org/1999/xlink\" "
+      "width=\"25\" height=\"25\" version=\"1.0\">"
+      "<defs><radialGradient id=\"$rg\" cx=\".47\" cy=\".49\" r=\".48\">"
+      " <stop offset=\".7\" stop-color=\"#FFF\"/>"
+      " <stop offset=\".9\" stop-color=\"#DDD\"/>"
+      " <stop offset=\"1\" stop-color=\"#777\"/>"
+      "</radialGradient></defs>"
+      "<rect width=\"25\" height=\"25\" fill=\"#dcb35c\"/>"
+      "<circle cx=\"12.5\" cy=\"12.5\" r=\"6.125\" fill=\"url(#$rg)\"/>"
+      "</svg>")))
+
+(defvar go-board-image-back
+  `(image
+    :type svg :ascent center :data
+    ,(concat
+      "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"
+      "<svg xmlns=\"http://www.w3.org/2000/svg\" "
+      "width=\"25\" height=\"25\">"
+      "<rect width=\"25\" height=\"25\" fill=\"#DCB35C\"/>"
+      "<path stroke=\"#000\" stroke-width=\"1\" "
+      "d=\"M0,12.5H25M12.5,0V25\"/>"
+      "</svg>")))
+
+(defvar go-board-image-hoshi
+  `(image
+    :type svg :ascent center :data
+    ,(concat
+      "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"
+      "<svg xmlns=\"http://www.w3.org/2000/svg\" "
+      "width=\"25\" height=\"25\">"
+      "<rect width=\"25\" height=\"25\" fill=\"#DCB35C\"/>"
+      "<path stroke=\"#000\" stroke-width=\"1\" "
+      "d=\"M0,12.5H25M12.5,0V25\"/>"
+      "<circle cx=\"12.5\" cy=\"12.5\" r=\"2.5\"/>"
+      "</svg>")))
+
+(defvar go-board-image-left
+  `(image
+    :type svg :ascent center :data
+    ,(concat
+      "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"
+      "<svg xmlns=\"http://www.w3.org/2000/svg\" "
+      "width=\"25\" height=\"25\">"
+      "<rect width=\"25\" height=\"25\" fill=\"#DCB35C\"/>"
+      "<path stroke=\"#000\" stroke-width=\"1\" "
+      "d=\"M12,12.5H25M12.5,0V25\"/>"
+      "</svg>")))
+
+(defun go-board-image (point image)
+  (let ((ov (make-overlay point (1+ point))))
+    (overlay-put ov 'display image)
+    (push ov go-board-image-overlays)))
+
 (provide 'go-board-faces)