fix alpha-only mode of `get-argb-pixels'

Closes PR 11927
This commit is contained in:
Matthew Flatt 2011-05-17 15:49:21 -07:00
parent b65054134a
commit 905eb11651
3 changed files with 31 additions and 2 deletions

View File

@ -718,7 +718,7 @@
(for ([j (in-range y (min (+ y h) height))])
(let ([row (* j row-width)])
(for ([i (in-range x (min (+ x w) width))])
(let ([p (* 4 (+ i (* j w)))]
(let ([p (* 4 (+ (- i x) (* (- j y) w)))]
[q (+ row (* i 4))])
(bytes-set! bstr p (bytes-ref data (+ q A)))))))))

View File

@ -76,7 +76,8 @@ The pixel RGB values are copied into @scheme[pixels]. The first byte
If @scheme[alpha?] is false, if the bitmap does not have an alpha
channel, then the alpha value for each pixel is set to 255. If
@scheme[alpha?] is true, then @italic{only} the alpha value is set
for each pixel, based on each pixel's inverted value. Thus, when a
for each pixel; if the bitmap has no alpha channel, then the alpha
value is based on each pixel's inverted RGB average. Thus, when a
bitmap has a separate mask bitmap, the same @scheme[pixels] byte
string is in general filled from two bitmaps: one (the main image)
for the pixel values and one (the mask) for the alpha values.

View File

@ -365,4 +365,32 @@
;; ----------------------------------------
(let ()
(define (get-column-alpha bm x y)
(define bs (make-bytes 4))
(send bm get-argb-pixels x y 1 1 bs #t)
bs)
(define abm (make-object bitmap% 2 2 #f #t))
(define nbm (make-object bitmap% 2 2 #f #f))
(define (avg bstr) (- 255
(quotient (+ (bytes-ref bstr 0)
(bytes-ref bstr 1)
(bytes-ref bstr 2))
3)))
(send abm set-argb-pixels 0 0 2 2 #"0123456789abcdef")
(send nbm set-argb-pixels 0 0 2 2 #"0123456789abcdef")
(test (bytes (char->integer #\0) 0 0 0) 'a0+0 (get-column-alpha abm 0 0))
(test (bytes (char->integer #\4) 0 0 0) 'a1+0 (get-column-alpha abm 1 0))
(test (bytes (char->integer #\8) 0 0 0) 'a0+1 (get-column-alpha abm 0 1))
(test (bytes (char->integer #\c) 0 0 0) 'a1+1 (get-column-alpha abm 1 1))
(test (bytes (avg #"123") 0 0 0) 'n0+0 (get-column-alpha nbm 0 0))
(test (bytes (avg #"567") 0 0 0) 'n1+0 (get-column-alpha nbm 1 0))
(test (bytes (avg #"9ab") 0 0 0) 'n0+1 (get-column-alpha nbm 0 1))
(test (bytes (avg #"def") 0 0 0) 'n1+1 (get-column-alpha nbm 1 1)))
;; ----------------------------------------
(report-errs)