suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix the png conversion code for 2htdp/image images

Browse Source 
closes PR 12061
  please merge to the release branch
This commit is contained in:
Robby Findler 2011-07-22 08:09:17 -05:00
parent f7f3971d15
commit 56b82ba83c
2 changed files with 14 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/2htdp/tests/test-image.rkt
View File

@ -2194,8 +2194,18 @@
(test (convertible? (circle 20 "solid" "red")) => #t) (test (convertible? (circle 20 "solid" "red")) => #t)
(test (bytes? (convert (circle 20 "solid" "red") 'png-bytes)) => #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))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;

4
collects/mrlib/image-core.rkt
View File

@ -231,8 +231,8 @@ has been moved out).
(define (to-bitmap img) (define (to-bitmap img)
(let* ([bb (send img get-bb)] (let* ([bb (send img get-bb)]
[bm (make-bitmap [bm (make-bitmap
(add1 (inexact->exact (ceiling (bb-right bb)))) (inexact->exact (ceiling (bb-right bb)))
(add1 (inexact->exact (ceiling (bb-bottom bb)))))] (inexact->exact (ceiling (bb-bottom bb))))]
[bdc (new bitmap-dc% [bitmap bm])]) [bdc (new bitmap-dc% [bitmap bm])])
(send bdc erase) (send bdc erase)
(render-image img bdc 0 0) (render-image img bdc 0 0)