From 56b82ba83c5d29afaafbed602c8e14873a14f953 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Fri, 22 Jul 2011 08:09:17 -0500 Subject: [PATCH] fix the png conversion code for 2htdp/image images closes PR 12061 please merge to the release branch --- collects/2htdp/tests/test-image.rkt | 14 ++++++++++++-- collects/mrlib/image-core.rkt | 4 ++-- 2 files changed, 14 insertions(+), 4 deletions(-) diff --git a/collects/2htdp/tests/test-image.rkt b/collects/2htdp/tests/test-image.rkt index 083dd16fe2..4a20cd227b 100644 --- a/collects/2htdp/tests/test-image.rkt +++ b/collects/2htdp/tests/test-image.rkt @@ -2194,8 +2194,18 @@ (test (convertible? (circle 20 "solid" "red")) => #t) (test (bytes? (convert (circle 20 "solid" "red") 'png-bytes)) => #t) - - +(let () + (define tmpfile (make-temporary-file "2htdpimage-test-~a")) + (define i (circle 15 "solid" "red")) + (call-with-output-file tmpfile + (lambda (p) + (display (convert i 'png-bytes) p)) + #:exists 'truncate) + (define i2 (rotate 0 (read-bitmap tmpfile))) ;; add rotate to be sure we get an image so that equal? works properly + (delete-file tmpfile) + (test (image-width i2) => 30) + (test (image-height i2) => 30) + (test i2 => i)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; diff --git a/collects/mrlib/image-core.rkt b/collects/mrlib/image-core.rkt index c90e337685..a22a338805 100644 --- a/collects/mrlib/image-core.rkt +++ b/collects/mrlib/image-core.rkt @@ -231,8 +231,8 @@ has been moved out). (define (to-bitmap img) (let* ([bb (send img get-bb)] [bm (make-bitmap - (add1 (inexact->exact (ceiling (bb-right bb)))) - (add1 (inexact->exact (ceiling (bb-bottom bb)))))] + (inexact->exact (ceiling (bb-right bb))) + (inexact->exact (ceiling (bb-bottom bb))))] [bdc (new bitmap-dc% [bitmap bm])]) (send bdc erase) (render-image img bdc 0 0)