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

racket/draw: fix get-argb-pixels for unscaled and just-alpha

Browse Source 
Closes PR 14653

Merge to v6.1
(cherry picked from commit 295cb46c48)
This commit is contained in:
Matthew Flatt 2014-07-23 08:40:11 +01:00 committed by Ryan Culpepper
parent 26835dbb59
commit 6a44b8aaf8
2 changed files with 13 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
pkgs/draw-pkgs/draw-lib/racket/draw/private/bitmap.rkt
View File

@ -769,7 +769,7 @@
(unsafe-bytes-set! bstr (+ pi 3) (unmult (unsafe-bytes-ref data (+ ri B)))))))))))))
(cond
[get-alpha?
(get-alphas-as-mask x y w h bstr)]
(get-alphas-as-mask x y w h bstr width height)]
[(and (not get-alpha?) (not alpha-channel?))
;; For non-alpha mode and no alpha channel; fill in 255s for alpha:
(for ([j (in-range 0 (min h (- height y)))])
@ -876,7 +876,7 @@
(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)
(define/public (get-alphas-as-mask x y w h bstr width height)
(let ([data (cairo_image_surface_get_data (if (or b&w? alpha-channel?)
(begin
(cairo_surface_flush s)

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

@ -763,6 +763,7 @@
(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)
@ -772,6 +773,16 @@
(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 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))
(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)