First commit

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)))