suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

speed up mult/unmult in `{get,set}-argb-pixels'

Browse Source 
Also add test cases to check consistency of the results.
This commit is contained in:
Matthew Flatt 2011-08-26 09:08:10 -06:00
parent 2ef9f5ae0e
commit 71b500b49f
2 changed files with 130 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

79
collects/racket/draw/private/bitmap.rkt
View File

@ -64,6 +64,39 @@
(define fx+ unsafe-fx+)
(define fx* unsafe-fx*)
(define mult-table #f)
(define unmult-table #f)
(define (get-mult-table)
(unless mult-table
(set! mult-table (make-bytes (* 256 256)))
(for ([a (in-range 256)])
(for ([v (in-range 256)])
(bytes-set! mult-table
(fx+ (fx* a 256) v)
(unsafe-fl->fx
(unsafe-flround
(unsafe-fl/
(unsafe-fx->fl (fx* a v))
255.0)))))))
mult-table)
(define (get-unmult-table)
(unless unmult-table
(set! unmult-table (make-bytes (* 256 256)))
(for ([a (in-range 256)])
(for ([v (in-range 256)])
(bytes-set! unmult-table
(fx+ (fx* a 256) v)
(if (unsafe-fx<= a v)
255
(unsafe-fl->fx
(unsafe-flround
(unsafe-fl/
(unsafe-fx->fl (fx* 255 v))
(unsafe-fx->fl a)))))))))
unmult-table)
(define (alpha-mult al v)
(unsafe-fl->fx
(unsafe-flround
@ -71,6 +104,17 @@
(unsafe-fx->fl (fx* al v))
255.0))))
(define (alpha-unmult al v)
(if (zero? al)
255
(unsafe-fxmin 255
(unsafe-fl->fx
(unsafe-flround
(unsafe-fl/
(unsafe-fx->fl (fx* 255 v))
(unsafe-fx->fl al)))))))
(define png-convertible<%>
(interface* ()
([prop:convertible
@ -398,7 +442,8 @@
(let* ([dest (begin
(cairo_surface_flush s)
(cairo_image_surface_get_data s))]
[dest-row-width (cairo_image_surface_get_stride s)])
[dest-row-width (cairo_image_surface_get_stride s)]
[m (and pre? (get-mult-table))])
(let-values ([(A R G B) (argb-indices)])
(for ([r (in-vector rows)]
[j (in-naturals)])
@ -428,8 +473,8 @@
(unsafe-bytes-ref r (fx+ spos 3))
255)]
[premult (lambda (al v)
(if pre?
(alpha-mult al v)
(if m
(unsafe-bytes-ref m (fx+ (fx* al 256) v))
v))])
(unsafe-bytes-set! dest (fx+ pos A) al)
(unsafe-bytes-set! dest (fx+ pos R) (premult al (unsafe-bytes-ref r spos)))
@ -488,8 +533,7 @@
row
bi
(let ([src (+ (* j row-width) (* (* bi 8) 4))])
(for/fold ([v 0])
([k (in-range 8)])
(for/fold ([v 0]) ([k (in-range 8)])
(if ((+ (* 8 bi) k) . < . width)
(if (zero? (bytes-ref data (+ src (* 4 k))))
v
@ -611,7 +655,8 @@
(cairo_surface_flush s)
(let ([data (cairo_image_surface_get_data s)]
[row-width (cairo_image_surface_get_stride s)]
[use-alpha? (or (and alpha-channel? (not pre-mult?)) b&w?)]
[um (and (or (and alpha-channel? (not pre-mult?)) b&w?)
(get-unmult-table))]
[set-alpha? alpha-channel?])
(let ([w2 (+ x (min (- width x) w))])
(for* ([j (in-range y (min (+ y h) height))])
@ -630,17 +675,8 @@
;; instead of binding a local variable
(syntax-rules ()
[(_ v)
(if use-alpha?
(if (unsafe-fx= 0 a)
255
;; `min' shouldn't be necessary, but it's
;; just in case the data is ill-formed
(unsafe-fxmin 255
(unsafe-fl->fx
(unsafe-flround
(unsafe-fl/
(unsafe-fx->fl (fx* 255 v))
(unsafe-fx->fl a))))))
(if um
(unsafe-bytes-ref um (fx+ (fx* a 256) v))
v)])])
(when set-alpha?
(unsafe-bytes-set! bstr pi a))
@ -676,7 +712,8 @@
(when (not set-alpha?)
(cairo_surface_flush s)
(let ([data (cairo_image_surface_get_data s)]
[row-width (cairo_image_surface_get_stride s)])
[row-width (cairo_image_surface_get_stride s)]
[m (and (not pre-mult?) (get-mult-table))])
(let ([w2 (+ x (min (- width x) w))])
(for ([j (in-range y (min (+ y h) height))]
[dj (in-naturals)])
@ -699,9 +736,9 @@
(if alpha-channel?
(let ([a (bytes-ref bstr pi)]
[pm (lambda (a v)
(if pre-mult?
(min a v)
(alpha-mult a v)))])
(if m
(unsafe-bytes-ref m (fx+ (fx* a 256) v))
(min a v)))])
(bytes-set! data (+ ri A) a)
(bytes-set! data (+ ri R) (pm a (bytes-ref bstr (+ pi 1))))
(bytes-set! data (+ ri G) (pm a (bytes-ref bstr (+ pi 2))))

73
collects/tests/gracket/dc.rktl
View File

@ -407,7 +407,7 @@
bs)
(define (unmul b)
(define (um v) (quotient (* v 255) (bytes-ref b 0)))
(define (um v) (inexact->exact (round (/ (* v 255.) (bytes-ref b 0)))))
(bytes (bytes-ref b 0)
(um (bytes-ref b 1))
(um (bytes-ref b 2))
@ -420,6 +420,77 @@
'alpha-normal (get-pixels abm #f))
(test #"30127456b89afcde" 'alpha-premult (get-pixels abm #t)))
;; ----------------------------------------
;; check consistency of pre-multiplication, drawing, etc.
(let ()
(define gray-cols (make-bitmap 256 256 #f)) ; no alpha channel
(let ([s (make-bytes (* 256 256 4))])
(for* ([i 256] [j 256])
(bytes-set! s (+ (* 4 i) (* j 256 4)) 255)
(bytes-set! s (+ (* 4 i) 1 (* j 256 4)) (- 255 i))
(bytes-set! s (+ (* 4 i) 2 (* j 256 4)) (- 255 i))
(bytes-set! s (+ (* 4 i) 3 (* j 256 4)) (- 255 i)))
(send gray-cols set-argb-pixels 0 0 256 256 s))
(define rainbow-rows (make-bitmap 256 256))
(let ([s (make-bytes (* 256 256 4))])
(for* ([i 256] [j 256])
(bytes-set! s (+ (* 4 i) (* j 256 4)) 255)
(bytes-set! s (+ (* 4 i) 1 (* j 256 4)) j)
(bytes-set! s (+ (* 4 i) 2 (* j 256 4)) (modulo (+ j 10) 256))
(bytes-set! s (+ (* 4 i) 3 (* j 256 4)) (modulo (+ j 20) 256)))
(send rainbow-rows set-argb-pixels 0 0 256 256 s))
(define rainbow-rows-alpha-cols (make-bitmap 256 256))
(let ([s (make-bytes (* 256 256 4))])
(for* ([i 256] [j 256])
(bytes-set! s (+ (* 4 i) (* j 256 4)) i)
(bytes-set! s (+ (* 4 i) 1 (* j 256 4)) j)
(bytes-set! s (+ (* 4 i) 2 (* j 256 4)) (modulo (+ j 10) 256))
(bytes-set! s (+ (* 4 i) 3 (* j 256 4)) (modulo (+ j 20) 256)))
(send rainbow-rows-alpha-cols set-argb-pixels 0 0 256 256 s))
(define rainbow-rows-alpha-cols-premult (make-bitmap 256 256))
(let ([s (make-bytes (* 256 256 4))])
(for* ([i 256] [j 256])
(bytes-set! s (+ (* 4 i) (* j 256 4)) i)
(bytes-set! s (+ (* 4 i) 1 (* j 256 4)) (min i j))
(bytes-set! s (+ (* 4 i) 2 (* j 256 4)) (min i (modulo (+ j 10) 256)))
(bytes-set! s (+ (* 4 i) 3 (* j 256 4)) (min i (modulo (+ j 20) 256))))
(send rainbow-rows-alpha-cols-premult set-argb-pixels 0 0 256 256 s #f #t))
;; Check that drawing with a mask is consistent with `set-argb-pixels'
;; in non-premultiplied mode:
(let ([target (make-bitmap 256 256)])
(define dc (make-object bitmap-dc% target))
(send dc draw-bitmap rainbow-rows 0 0
'solid
(send the-color-database find-color "black")
gray-cols)
(let ([s1 (make-bytes (* 256 256 4))]
[s2 (make-bytes (* 256 256 4))])
(send target get-argb-pixels 0 0 256 256 s1 #f #t)
(send rainbow-rows-alpha-cols get-argb-pixels 0 0 256 256 s2 #f #t)
(for ([i (in-range (* 256 256))])
(unless (= (bytes-ref s1 i) (bytes-ref s2 i))
(printf "~a ~a ~a\n" i (bytes-ref s1 i) (bytes-ref s2 i))))
(test #t 'consistent-mult (equal? s1 s2))))
;; Check that getting non-premult values out and putting them back in
;; gives consistent premult results:
(let ([target (make-bitmap 256 256)])
(let ([s1 (make-bytes (* 256 256 4))]
[s2 (make-bytes (* 256 256 4))])
(send rainbow-rows-alpha-cols-premult get-argb-pixels 0 0 256 256 s1 #f #f)
(send target set-argb-pixels 0 0 256 256 s1 #f #f)
(send target get-argb-pixels 0 0 256 256 s1 #f #t)
(send rainbow-rows-alpha-cols-premult get-argb-pixels 0 0 256 256 s2 #f #t)
(test #t 'consistent-premult (equal? s1 s2))))
(void))
;; ----------------------------------------