diff --git a/collects/tests/gracket/dc.rktl b/collects/tests/gracket/dc.rktl index 7213989f6a..cfff7e84ee 100644 --- a/collects/tests/gracket/dc.rktl +++ b/collects/tests/gracket/dc.rktl @@ -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)