From 71b500b49f2948b7c6902afe2a03938e55eb9423 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 26 Aug 2011 09:08:10 -0600 Subject: [PATCH] speed up mult/unmult in `{get,set}-argb-pixels' Also add test cases to check consistency of the results. --- collects/racket/draw/private/bitmap.rkt | 79 ++++++++++++++++++------- collects/tests/gracket/dc.rktl | 73 ++++++++++++++++++++++- 2 files changed, 130 insertions(+), 22 deletions(-) diff --git a/collects/racket/draw/private/bitmap.rkt b/collects/racket/draw/private/bitmap.rkt index 40720c0656..19eb68798d 100644 --- a/collects/racket/draw/private/bitmap.rkt +++ b/collects/racket/draw/private/bitmap.rkt @@ -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)))) diff --git a/collects/tests/gracket/dc.rktl b/collects/tests/gracket/dc.rktl index a1d5cf137e..5fe76a98cc 100644 --- a/collects/tests/gracket/dc.rktl +++ b/collects/tests/gracket/dc.rktl @@ -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)) + ;; ----------------------------------------