diff --git a/pkgs/gui-pkgs/gui-lib/mrlib/image-core.rkt b/pkgs/gui-pkgs/gui-lib/mrlib/image-core.rkt index f3e96fc38c..2ccb2d9333 100644 --- a/pkgs/gui-pkgs/gui-lib/mrlib/image-core.rkt +++ b/pkgs/gui-pkgs/gui-lib/mrlib/image-core.rkt @@ -943,7 +943,9 @@ has been moved out). (define bw (send bitmap-obj get-width)) (define bh (send bitmap-obj get-height)) - (send dc translate (- (/ bw 2)) (- (/ bh 2))) + (send dc translate + (* (ibitmap-x-scale bitmap) (- (/ bw 2))) + (* (ibitmap-y-scale bitmap) (- (/ bh 2)))) (send dc set-scale (ibitmap-x-scale bitmap) (ibitmap-y-scale bitmap)) (send dc draw-bitmap bitmap-obj 0 0) diff --git a/pkgs/htdp-pkgs/htdp-lib/2htdp/tests/test-image.rkt b/pkgs/htdp-pkgs/htdp-lib/2htdp/tests/test-image.rkt index c502e6f456..86d2f44673 100644 --- a/pkgs/htdp-pkgs/htdp-lib/2htdp/tests/test-image.rkt +++ b/pkgs/htdp-pkgs/htdp-lib/2htdp/tests/test-image.rkt @@ -1474,6 +1474,31 @@ (test (equal? (rotate 0 i1) i2) => #t) (test (equal? i1 (rotate 0 i2)) => #t)) + +;; this test case checks for broken behavior in scaled, translated +;; bitmaps whereby the translation amount isn't scaled properly so +;; the bitmap goes in the wrong place (and thus the buggy would +;; not equate the two images, since the bitmap would be in +;; the bounding box (where it wasn't supposed to be)) +(let () + (define img (make-object bitmap% 200 200)) + (define bdc (make-object bitmap-dc% img)) + (send bdc erase) + (send bdc set-brush "black" 'solid) + (send bdc set-pen "black" 1 'transparent) + (send bdc draw-rectangle 0 0 200 200) + (send bdc set-bitmap #f) + + (test (equal? (place-image (scale .1 (overlay (circle 60 'solid 'red) img)) + 120 120 + (rectangle 100 100 'solid 'white)) + (place-image (scale .1 (circle 60 'solid 'red)) + 120 120 + (rectangle 100 100 'solid 'white))) + => + #t)) + + (define-runtime-path u.png "u.png") (let () (define i (rotate 0 (make-object bitmap% u.png 'unknown/mask)))