add support for paths: see glyphs/uk.scm

1 files changed, 26 insertions, 2 deletions

diff --git a/stickers.scm b/stickers.scm
index 264f3e1..8e8ee10 100644
--- a/stickers.scm
+++ b/stickers.scm
@@ -7,7 +7,7 @@
         (srfi 9)
         (srfi 41))
 
-(define-record-type :glyph
+(define-record-type <glyph>
   (glyph char font size color style)
   glyph?
   (char  glyph-char  glyph-set-char!)
@@ -16,6 +16,13 @@
   (color glyph-color glyph-set-color!)
   (style glyph-style glyph-set-style!))
 
+(define-record-type <path>
+  (path contents size color)
+  path?
+  (contents     path-contents     path-contents!)
+  (size         path-size         path-set-size!)
+  (color        path-color        path-set-color!))
+
 ; Load here the glyphs you need, the only ones that are more or less defined
 ; are the English ones
 (load "glyphs/ru.scm")
@@ -104,6 +111,20 @@ text {
               (dominant-baseline central))
            ,(glyph-char glyph))))
 
+(define (path-unpositioned path)
+  "Returns a `path` object that is defined to be centered vertically and
+  horizontally  in a `g` wrapped in a procedure that must be called to provide
+  it the center position. It gets a `path` record as an input."
+  (define str number->string)
+  (lambda (cx cy)
+    `(g (@ (x ,cx)
+           (y ,cy)
+           (transform ,(string-append
+                         "translate(" (str cx) " " (str cy) ")"
+                         "scale(" (path-size path) " " (path-size path) ")")))
+      (path (@ (d ,(path-contents path))
+               (style ,(string-append "; fill: " (path-color path))))))))
+
 
 (define stickers
   (let ((pos (honeycomb sticker-radius '(0 . 0) page-size 1)))
@@ -125,7 +146,10 @@ text {
             "cuts")
           (contents (x position) (y position)))))
 
-    (map text-unpositioned glyphs))))
+    (map (lambda (el)
+           (cond ((glyph? el)  (text-unpositioned el))
+                 ((path? el)   (path-unpositioned el))))
+         glyphs))))
 
 
 (define cuts     (map car stickers))