(require file/convertible racket/draw)

(define size 512)

;; from colours package

(define (chmn->rgb c hue mn)
  (define-values (r g b)
    (cond
      [(or (nan? hue) (nan? c)) (values 0 0 0)]
      [else
       (define x (* c (- 1 (abs (- (float-modulo (* hue 6) 2) 1)))))
       (match (exact-floor (* hue 6))
         [0 (values c x 0)]
         [1 (values x c 0)]
         [2 (values 0 c x)]
         [3 (values 0 x c)]
         [4 (values x 0 c)]
         [5 (values c 0 x)])]))
  (define mnv (if (nan? mn) 0 mn))
  (define (convert x) (remainder (+ 256 (exact-round (* 255 (+ x mnv)))) 256))
  (values (convert r) (convert g) (convert b)))

(define (float-modulo a n) (- a (* n (floor (/ a n)))))

(define (hsl->color h s l)
  (define chroma (* s (- 1 (abs (- (* 2 l) 1)))))
  (define mn (- l (/ chroma 2)))
  (define-values (r g b) (chmn->rgb chroma h mn))
  (make-color r g b))

;; /stolen

(define tau (* 2 pi))

(define (complex->colour z)
  (hsl->color
   (/ (float-modulo (+ tau (angle z)) tau) tau)
   1.0
   (* (/ 2 pi) (atan (magnitude z)))))

(define (wheel-bmp formula origin scale)
  (define f (eval `(lambda (z) ,formula)))
  (define bm (make-bitmap size size))
  (define dc (send bm make-dc))
  (for* ([b size] [a size])
    (define z
      (~> (make-rectangular a b) exact->inexact
          (/ size) (* 2) (- 1+1i) (+ origin) (* scale)))
    (send dc set-pixel a b (complex->colour (f z))))
  bm)

(define (generate-wheel f o s)
  (~> (wheel-bmp f (eval o) (eval s))
      (convert 'png-bytes)
      make-image))

(match (read-args)
  [(list formula) (generate-wheel formula 0 2)]
  [(list formula scale) (generate-wheel formula 0 scale)]
  [(list formula scale origin) (generate-wheel formula origin scale)]
  [_ "Usage:\n`!!color-wheel <formula> [scale] [origin]`"])