[plt-scheme] Re : interaction bug of draw-bitmap set-scale and get-loaded-mask
here's an ugly/lazy illustration (from its matched code...) :
#lang scheme/gui
(define gray (send the-color-database find-color "gray"))
(define misspelled-gray (make-object color% 158 158 150))
(define black (send the-color-database find-color "black"))
(define white (send the-color-database find-color "white"))
(define red (send the-color-database find-color "red"))
(define blue (send the-color-database find-color "blue"))
;you can play around with those, for maximum effect :
(define background-color black)
(define different-background-color white)
(define pen-color white)
(define pen-size 0)
(define image-name "essai.png")
(define image-path (build-path (find-system-path 'desk-dir) image-name))
(define image (make-object bitmap% 500 500))
(define mask (make-object bitmap% (send image get-width) (send image get-height)))
(define image-dc (instantiate bitmap-dc% (image)))
(define mask-dc (instantiate bitmap-dc% (mask)))
(define draw-pen (make-object pen% pen-color pen-size 'solid))
(define mask-pen (make-object pen% black pen-size 'solid))
(define draw-brush (make-object brush% red 'transparent))
(define mask-brush (make-object brush% black 'transparent))
(send image-dc set-pen draw-pen)
(send image-dc set-brush draw-brush)
(send mask-dc set-pen mask-pen)
(send mask-dc set-brush mask-brush)
(send image-dc set-background background-color)
(send image-dc clear)
(send mask-dc set-background white)
(send mask-dc clear)
(send mask-dc set-smoothing 'unsmoothed)
(send image-dc set-smoothing 'unsmoothed)
(send image-dc draw-rectangle 50 50 400 400)
(send mask-dc draw-rectangle 50 50 400 400)
(send image set-loaded-mask mask)
(send image save-file image-path 'png)
(send image-dc set-bitmap #f)
(send image load-file image-path 'png/mask)
(define scale 0.5)
(define (draw dc)
(send dc set-scale scale scale)
(send dc draw-bitmap image 0 0 'solid black mask))
(define (draw-with-get-loaded-mask dc)
(send dc set-scale scale scale)
(send dc draw-bitmap image 0 0 'solid black (send image get-loaded-mask)))
(define f (new frame% (label "same-color/mask") (x 0) (y 0)))
(define c (new canvas%
(parent f)
(min-width (inexact->exact (* scale (send mask get-width))))
(min-height (inexact->exact (* scale (send mask get-height))))
(paint-callback
(λ (c dc) (begin (send dc set-background background-color)
(send dc clear)
(draw dc))))))
(define f1 (new frame% (label "same-color/get-loaded") (x (inexact->exact (* scale (send mask get-width)))) (y 0)))
(define c1 (new canvas%
(parent f1)
(min-width (inexact->exact (* scale (send mask get-width))))
(min-height (inexact->exact (* scale (send mask get-height))))
(paint-callback
(λ (c dc) (begin (send dc set-background background-color)
(send dc clear)
(draw-with-get-loaded-mask dc))))))
(define f2 (new frame% (label "different-color/get-loaded") (x (inexact->exact (* 2 scale (send mask get-width)))) (y 0)))
(define c2 (new canvas%
(parent f2)
(min-width (inexact->exact (* scale (send mask get-width))))
(min-height (inexact->exact (* scale (send mask get-height))))
(paint-callback
(λ (c dc) (begin (send dc set-background different-background-color)
(send dc clear)
(draw-with-get-loaded-mask dc))))))
(define f3 (new frame% (label "different-color/mask") (x (inexact->exact (* 3 scale (send mask get-width)))) (y 0)))
(define c3 (new canvas%
(parent f3)
(min-width (inexact->exact (* scale (send mask get-width))))
(min-height (inexact->exact (* scale (send mask get-height))))
(paint-callback
(λ (c dc) (begin (send dc set-background different-background-color)
(send dc clear)
(draw dc))))))
(send f show #t)
(send f1 show #t)
(send f2 show #t)
(send f3 show #t)