diff --git a/collects/2htdp/private/image-more.rkt b/collects/2htdp/private/image-more.rkt index 2603cc3d73..1ce973b429 100644 --- a/collects/2htdp/private/image-more.rkt +++ b/collects/2htdp/private/image-more.rkt @@ -57,10 +57,10 @@ [parent bp]) min-width 100) (send f show #t))) -(define/chk (save-image image filename) +(define/chk (save-image image filename [width (image-width image)] [height (image-height image)]) (let* ([bm (make-object bitmap% - (inexact->exact (ceiling (+ 1 (get-right image)))) - (inexact->exact (ceiling (+ 1 (get-bottom image)))))] + (inexact->exact (ceiling width)) + (inexact->exact (ceiling height)))] [bdc (make-object bitmap-dc% bm)]) (send bdc set-smoothing 'aligned) (send bdc clear) diff --git a/collects/2htdp/private/img-err.rkt b/collects/2htdp/private/img-err.rkt index b7d8be9bea..2c1d42fd25 100644 --- a/collects/2htdp/private/img-err.rkt +++ b/collects/2htdp/private/img-err.rkt @@ -53,9 +53,21 @@ final-arg)]) body ...))))] [(define/chk (fn-name args ...) body ...) - (with-syntax ([(i ...) (build-list (length (syntax->list #'(args ...))) add1)]) + (with-syntax ([(i ...) (build-list (length (syntax->list #'(args ...))) add1)] + [(arg-ids ...) + (map (λ (arg) + (syntax-case arg () + [x + (identifier? #'x) + #'x] + [(x y) + (identifier? #'x) + #'x] + [_ + (raise-syntax-error 'define/chk "unknown argument spec" stx arg)])) + (syntax->list #'(args ...)))]) #'(define (fn-name args ...) - (let ([args (check/normalize 'fn-name 'args args i)] ...) + (let ([arg-ids (check/normalize 'fn-name 'arg-ids arg-ids i)] ...) body ...)))]))) (define (map/i f l) diff --git a/collects/teachpack/2htdp/scribblings/image.scrbl b/collects/teachpack/2htdp/scribblings/image.scrbl index bf292c5056..60c23e1a98 100644 --- a/collects/teachpack/2htdp/scribblings/image.scrbl +++ b/collects/teachpack/2htdp/scribblings/image.scrbl @@ -1443,7 +1443,7 @@ are not lost if the image is later clipped to its bounding box. @;----------------------------------------------------------------------------- @section{Exporting Images to Disk} -In order to use an image as an input to another program (Photoshop, e.g., or +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, writing an image to disk using the @tt{PNG} format. Since this @@ -1451,8 +1451,21 @@ 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). -@defproc[(save-image [image image?] [filename path-string?]) boolean?]{ - writes an image to the path specified by @racket[filename], using the - @tt{PNG} format.} +@defproc[(save-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)]) + boolean?]{ + Writes an image to the path specified by @racket[filename], using the + @tt{PNG} 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. + + }