[plt-scheme] Re : interaction bug of draw-bitmap set-scale and get-loaded-mask

Well, sorry for the delay in getting back to this. I definitely agree
that you've found a bug. I hope you don't mind: I've gone ahead and
submitted a bug report and put you in as an interested party.

 http://bugs.plt-scheme.org/query/?cmd=view&pr=10770

Robby

On Sun, Jan 10, 2010 at 1:30 PM, stephane bonnet <stefanbonnet at yahoo.fr> wrote:
> 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)
>