From 85318a2169009f09c3f4de2ceebfaa6ac61e1241 Mon Sep 17 00:00:00 2001 From: Ekaitz Zarraga Date: Sat, 5 Oct 2024 13:55:10 +0200 Subject: add support for paths: see glyphs/uk.scm --- stickers.scm | 28 ++++++++++++++++++++++++++-- 1 file 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 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 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)) -- cgit v1.2.3