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

noticed a few uses of unsafe primitives in some code that was causing trouble yesterday,

Browse Source 
so I refactored it a bit to speed it up by adding a  few more unsafes and lifting
computations out of the main loop. It sped up the 'time' in the program below
by slightly less than a factor of 2.

(define w 200)
(define h 200)
(define bm (make-bitmap w h))
(define bdc (make-object bitmap-dc% bm))
(send bdc set-smoothing 'aligned)
(send bdc set-text-foreground (send the-color-database find-color "blue"))
(send bdc draw-text "ab" 0 0)
(define the-bytes (make-bytes (* w h 4)))
(time
 (let loop ([n 400])
    (unless (zero? n)
         (send bm get-argb-pixels 0 0 w h the-bytes)
	      (loop (- n 1)))))
This commit is contained in:
Robby Findler 2010-12-29 08:05:17 -06:00
parent 56b27975a4
commit 03ff6f3abb
1 changed files with 39 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2,6 +2,7 @@
(require racket/class (require racket/class
racket/unsafe/ops racket/unsafe/ops
file/convertible file/convertible
(for-syntax racket/base)
"syntax.rkt" "syntax.rkt"
"hold.rkt" "hold.rkt"
"../unsafe/bstr.rkt" "../unsafe/bstr.rkt"
@ -605,28 +606,45 @@
[use-alpha? (or alpha-channel? b&w?)]) [use-alpha? (or alpha-channel? b&w?)])
(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))])
(let ([row (* j row-width)] (let* ([row (* j row-width)]
[p (* 4 (* (- j y) w))]) [p (* 4 (* (- j y) w))]
(for ([i (in-range x w2)]) [ri-start (+ row (* 4 x))]
(let* ([4i (* 4 i)] [ri-end (+ row (* 4 w2))]
[pi (+ p (* 4 (- i x)))] [pi-start p]
[ri (+ row 4i)] [pi-end (+ p (* 4 (- w2 x)))])
[a (bytes-ref data (+ ri A))] (unless (and (<= 0 ri-start)
[unmult (lambda (a v) (<= ri-end (bytes-length data)))
(if use-alpha? (error 'bitmap.rkt "ri indicies out of range ~s & ~s vs ~s"
(if (unsafe-fx= 0 a) ri-start
255 ri-end
;; `min' shouldn't be necessary, but it's (bytes-length data)))
;; just in case the data is ill-formed (unless (and (<= 0 pi-start)
(unsafe-fxmin 255 (unsafe-fxquotient (<= pi-end (bytes-length bstr)))
(unsafe-fx* v 255) (error 'bitmap.rkt "pi indicies out of range ~s & ~s vs ~s"
a))) pi-start
v))]) 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-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? (when alpha-channel?
(bytes-set! bstr pi a)) (unsafe-bytes-set! bstr pi a))
(bytes-set! bstr (+ pi 1) (unmult a (bytes-ref data (+ ri R)))) (unsafe-bytes-set! bstr (+ pi 1) (unmult (unsafe-bytes-ref data (+ ri R))))
(bytes-set! bstr (+ pi 2) (unmult a (bytes-ref data (+ ri G)))) (unsafe-bytes-set! bstr (+ pi 2) (unmult (unsafe-bytes-ref data (+ ri G))))
(bytes-set! bstr (+ pi 3) (unmult a (bytes-ref data (+ ri B)))))))))))) (unsafe-bytes-set! bstr (+ pi 3) (unmult (unsafe-bytes-ref data (+ ri B)))))))))))))
(cond (cond
[get-alpha? [get-alpha?
(get-alphas-as-mask x y w h bstr)] (get-alphas-as-mask x y w h bstr)]