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

test for draw-bitmap repairs

Browse Source
This commit is contained in:
Matthew Flatt 2010-12-16 19:30:36 -07:00
parent 2ce5c63ea8
commit f8ec47cdeb
1 changed files with 46 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
collects/tests/gracket/dc.rktl
View File

@ -218,6 +218,52 @@
(send bm3 get-argb-pixels 0 0 70 70 s3)
(test #t 'same-scaled (equal? s2 s3))))
;; ----------------------------------------
;; Test some masking combinations
(let ()
(define u (make-object bitmap% 2 2))
(define mu (make-object bitmap% 2 2))
(send u set-argb-pixels 0 0 2 2
(bytes 255 100 0 0
255 0 0 0
255 100 0 0
255 0 0 0))
(send mu set-argb-pixels 0 0 2 2
(bytes 255 0 0 0
255 255 255 255
255 0 0 0
255 255 255 255))
(send u set-loaded-mask mu)
(define (try-draw nonce-color b&w?)
(let* ((bm (make-object bitmap% 2 2 b&w?))
(dc (make-object bitmap-dc% bm)))
(send dc clear)
;; Check that draw-bitmap-section really uses the
;; section, even in combination with a mask.
(send dc draw-bitmap-section u 0 0 0 0 2 1
'solid nonce-color (send u get-loaded-mask))
(send dc set-bitmap #f)
(let ([s (make-bytes (* 2 2 4))])
(send bm get-argb-pixels 0 0 2 2 s)
(when b&w? (send bm get-argb-pixels 0 0 2 2 s #t))
(test (if b&w?
;; For b&w destination, check that the
;; alpha is consistent with the drawn pixels
(bytes 255 0 0 0
0 255 255 255
0 255 255 255
0 255 255 255)
(bytes 255 100 0 0
255 255 255 255
255 255 255 255
255 255 255 255))
'masked-draw
s))))
(try-draw (make-object color% "green") #f)
(try-draw (make-object color%) #f)
(try-draw (make-object color%) #t))
;; ----------------------------------------
(report-errs)