1 files changed, 118 insertions, 0 deletions
diff --git a/utils/cover/barcode.scm b/utils/cover/barcode.scm
new file mode 100644
index 0000000..85f28c2
--- /dev/null
+++ b/utils/cover/barcode.scm
@@ -0,0 +1,118 @@
+(import (chibi)
+        (chibi sxml)
+        (srfi 1))
+
+
+; R ENCODING
+(define R (list (list #t #t #t #f #f #t #f) 
+                (list #t #t #f #f #t #t #f)
+                (list #t #t #f #t #t #f #f)
+                (list #t #f #f #f #f #t #f)
+                (list #t #f #t #t #t #f #f)
+                (list #t #f #f #t #t #t #f)
+                (list #t #f #t #f #f #f #f)
+                (list #t #f #f #f #t #f #f)
+                (list #t #f #f #t #f #f #f)
+                (list #t #t #t #f #t #f #f)))
+
+; G ENCODING
+(define G 
+  (map reverse R))
+
+; L ENCODING
+(define L
+  (map (lambda (x) (map not x)) R))
+
+; END
+(define E '(#t #f #t))
+
+; SEPARATOR
+(define S '(#f #t #f #t #f))
+
+(define (encode encoding num)
+  (case encoding
+    ('E E)
+    ('S S)
+    ('R (list-ref R num))
+    ('L (list-ref L num))
+    ('G (list-ref G num))))
+
+
+(define order '((E L L L L L L S R R R R R R E)
+                (E L L G L G G S R R R R R R E)
+                (E L L G G L G S R R R R R R E)
+                (E L L G G G L S R R R R R R E)
+                (E L G L L G G S R R R R R R E)
+                (E L G G L L G S R R R R R R E)
+                (E L G G G L L S R R R R R R E)
+                (E L G L G L G S R R R R R R E)
+                (E L G L G G L S R R R R R R E)
+                (E L G G L G L S R R R R R R E)))
+
+(define (barcode number)
+  "Get number in decima string"
+  (let* ((nums (string->list number))
+
+         (digits (map (lambda (x) (string->number (list->string (list x))))
+                      nums))
+
+         (digit-1 (car digits))
+         (digits-rest (cdr digits))
+         (block-1 (take digits-rest 6))
+         (block-2 (drop digits-rest 6))
+         (sep '(#f)))
+
+    (concatenate (map (lambda (x y) (encode x y))
+                      (list-ref order digit-1)
+                      (concatenate (list sep
+                                         block-1
+                                         sep
+                                         block-2
+                                         sep))))))
+
+
+
+
+(define (barcode-sxml code x y scale)
+  (let* ((border 0.1)
+         (text-size border)
+         (codewidth 1)
+         (width  (+ border codewidth))
+         (colwidth (exact->inexact (/ codewidth 95)))
+         (height 0.6)
+         (viewBox (string-append "0 0 "
+                                 (number->string width)
+                                 " "
+                                 (number->string height)))
+         (encoded (barcode code)))
+    `(g
+       (@ (transform ,(string-append "translate(" (number->string x) "," (number->string y) ")"
+                                     "scale(" (number->string scale) ")")))
+
+       ,(map
+          (lambda (render pos)
+            `(rect (@ (x ,(+ border (* pos colwidth)))
+                      (y 0)
+                      (width  ,(exact->inexact colwidth))
+                      (height ,(if
+                                 (find (lambda (x) (= x pos))
+                                       '(0 1 2 94 93 92 45 46 47 48 49))
+                                 height
+                                 (- height border)))
+                      (style ,(if render "fill: black" "fill: white")))))
+          encoded
+          (iota (length encoded)))
+
+       ,(map
+          (lambda (char pos)
+            `(text (@ (style ,(string-append "font-size: " (number->string text-size) ";"
+                                             "text-anchor: middle"))
+                      (x ,(cond ((= 0 pos)    (* 3.5 colwidth))
+                                ((<= 1 pos 6) (+ border (* (+ 3 (* (- pos 0.5) 7)) colwidth)))
+                                ((< 6 pos)    (+ border (* (+ 3 5 (* (- pos 0.5) 7)) colwidth)))))
+                      (y  ,height))
+                   ,(list->string (list char))))
+          (string->list code)
+          (iota (string-length code))))))
+
+#;(display (barcode-svg "9780201379624"))