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

racket/draw: fix problems with set-argb-pixels on scaled, no-alpha bitmaps

Browse Source 
Also, fix the docs to clarify that `just-alpha?` as #t means a no-op for
a target bitmap that has an alpha channel.

original commit: a1147335597ef2879ad19678e067a62a6b930973
This commit is contained in:
Matthew Flatt 2014-07-23 09:15:27 +01:00
parent 1deb80b255
commit 4c71b5d039
1 changed files with 50 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

84
pkgs/gui-pkgs/gui-test/tests/gracket/dc.rktl
View File

@ -754,46 +754,62 @@
;; -----------------------------------------------------------
;; Check pixel operations on a bitmap with a x2 backing scale
(let ([bm (make-bitmap 10 11 #:backing-scale 2)])
(test 2.0 'scale (send bm get-backing-scale))
(test 10 'width (send bm get-width))
(test 11 'height (send bm get-height))
(define (scaled-bm-test alpha?)
(let ([bm (make-bitmap 10 11 alpha? #:backing-scale 2)])
(test 2.0 'scale (send bm get-backing-scale))
(test 10 'width (send bm get-width))
(test 11 'height (send bm get-height))
(define dc (send bm make-dc))
(send dc set-pen "black" 0 'transparent)
(send dc set-brush (make-color 100 100 200) 'solid)
(send dc draw-rectangle 0 0 3 3)
(send dc draw-rectangle 9 9 1 1)
(define dc (send bm make-dc))
(send dc set-pen "black" 0 'transparent)
(send dc set-brush (make-color 100 100 200) 'solid)
(send dc draw-rectangle 0 0 3 3)
(send dc draw-rectangle 9 9 1 1)
(let ([s (make-bytes 4)])
(send bm get-argb-pixels 2 2 1 1 s)
(test (list 255 100 100 200) 'scaled (bytes->list s))
(send bm get-argb-pixels 4 4 1 1 s)
(test 0 'scaled (bytes-ref s 0))
(send bm get-argb-pixels 2 2 1 1 s #:unscaled? #t)
(test (list 255 100 100 200) 'unscaled (bytes->list s))
(let ([s (make-bytes 4)])
(send bm get-argb-pixels 2 2 1 1 s)
(test (list 255 100 100 200) 'scaled (bytes->list s))
(send bm get-argb-pixels 4 4 1 1 s)
(test (if alpha? 0 255) 'scaled (bytes-ref s 0))
(send bm get-argb-pixels 2 2 1 1 s #:unscaled? #t)
(test (list 255 100 100 200) 'unscaled (bytes->list s))
(bytes-copy! s 0 (bytes 0 1 2 3))
(send bm get-argb-pixels 2 2 1 1 s #:unscaled? #t 'just-alpha)
(test (list 255 1 2 3) 'unscaled-alpha (bytes->list s))
(bytes-copy! s 0 (bytes 0 1 2 3))
(send bm get-argb-pixels 2 2 1 1 s #:unscaled? #t 'just-alpha)
;; for (not alpha?), 122 is the mask equivalent of the brush color
(test (list (if alpha? 255 122) 1 2 3) 'unscaled-alpha (bytes->list s))
(bytes-copy! s 0 (bytes 0 1 2 3))
(send bm get-argb-pixels 9 9 1 1 s #:unscaled? #t 'just-alpha)
(test (list 0 1 2 3) 'unscaled-alpha-miss (bytes->list s))
(send bm get-argb-pixels 18 18 1 1 s #:unscaled? #t 'just-alpha)
(test (list 255 1 2 3) 'unscaled-alpha-hit (bytes->list s))
(bytes-copy! s 0 (bytes 0 1 2 3))
(send bm get-argb-pixels 9 9 1 1 s #:unscaled? #t 'just-alpha)
(test (list 0 1 2 3) 'unscaled-alpha-miss (bytes->list s))
(send bm get-argb-pixels 18 18 1 1 s #:unscaled? #t 'just-alpha)
(test (list (if alpha? 255 122) 1 2 3) 'unscaled-alpha-hit (bytes->list s))
(send bm set-argb-pixels 0 0 2 1 #"\xff\x0\x0\x0\xff\x0\x0\x0"
#:unscaled? #t)
(send bm get-argb-pixels 0 0 1 1 s #:unscaled? #t)
(test (list 255 0 0 0) 'unscaled (bytes->list s))
;; scaled is average of black and blue:
(send bm get-argb-pixels 0 0 1 1 s)
(test (list 255 50 50 100) 'scaled (bytes->list s))
(send bm set-argb-pixels 0 0 2 1 #"\xff\x0\x0\x0\xff\x0\x0\x0"
#:unscaled? #t)
(send bm get-argb-pixels 0 0 1 1 s #:unscaled? #t)
(test (list 255 0 0 0) 'unscaled (bytes->list s))
;; scaled is average of black and blue:
(send bm get-argb-pixels 0 0 1 1 s)
(test (list 255 50 50 100) 'scaled (bytes->list s))
(send bm set-argb-pixels 0 0 2 1 #"\xff\x0\x0\x0\xff\x0\x0\x0")
(send bm get-argb-pixels 0 0 1 1 s)
(test (list 255 0 0 0) 'scaled (bytes->list s))))
(send bm set-argb-pixels 0 0 2 1 #"\xff\x0\x0\x0\xff\x0\x0\x0")
(send bm get-argb-pixels 0 0 1 1 s)
(test (list 255 0 0 0) 'scaled (bytes->list s))
(when (not alpha?)
(bytes-copy! s 0 (bytes 100 1 2 3))
(send bm set-argb-pixels 9 9 1 1 s #:unscaled? #t 'just-alpha)
(send bm get-argb-pixels 9 9 1 1 s #:unscaled? #t)
(test (list 255 155 155 155) 'unscaled-alpha-set (bytes->list s))
(bytes-copy! s 0 (bytes 100 1 2 3))
(send bm set-argb-pixels 18 18 1 1 s #:unscaled? #t 'just-alpha)
(send bm get-argb-pixels 18 18 1 1 s #:unscaled? #t)
(test (list 255 155 155 155) 'unscaled-alpha-set-far (bytes->list s))))))
(scaled-bm-test #t)
(scaled-bm-test #f)
(let ([p (collection-file-path "sk.jpg" "icons")])
(let ([bm1 (read-bitmap p)]