#lang racket/base

(require racket/sequence
         "bits.rkt"
         "bmp.rkt"
         "version.rkt")

(provide (all-defined-out)) ;xxx

(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)])
    ;; Finder pattern
    (blit! bmp finder 0 0)
    (blit! bmp finder (- size 7) 0)
    (blit! bmp finder 0 (- size 7))
    
    ;; Timing pattern
    (for ([i (in-range 8 (- size 8) 2)])
      (set-px! bmp i 6)
      (set-px! bmp 6 i))
    
    ;; Alignment pattern
    (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)))