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