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

further performance tweaks for `get-argb-pixels'

Browse Source
This commit is contained in:
Matthew Flatt 2010-12-29 09:44:16 -07:00
parent 03ff6f3abb
commit fb42102c62
1 changed files with 18 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -603,7 +603,8 @@
(cairo_surface_flush s)
(let ([data (cairo_image_surface_get_data s)]
[row-width (cairo_image_surface_get_stride s)]
[use-alpha? (or alpha-channel? b&w?)])
[use-alpha? (or alpha-channel? b&w?)]
[set-alpha? alpha-channel?])
(let ([w2 (+ x (min (- width x) w))])
(for* ([j (in-range y (min (+ y h) height))])
(let* ([row (* j row-width)]
@ -612,35 +613,25 @@
[ri-end (+ row (* 4 w2))]
[pi-start p]
[pi-end (+ p (* 4 (- w2 x)))])
(unless (and (<= 0 ri-start)
(<= ri-end (bytes-length data)))
(error 'bitmap.rkt "ri indicies out of range ~s & ~s vs ~s"
ri-start
ri-end
(bytes-length data)))
(unless (and (<= 0 pi-start)
(<= pi-end (bytes-length bstr)))
(error 'bitmap.rkt "pi indicies out of range ~s & ~s vs ~s"
pi-start
pi-end
(bytes-length bstr)))
(for ([ri (in-range ri-start ri-end 4)]
[pi (in-range pi-start pi-end 4)])
(let ([a (bytes-ref data (+ ri A))])
(let ([a (unsafe-bytes-ref data (+ ri A))])
(let-syntax ([unmult
(λ (stx)
(syntax-case stx ()
[(_ 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-fxquotient
(unsafe-fx* v 255)
a)))
v)]))])
(when alpha-channel?
;; Defined as a macro to copy the
;; `unsafe-bytes-ref' to each branch,
;; 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-fxquotient
(unsafe-fx* v 255)
a)))
v)])])
(when set-alpha?
(unsafe-bytes-set! bstr pi a))
(unsafe-bytes-set! bstr (+ pi 1) (unmult (unsafe-bytes-ref data (+ ri R))))
(unsafe-bytes-set! bstr (+ pi 2) (unmult (unsafe-bytes-ref data (+ ri G))))