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

set-argb-pixels: lift tests for mode out of loop

Browse Source 
This change by itself provides only a small performance improvement.
This commit is contained in:
Matthew Flatt 2012-12-17 05:29:33 -07:00
parent e6c1e73452
commit 148a1d4387
1 changed files with 50 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -719,48 +719,56 @@
(cairo_surface_flush s) (cairo_surface_flush s)
(let ([data (cairo_image_surface_get_data 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))] [m (and (not pre-mult?) (get-mult-table))])
[b&w-local? b&w?] (define-syntax-rule (set-loop body)
[alpha-channel-local? alpha-channel?]) (let ([w2 (+ x (min (- width x) w))])
(let ([w2 (+ x (min (- width x) w))]) (for ([j (in-range y (min (+ y h) height))]
(for ([j (in-range y (min (+ y h) height))] [dj (in-naturals)])
[dj (in-naturals)]) (let ([row (* j row-width)]
(let ([row (* j row-width)] [p (* 4 (* dj w))])
[p (* 4 (* dj w))]) (for ([i (in-range x w2)])
(for ([i (in-range x w2)]) (let* ([4i (unsafe-fx* 4 i)]
(let* ([4i (unsafe-fx* 4 i)] [pi (unsafe-fx+ p (unsafe-fx* 4 (unsafe-fx- i x)))]
[pi (unsafe-fx+ p (unsafe-fx* 4 (unsafe-fx- i x)))] [ri (unsafe-fx+ row 4i)])
[ri (unsafe-fx+ row 4i)]) (body pi ri)))))))
(if b&w-local? (cond
(let ([v (if (and (= (unsafe-bytes-ref bstr (+ pi 1)) 255) [b&w?
(= (unsafe-bytes-ref bstr (+ pi 2)) 255) (set-loop
(= (unsafe-bytes-ref bstr (+ pi 3)) 255)) (lambda (pi ri)
255 (let ([v (if (and (= (unsafe-bytes-ref bstr (+ pi 1)) 255)
0)]) (= (unsafe-bytes-ref bstr (+ pi 2)) 255)
(unsafe-bytes-set! data (unsafe-fx+ ri A) (- 255 v)) (= (unsafe-bytes-ref bstr (+ pi 3)) 255))
(unsafe-bytes-set! data (unsafe-fx+ ri 1) v) 255
(unsafe-bytes-set! data (unsafe-fx+ ri 2) v) 0)])
(unsafe-bytes-set! data (unsafe-fx+ ri B) v)) (unsafe-bytes-set! data (unsafe-fx+ ri A) (- 255 v))
(if alpha-channel-local? (unsafe-bytes-set! data (unsafe-fx+ ri 1) v)
(let ([a (bytes-ref bstr pi)] (unsafe-bytes-set! data (unsafe-fx+ ri 2) v)
[pm (lambda (a v) (unsafe-bytes-set! data (unsafe-fx+ ri B) v))))]
(if m [alpha-channel?
(unsafe-bytes-ref m (fx+ (fx* a 256) v)) (define-syntax-rule (alpha-set-loop pm)
(min a v)))]) (set-loop
(unsafe-bytes-set! data (unsafe-fx+ ri A) a) (lambda (pi ri)
(unsafe-bytes-set! data (unsafe-fx+ ri R) (let ([a (bytes-ref bstr pi)])
(pm a (unsafe-bytes-ref bstr (unsafe-fx+ pi 1)))) (unsafe-bytes-set! data (unsafe-fx+ ri A) a)
(unsafe-bytes-set! data (unsafe-fx+ ri G) (unsafe-bytes-set! data (unsafe-fx+ ri R)
(pm a (unsafe-bytes-ref bstr (unsafe-fx+ pi 2)))) (pm a (unsafe-bytes-ref bstr (unsafe-fx+ pi 1))))
(unsafe-bytes-set! data (unsafe-fx+ ri B) (unsafe-bytes-set! data (unsafe-fx+ ri G)
(pm a (unsafe-bytes-ref bstr (unsafe-fx+ pi 3))))) (pm a (unsafe-bytes-ref bstr (unsafe-fx+ pi 2))))
(begin (unsafe-bytes-set! data (unsafe-fx+ ri B)
(unsafe-bytes-set! data (unsafe-fx+ ri R) (pm a (unsafe-bytes-ref bstr (unsafe-fx+ pi 3))))))))
(unsafe-bytes-ref bstr (unsafe-fx+ pi 1))) (if m
(unsafe-bytes-set! data (unsafe-fx+ ri G) (alpha-set-loop (lambda (a v)
(unsafe-bytes-ref bstr (unsafe-fx+ pi 2))) (unsafe-bytes-ref m (unsafe-fx+ (unsafe-fx* a 256) v))))
(unsafe-bytes-set! data (unsafe-fx+ ri B) (alpha-set-loop (lambda (a v) (unsafe-fxmin a v))))]
(unsafe-bytes-ref bstr (unsafe-fx+ pi 3)))))))))))) [else
(set-loop
(lambda (pi ri)
(unsafe-bytes-set! data (unsafe-fx+ ri R)
(unsafe-bytes-ref bstr (unsafe-fx+ pi 1)))
(unsafe-bytes-set! data (unsafe-fx+ ri G)
(unsafe-bytes-ref bstr (unsafe-fx+ pi 2)))
(unsafe-bytes-set! data (unsafe-fx+ ri B)
(unsafe-bytes-ref bstr (unsafe-fx+ pi 3)))))]))
(cairo_surface_mark_dirty s))) (cairo_surface_mark_dirty s)))
(cond (cond
[(and set-alpha? [(and set-alpha?