#lang racket/base

(require racket/class
         racket/contract
         racket/draw
         "base.rkt"
         "data.rkt"
         "private/bmp.rkt"
         "private/encode.rkt")

(provide
 (all-from-out "base.rkt")
 (contract-out
  [qr-encode (->* (qr-spec?)
                  (#:scale exact-positive-integer?)
                  (is-a?/c bitmap%))]
  [make-qr-code (->* (string?)
                     (#:version (or/c #f (integer-in 1 40))
                                #:edc-level (one-of/c 'L 'M 'Q 'H)
                                #:scale exact-positive-integer?)
                     (is-a?/c bitmap%))]))

(define (qr-encode spec #:scale [scale 4])
  (let* ([bmp (qr-encode/bmp spec)]
         [size (bmp-width bmp)]
         [core (make-monochrome-bitmap size size (bmp-bits bmp))]
         [sym (make-bitmap (* scale (+ size 8))
                           (* scale (+ size 8)))]
         [dc (new bitmap-dc% [bitmap sym])])
    (send dc set-scale scale scale)
    (send dc set-smoothing 'unsmoothed)
    (send dc draw-bitmap core 4 4)
    sym))

(define (make-qr-code text #:version [version #f] #:edc-level [edc-level 'M] #:scale [scale 4])
  (let* ([data (string->qr-data text)]
         [min-ver (data-minimum-version data edc-level)]
         [version (or version min-ver)])
    (unless (>= version min-ver)
      (error 'make-qr "data won't fit in version ~a" version))
    (qr-encode (qr-spec version edc-level data)
               #:scale scale)))