#lang racket/base
(require racket/sequence
"bits.rkt"
"bmp.rkt"
"version.rkt")
(provide (all-defined-out))
(define alignment
(make-bmp 5 5
(bytes #b00011111
#b00010001
#b00010101
#b00010001
#b00011111)))
(define finder
(make-bmp 7 7
(bytes #b01111111
#b01000001
#b01011101
#b01011101
#b01011101
#b01000001
#b01111111)))
(define mask-patterns
(vector
(make-bmp 2 2
(bytes #b01 #b10))
(make-bmp 1 2
(bytes #b1 #b0))
(make-bmp 3 1
(bytes #b001))
(make-bmp 3 3
(bytes #b001 #b100 #b010))
(make-bmp 6 4
(bytes #b000111 #b000111 #b111000 #b111000))
(make-bmp 6 6
(bytes #b111111 #b000001 #b001001 #b010101 #b001001 #b000001))
(make-bmp 6 6
(bytes #b111111 #b000111 #b011011 #b010101 #b101101 #b110001))
(make-bmp 6 6
(bytes #b010101 #b111000 #b110001 #b101010 #b000111 #b001110))))
(define (qr-template version)
(let* ([size (qr-size version)]
[bmp (make-bmp size size)])
(blit! bmp finder 0 0)
(blit! bmp finder (- size 7) 0)
(blit! bmp finder 0 (- size 7))
(for ([i (in-range 8 (- size 8) 2)])
(set-px! bmp i 6)
(set-px! bmp 6 i))
(when (> version 1)
(let* ([coords (qr-alignment-pattern-coords version)]
[n (vector-length coords)])
(for* ([j (in-range n)]
[i (in-range n)]
#:unless (or (and (zero? i) (zero? j))
(and (zero? i) (= (sub1 n) j))
(and (= (sub1 n) i) (zero? j))))
(blit! bmp alignment
(- (vector-ref coords i) 2)
(- (vector-ref coords j) 2)))))
(set-px! bmp 8 (- size 8))
bmp))
(define (qr-data-mask version)
(let* ([size (qr-size version)]
[bmp (make-bmp size size)])
(set-rect! bmp 0 0 size size)
(clear-rect! bmp 0 0 9 9)
(clear-rect! bmp (- size 8) 0 8 9)
(clear-rect! bmp 0 (- size 8) 9 8)
(clear-rect! bmp 9 6 (- size 17) 1)
(clear-rect! bmp 6 9 1 (- size 17))
(when (> version 1)
(let* ([coords (qr-alignment-pattern-coords version)]
[n (vector-length coords)])
(for* ([j (in-range n)]
[i (in-range n)]
#:unless (or (and (zero? i) (zero? j))
(and (zero? i) (= (sub1 n) j))
(and (= (sub1 n) i) (zero? j))))
(clear-rect! bmp
(- (vector-ref coords i) 2)
(- (vector-ref coords j) 2)
5 5))))
(when (>= version 7)
(clear-rect! bmp (- size 11) 0 3 6)
(clear-rect! bmp 0 (- size 11) 6 3))
bmp))
(define (in-modules size)
(make-do-sequence
(lambda ()
(values
(lambda (i)
(let-values ([(col row) (quotient/remainder i (* size 2))])
(let-values
([(x y)
(if (even? col)
(values (- size 1 (* 2 col) (remainder row 2))
(- size 1 (quotient row 2)))
(values (- size 1 (* 2 col) (remainder row 2))
(quotient row 2)))])
(if (<= x 6)
(values (sub1 x) y)
(values x y)))))
add1
0
(lambda (i)
(< i (* size size)))
#f
#f))))
(define (in-mask mask)
(sequence-filter
(lambda (x y)
(get-px mask x y))
(in-modules (bmp-width mask))))
(define (qr-layout-data! bmp mask bits)
(for ([(x y) (in-mask mask)]
[b (in-list (bytes->bits bits))]
#:when b)
(set-px! bmp x y)))
(define (qr-apply-data-mask n sym mask)
(let* ([size (bmp-width sym)]
[data-mask (bmp-map bitwise-and
(bmp-tile (vector-ref mask-patterns n) size size)
mask)])
(bmp-map bitwise-xor sym data-mask)))