#lang racket/base

(require racket/draw racket/class racket/match
         racket/unsafe/ops
         "flomap-struct.rkt"
         "flomap-pointwise.rkt"
         "flomap-resize.rkt")

(provide bitmap->flomap flomap->bitmap draw-flomap)

(define (bitmap->flomap bm)
  (unless (is-a? bm bitmap%)
    (raise-type-error 'bitmap->flomap "bitmap% instance" bm))
  (define w (send bm get-width))
  (define h (send bm get-height))
  (define bs (make-bytes (* 4 w h)))
  (send bm get-argb-pixels 0 0 w h bs #t #t)
  (send bm get-argb-pixels 0 0 w h bs #f #t)
  
  (define argb-fm (make-flomap 4 w h))
  (define argb-vs (flomap-values argb-fm))
  (for ([i0  (in-range 0 (* 4 w h) 4)])
    (define i1 (unsafe-fx+ i0 1))
    (define i2 (unsafe-fx+ i0 2))
    (define i3 (unsafe-fx+ i0 3))
    (define a (unsafe-bytes-ref bs i0))
    (define r (unsafe-bytes-ref bs i1))
    (define g (unsafe-bytes-ref bs i2))
    (define b (unsafe-bytes-ref bs i3))
    (unsafe-flvector-set! argb-vs i0 (unsafe-fl/ (unsafe-fx->fl a) 255.0))
    (unsafe-flvector-set! argb-vs i1 (unsafe-fl/ (unsafe-fx->fl r) 255.0))
    (unsafe-flvector-set! argb-vs i2 (unsafe-fl/ (unsafe-fx->fl g) 255.0))
    (unsafe-flvector-set! argb-vs i3 (unsafe-fl/ (unsafe-fx->fl b) 255.0)))
  
  argb-fm)

(define (unsafe-fl->byte x)
  (unsafe-fl->fx
   (unsafe-flround
    (unsafe-flmax 0.0 (unsafe-flmin 255.0 (unsafe-fl* x 255.0))))))

(define (flomap->bitmap fm)
  (match-define (flomap vs c w h) fm)
  (let* ([fm  (case c
                [(0)  (make-flomap 4 w h)]
                [(1)  (flomap-append-components (make-flomap 1 w h 1.0) fm fm fm)]
                [(2)  (define alpha-fm (flomap-ref-component fm 0))
                      (define value-fm (flomap-drop-components fm 1))
                      (flomap-append-components alpha-fm value-fm value-fm value-fm)]
                [(3)  (flomap-append-components (make-flomap 1 w h 1.0) fm)]
                [(4)  fm]
                [else  (raise-type-error 'flomap->bitmap "flomap with 1, 2, 3 or 4 components" fm)])]
         ;; inset if zero (bitmaps can't have zero size)
         [fm  (flomap-inset fm 0 0 (if (= w 0) 1 0) (if (= h 0) 1 0))])
    ;; guaranteed an ARGB flomap now
    (match-define (flomap vs 4 w h) fm)
    (define bs (make-bytes (* 4 w h)))
    (for ([i0  (in-range 0 (* 4 w h) 4)])
      (define i1 (unsafe-fx+ i0 1))
      (define i2 (unsafe-fx+ i0 2))
      (define i3 (unsafe-fx+ i0 3))
      (define a (unsafe-flvector-ref vs i0))
      (define r (unsafe-flvector-ref vs i1))
      (define g (unsafe-flvector-ref vs i2))
      (define b (unsafe-flvector-ref vs i3))
      (unsafe-bytes-set! bs i0 (unsafe-fl->byte a))
      (unsafe-bytes-set! bs i1 (unsafe-fl->byte r))
      (unsafe-bytes-set! bs i2 (unsafe-fl->byte g))
      (unsafe-bytes-set! bs i3 (unsafe-fl->byte b)))
    
    (define bm (make-bitmap w h))
    (send bm set-argb-pixels 0 0 w h bs #t #t)
    (send bm set-argb-pixels 0 0 w h bs #f #t)
    bm))

(define (draw-flomap draw-proc w h)
  (unless (w . >= . 0) (raise-type-error 'draw-flomap "nonnegative fixnum" 0 w h draw-proc))
  (unless (h . >= . 0) (raise-type-error 'draw-flomap "nonnegative fixnum" 1 w h draw-proc))
  
  (define bm (make-bitmap (max w 1) (max h 1)))
  (define dc (make-object bitmap-dc% bm))
  (send dc set-smoothing 'smoothed)
  (draw-proc dc)
  (flomap-inset (bitmap->flomap bm) 0 0 (if (= w 0) -1 0) (if (= h 0) -1 0)))