Speed up set-argb-pixels by using local references to b&w? and alpha-channel?
In set-argb-pixels, the critical loop for each pixel tests the value of a boolean that was defined at the top level of the class. Forcing these to be local variables gives a speedup of 1.5.
This commit is contained in:
Michael Wilber
Matthew Flatt
parent
a04ae51f64
commit
6308f3011d
|
|
@ -43,11 +43,11 @@
|
|||
|
||||
(define (bitmap-file-kind-symbol? s)
|
||||
(memq s '(unknown unknown/mask unknown/alpha
|
||||
gif gif/mask gif/alpha
|
||||
gif gif/mask gif/alpha
|
||||
jpeg jpeg/alpha
|
||||
png png/mask png/alpha
|
||||
xbm xbm/alpha
|
||||
xpm xpm/alpha
|
||||
xbm xbm/alpha
|
||||
xpm xpm/alpha
|
||||
bmp bmp/alpha
|
||||
pict)))
|
||||
|
||||
|
|
@ -117,7 +117,7 @@
|
|||
(define (alpha-unmult al v)
|
||||
(if (zero? al)
|
||||
255
|
||||
(unsafe-fxmin 255
|
||||
(unsafe-fxmin 255
|
||||
(unsafe-fl->fx
|
||||
(unsafe-flround
|
||||
(unsafe-fl/
|
||||
|
|
@ -143,7 +143,7 @@
|
|||
(class* object% (png-convertible<%>)
|
||||
|
||||
;; We support three kinds of bitmaps:
|
||||
;; * Color with alpha channel;
|
||||
;; * Color with alpha channel;
|
||||
;; when used as a mask, alpha channel is used;
|
||||
;; this is the sensible one that works nicely with Cairo
|
||||
;; * Black and white; alpha channel is opposite
|
||||
|
|
@ -161,7 +161,7 @@
|
|||
(super-new)
|
||||
|
||||
(define-values (alt? width height b&w? alpha-channel? s loaded-mask)
|
||||
(case-args
|
||||
(case-args
|
||||
args
|
||||
[([alternate-bitmap-kind? a])
|
||||
(values #t
|
||||
|
|
@ -184,7 +184,7 @@
|
|||
[b&w?
|
||||
;; Init transparent white:
|
||||
(transparent-white! s w h)]
|
||||
[alpha?
|
||||
[alpha?
|
||||
;; Init transparent:
|
||||
(bytes-fill! (cairo_image_surface_get_data s) 0)]
|
||||
[else
|
||||
|
|
@ -199,7 +199,7 @@
|
|||
[any? [complain-on-failure? #f]])
|
||||
(let-values ([(s b&w?) (do-load-bitmap filename kind bg-color complain-on-failure?)]
|
||||
[(alpha?) (memq kind '(unknown/alpha gif/alpha jpeg/alpha
|
||||
png/alpha xbm/alpha xpm/alpha
|
||||
png/alpha xbm/alpha xpm/alpha
|
||||
bmp/alpha))]
|
||||
[(mask?) (memq kind '(unknown/mask gif/mask png/mask))])
|
||||
(let ([mask-bm
|
||||
|
|
@ -320,10 +320,10 @@
|
|||
(equal? (peek-bytes (bytes-length s) 0 in) s))])
|
||||
(cond
|
||||
[(starts? #"\211PNG\r\n")
|
||||
(do-load-bitmap in
|
||||
(if (eq? kind 'unknown/alpha)
|
||||
'png/alpha
|
||||
(if (eq? kind 'unknown/mask)
|
||||
(do-load-bitmap in
|
||||
(if (eq? kind 'unknown/alpha)
|
||||
'png/alpha
|
||||
(if (eq? kind 'unknown/mask)
|
||||
'png/mask
|
||||
'png))
|
||||
bg
|
||||
|
|
@ -353,7 +353,7 @@
|
|||
proc
|
||||
(values (cairo_image_surface_create_from_png_stream proc) #f)))
|
||||
;; Using libpng directly:
|
||||
(let-values ([(r w h b&w? alpha?) (create-png-reader
|
||||
(let-values ([(r w h b&w? alpha?) (create-png-reader
|
||||
in
|
||||
(memq kind '(png/mask png/alpha))
|
||||
(and bg
|
||||
|
|
@ -436,7 +436,7 @@
|
|||
(values s #f))
|
||||
(values #f #f)))]
|
||||
[else (values #f #f)])))
|
||||
|
||||
|
||||
;; s : Cairo bitmap surface
|
||||
;; w, h : width and height in pixels
|
||||
;; rows : a vector of `h' byte strings
|
||||
|
|
@ -469,7 +469,7 @@
|
|||
(unsafe-fxrshift 128 (unsafe-fxand i 7)))]
|
||||
[pos (fx+ row (fx* 4 i))])
|
||||
(let* ([v (if (zero? (unsafe-fxand bit (unsafe-bytes-ref r b)))
|
||||
0
|
||||
0
|
||||
255)]
|
||||
[v (if backward? (- 255 v) v)])
|
||||
(unsafe-bytes-set! dest (fx+ pos A) (- 255 v))
|
||||
|
|
@ -514,7 +514,7 @@
|
|||
(and (ok?)
|
||||
(begin
|
||||
(if alt?
|
||||
(call-with-alt-bitmap
|
||||
(call-with-alt-bitmap
|
||||
0 0 width height
|
||||
(lambda (bm)
|
||||
(send bm save-file out kind quality)))
|
||||
|
|
@ -540,7 +540,7 @@
|
|||
(for ([j (in-range height)])
|
||||
(let ([row (vector-ref rows j)])
|
||||
(for ([bi (in-range b)])
|
||||
(bytes-set!
|
||||
(bytes-set!
|
||||
row
|
||||
bi
|
||||
(let ([src (+ (* j row-width) (* (* bi 8) 4))])
|
||||
|
|
@ -553,7 +553,7 @@
|
|||
(let ([w (create-png-writer out width height #t #f)])
|
||||
(write-png w rows)
|
||||
(destroy-png-writer w)))]
|
||||
[else #;(and (not alpha-channel?)
|
||||
[else #;(and (not alpha-channel?)
|
||||
loaded-mask
|
||||
(= width (send loaded-mask get-width))
|
||||
(= height (send loaded-mask get-height)))
|
||||
|
|
@ -642,7 +642,7 @@
|
|||
(when (ok?)
|
||||
(if alt?
|
||||
(call-with-alt-bitmap
|
||||
x y w h
|
||||
x y w h
|
||||
(lambda (bm) (send bm get-argb-pixels 0 0 w h bstr get-alpha? pre-mult?)))
|
||||
(do-get-argb-pixels x y w h bstr get-alpha? pre-mult?))))
|
||||
|
||||
|
|
@ -679,8 +679,8 @@
|
|||
(for ([ri (in-range ri-start ri-end 4)]
|
||||
[pi (in-range pi-start pi-end 4)])
|
||||
(let ([a (unsafe-bytes-ref data (+ ri A))])
|
||||
(let-syntax ([unmult
|
||||
;; Defined as a macro to copy the
|
||||
(let-syntax ([unmult
|
||||
;; Defined as a macro to copy the
|
||||
;; `unsafe-bytes-ref' to each branch,
|
||||
;; instead of binding a local variable
|
||||
(syntax-rules ()
|
||||
|
|
@ -719,7 +719,9 @@
|
|||
(cairo_surface_flush s)
|
||||
(let ([data (cairo_image_surface_get_data 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?]
|
||||
[alpha-channel-local? alpha-channel?])
|
||||
(let ([w2 (+ x (min (- width x) w))])
|
||||
(for ([j (in-range y (min (+ y h) height))]
|
||||
[dj (in-naturals)])
|
||||
|
|
@ -729,7 +731,7 @@
|
|||
(let* ([4i (* 4 i)]
|
||||
[pi (+ p (* 4 (- i x)))]
|
||||
[ri (+ row 4i)])
|
||||
(if b&w?
|
||||
(if b&w-local?
|
||||
(let ([v (if (and (= (bytes-ref bstr (+ pi 1)) 255)
|
||||
(= (bytes-ref bstr (+ pi 2)) 255)
|
||||
(= (bytes-ref bstr (+ pi 3)) 255))
|
||||
|
|
@ -739,7 +741,7 @@
|
|||
(bytes-set! data (+ ri 1) v)
|
||||
(bytes-set! data (+ ri 2) v)
|
||||
(bytes-set! data (+ ri B) v))
|
||||
(if alpha-channel?
|
||||
(if alpha-channel-local?
|
||||
(let ([a (bytes-ref bstr pi)]
|
||||
[pm (lambda (a v)
|
||||
(if m
|
||||
|
|
@ -760,7 +762,7 @@
|
|||
;; Set alphas:
|
||||
(set-alphas-as-mask x y w h bstr (* 4 w) 0)])
|
||||
(drop-alpha-s)))
|
||||
|
||||
|
||||
(define/public (get-alphas-as-mask x y w h bstr)
|
||||
(let ([data (cairo_image_surface_get_data (if (or b&w? alpha-channel?)
|
||||
(begin
|
||||
|
|
@ -778,7 +780,7 @@
|
|||
(let ([p (* 4 (+ (- i x) (* (- j y) w)))]
|
||||
[q (+ row (* i 4))])
|
||||
(bytes-set! bstr p (bytes-ref data (+ q A)))))))))
|
||||
|
||||
|
||||
(define/public (prep-alpha)
|
||||
(when (and (not b&w?)
|
||||
(not alpha-channel?))
|
||||
|
|
@ -869,23 +871,23 @@
|
|||
(class bitmap%
|
||||
(init w h)
|
||||
(super-make-object (make-alternate-bitmap-kind w h))
|
||||
|
||||
|
||||
(define s (build-cairo-surface w h))
|
||||
;; erase the bitmap
|
||||
(let ([cr (cairo_create s)])
|
||||
(cairo_set_source_rgba cr 1.0 1.0 1.0 1.0)
|
||||
(cairo_paint cr)
|
||||
(cairo_destroy cr))
|
||||
|
||||
(define/public (build-cairo-surface w h)
|
||||
|
||||
(define/public (build-cairo-surface w h)
|
||||
(cairo_win32_surface_create_with_dib CAIRO_FORMAT_RGB24 w h))
|
||||
|
||||
|
||||
(define/override (ok?) #t)
|
||||
(define/override (is-color?) #t)
|
||||
(define/override (has-alpha-channel?) #f)
|
||||
|
||||
|
||||
(define/override (get-cairo-surface) s)
|
||||
|
||||
|
||||
(define/override (release-bitmap-storage)
|
||||
(atomically
|
||||
(cairo_surface_destroy s)
|
||||
|
|
@ -895,7 +897,7 @@
|
|||
(class bitmap%
|
||||
(init w h [with-alpha? #t])
|
||||
(super-make-object (make-alternate-bitmap-kind w h))
|
||||
|
||||
|
||||
(define s
|
||||
(let ([s (cairo_quartz_surface_create (if with-alpha?
|
||||
CAIRO_FORMAT_ARGB32
|
||||
|
|
@ -911,20 +913,20 @@
|
|||
(cairo_paint cr)
|
||||
(cairo_destroy cr))
|
||||
s))
|
||||
|
||||
|
||||
(define/override (ok?) (and s #t))
|
||||
|
||||
|
||||
(define/override (is-color?) #t)
|
||||
|
||||
|
||||
(define has-alpha? with-alpha?)
|
||||
(define/override (has-alpha-channel?) has-alpha?)
|
||||
|
||||
|
||||
(define/override (get-cairo-surface) s)
|
||||
(define/override (get-cairo-alpha-surface)
|
||||
(define/override (get-cairo-alpha-surface)
|
||||
(if has-alpha?
|
||||
s
|
||||
(super get-cairo-alpha-surface)))
|
||||
|
||||
|
||||
(define/override (release-bitmap-storage)
|
||||
(atomically
|
||||
(when s
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user