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

support svg-bytes for 2htdp/image images

Browse Source
This commit is contained in:
Robby Findler 2013-10-15 11:29:20 -05:00
parent 5508e4fc58
commit 6e062466a0
1 changed files with 14 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
pkgs/gui-pkgs/gui-lib/mrlib/image-core.rkt
View File

@ -238,6 +238,7 @@ has been moved out).
(let ([s (open-output-bytes)])
(send (to-bitmap (to-img img)) save-file s 'png)
(get-output-bytes s))]
[(svg-bytes) (to-svg-bytes img)]
[else default]))]
[prop:pict-convertible
(λ (image)
@ -267,6 +268,19 @@ has been moved out).
(send bdc set-bitmap #f)
bm)
(define (to-svg-bytes img)
(define bb (send img get-bb))
(define w (min (inexact->exact (ceiling (bb-right bb))) maximum-width))
(define h (min (inexact->exact (ceiling (bb-bottom bb))) maximum-height))
(define s (open-output-bytes))
(define svg-dc (new svg-dc% [width w] [height h] [output s]))
(send svg-dc start-doc "")
(send svg-dc start-page)
(render-image img svg-dc 0 0)
(send svg-dc end-page)
(send svg-dc end-doc)
(get-output-bytes s))
(define-local-member-name
set-use-bitmap-cache?!
set-cached-bitmap