diff options
| -rw-r--r-- | glyphs/en.scm | 16 | ||||
| -rw-r--r-- | glyphs/es.scm | 2 | ||||
| -rw-r--r-- | stickers.scm | 185 |
3 files changed, 203 insertions, 0 deletions
diff --git a/glyphs/en.scm b/glyphs/en.scm new file mode 100644 index 0000000..c84dc2c --- /dev/null +++ b/glyphs/en.scm @@ -0,0 +1,16 @@ +;https://unicode-table.com/en/2B7E/ + +(define letters (string->list "ABCDEFGHIJKLMNOPQRSTUVWXYZ")) +(define numbers (string->list "1234567890")) +(define brackets (string->list "()[]{}<>")) +(define symbols (string->list "+-*\\|@#~$%&^`´\"'")) +(define punct (string->list ",.")) + +(define key-symbols (string->list "⇧⇧⇪⏎⌫←↑→↓⭾")) +(define modifiers '("Ctrl" "Ctrl" "Alt" "AltGr" "Esc" "Del")) + +;(define fn '("Fn")) +(define fn-keys (string->list "")) + +;(define extra-sybols (string->list "☠⌨☭☮☢☣☥⚓")) +(define extra-sybols (string->list "☠⌨⌨☮☢☣☥")) diff --git a/glyphs/es.scm b/glyphs/es.scm new file mode 100644 index 0000000..5879908 --- /dev/null +++ b/glyphs/es.scm @@ -0,0 +1,2 @@ +(define letters (string->list "ABCDEFGHIJKLMNÑOPQRSTUVWXYZ")) +(define numbers (string->list "1234567890")) diff --git a/stickers.scm b/stickers.scm new file mode 100644 index 0000000..b6ba13f --- /dev/null +++ b/stickers.scm @@ -0,0 +1,185 @@ +(import (scheme char) + (chibi) + (chibi string) + (chibi sxml) + (srfi 1) + (srfi 41)) + +(load "glyphs/en.scm") + +(define a4-size '(297 . 210)) +(define a5-size '(210 . 148)) +(define a6-size '(148 . 105)) +(define a7-size '(105 . 74)) + +(define page-size a7-size) + +(define x car) +(define y cdr) +(define num number->string) +(define (mm i) + (string-append (num i) "mm")) + + +; Move this to a configuration file or something +(define font-size 6) ;mm +(define sticker-radius 4); mm +(define style (string-append +" +text { + /*font-family: 'Unifont';*/ + font-family: 'B612'; + stroke: black; + stroke-width: 0.01; +} +.letter { + font-size: "(num font-size)"; + fill: white; +} +.modifier { + font-style: italic; + font-size: "(num (- font-size 3))"; + fill: white; +} +.cuts { + fill: none; + stroke-width: 0.1; + stroke: grey; +} +.fn-color{ + fill: steelblue; +} +.brackets-color{ + fill: red; +} +.symbol-color{ + fill: lightgreen; +} +")) + + +(define (honeycomb sticker-radius top-left bottom-right spacing) + "Return a function that generates positions for the stickers of size + `sticker-radius` distributed in a box with `top-left` and `bottom-right` + corners with `spacing` between them." + (let* ((current-x (+ spacing sticker-radius (x top-left))) + (current-y (+ spacing sticker-radius (y top-left))) + (first #t)) + (lambda () + (if first + (begin + (set! first #f) + (cons current-x current-y)) + (begin + (set! current-x (+ spacing current-x (* 2 sticker-radius))) + (if (> (+ current-x sticker-radius spacing) + (x bottom-right)) + (begin + (set! current-x (+ spacing sticker-radius (x top-left))) + (set! current-y (+ spacing current-y (* 2 sticker-radius))) + (if (> (+ current-y sticker-radius spacing) + (y bottom-right)) + (error "Too many stickers for the provided space")))) + (cons current-x current-y)))))) + +(define (circle cx cy r class) + `(circle (@ (cx ,cx) + (cy ,cy) + (r ,r) + (class ,class)))) + +(define (rounded-rect cx cy w h r class) + `(rect (@ (x ,(- cx (/ w 2))) + (y ,(- cy (/ h 2))) + (width ,w) + (height ,h) + (rx ,r) + (ry ,r) + (class ,class)))) + +(define (text-unpositioned text class) + "Returns a `text` object that is defined to be centered vertically and + horizontally wrapped in a procedure that must be called to provide it the + center position of the text" + (lambda (cx cy) + `(text (@ (x ,cx) + (y ,cy) + (class ,class) + (text-anchor middle) + (dominant-baseline central)) + ,text))) + + +(define stickers + (let ((pos (honeycomb sticker-radius '(0 . 0) page-size 1))) + (map + (lambda (contents) + (let ((position (pos))) + (cons + #;(circle + (x position) + (y position) + sticker-radius + "cuts") + (rounded-rect + (x position) + (y position) + (* 2 sticker-radius) + (* 2 sticker-radius) + 1 + "cuts") + (contents (x position) (y position))))) + (concatenate + (list + (map (lambda (x) (text-unpositioned x "letter symbol-color")) symbols) + (map (lambda (x) (text-unpositioned x "letter")) key-symbols) + (map (lambda (x) (text-unpositioned x "letter")) letters) + (map (lambda (x) (text-unpositioned x "letter")) numbers) + (map (lambda (x) (text-unpositioned x "modifier")) modifiers) + + (map (lambda (x) (text-unpositioned x "letter brackets-color")) brackets) + + ;(map (lambda (x) (text-unpositioned x "modifier fn-color")) fn) + (map (lambda (x) (text-unpositioned x "letter fn-color")) fn-keys) + (map (lambda (x) (text-unpositioned x "letter")) extra-sybols) + (map (lambda (x) (text-unpositioned x "letter")) punct) + ))))) + + +(define cuts (map car stickers)) +(define graphics (map cdr stickers)) + +(define (dump outport) + (display + "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?>" outport) + (display + (sxml->xml + `(svg (@ (version "1.1") + (xmlns:inkscape "http://www.inkscape.org/namespaces/inkscape") + (width ,(mm (x page-size))) + (height ,(mm (y page-size))) + (viewBox ,(string-append "0 0 " (num (x page-size)) + " " (num (y page-size))))) + (defs + (style ,style)) + + (g (@ (id cut) + (inkscape:groupmode layer) + (inkscape:label "Cortes")) + ,@cuts) + + + (g (@ (id graph) + (inkscape:groupmode layer) + (inkscape:label "Gráficos")) + ,@graphics))) + + outport)) + + + +(define args (cdr (command-line))) + +(if (< 0 (length args)) + (call-with-output-file (car args) dump) + (dump (current-output-port))) |