summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--glyphs/en.scm16
-rw-r--r--glyphs/es.scm2
-rw-r--r--stickers.scm185
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)))