1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
(import (chibi)
(chibi string)
(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 decimal 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 (remove-dashes code)
(string-join (string-split code #\-) ""))
(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)))
(code (remove-dashes code))
(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))))))
|
