diff --git a/collects/2htdp/image.rkt b/collects/2htdp/image.rkt index 3df69cebd0..d1de83cc4f 100644 --- a/collects/2htdp/image.rkt +++ b/collects/2htdp/image.rkt @@ -132,6 +132,7 @@ and they all have good sample contracts. (It is amazing what we can do with kids pen? step-count? save-image + save-svg-image freeze bitmap/url) diff --git a/collects/2htdp/private/image-more.rkt b/collects/2htdp/private/image-more.rkt index a63a62928a..092d271620 100644 --- a/collects/2htdp/private/image-more.rkt +++ b/collects/2htdp/private/image-more.rkt @@ -76,6 +76,21 @@ (send bdc set-bitmap #f) (send bm save-file filename 'png))) +(define/chk (save-svg-image image + filename + [width (if (image? image) (image-width image) 0)] + [height (if (image? image) (image-height image) 0)]) + (call-with-output-file filename + (λ (port) + (define sdc (new svg-dc% [width width] [height height] [output port])) + (send sdc start-doc "") + (send sdc start-page) + (send sdc set-smoothing 'aligned) + (render-image image sdc 0 0) + (send sdc end-page) + (send sdc end-doc)) + #:exists 'truncate)) + (define (get-right img) (bb-right (send img get-bb))) (define (get-bottom img) (bb-bottom (send img get-bb))) (define (get-baseline img) (bb-baseline (send img get-bb))) @@ -1423,6 +1438,7 @@ save-image + save-svg-image bring-between diff --git a/collects/2htdp/tests/test-image.rkt b/collects/2htdp/tests/test-image.rkt index 4a20cd227b..c5e9df09a5 100644 --- a/collects/2htdp/tests/test-image.rkt +++ b/collects/2htdp/tests/test-image.rkt @@ -2031,6 +2031,9 @@ (test/exn (save-image "tri.png" (triangle 50 "solid" "purple")) => #rx"^save-image:") +(test/exn (save-svg-image "tri.png" (triangle 50 "solid" "purple")) + => + #rx"^save-svg-image:") (test/exn (pen 1 2 3 4 5) => diff --git a/collects/teachpack/2htdp/scribblings/image.scrbl b/collects/teachpack/2htdp/scribblings/image.scrbl index a0372f14db..8ead596572 100644 --- a/collects/teachpack/2htdp/scribblings/image.scrbl +++ b/collects/teachpack/2htdp/scribblings/image.scrbl @@ -1652,12 +1652,19 @@ are not lost if the image is later clipped to its bounding box. In order to use an image as an input to another program (e.g., Photoshop or a web browser), it is necessary to represent it in a format that these programs -can understand. The @racket[save-image] function provides this functionality, +can understand. + +The @racket[save-image] function provides this functionality, writing an image to disk using the @tt{PNG} format. Since this format represents an image using a set of pixel values, an image written to disk generally contains less information than the image that was written, and cannot be scaled or manipulated as cleanly (by any image program). +The @racket[save-svg-image] function writes an @tt{SVG} file format +representation of the file to the disk that, unlike @racket[save-image] produces +an image that can still be scaled arbitrarily look as good as scaling the +image directly via @racket[scale]. + @defproc[(save-image [image image?] [filename path-string?] [width @@ -1675,5 +1682,20 @@ or manipulated as cleanly (by any image program). } +@defproc[(save-svg-image [image image?] + [filename path-string?] + [width + (and/c real? (not/c negative?)) + (image-width image)] + [height + (and/c real? (not/c negative?)) + (image-height image)]) + void?]{ + Writes an image to the path specified by @racket[filename], using the + @tt{SVG} format. + + The last two arguments are optional. If present, they determine the width + and height of the save image file. If absent, the width and height of the image is used. + } @(close-eval img-eval)