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

change save-bitmap in 2htdp/image so that is uses the width and height of the image by default, but also so it accepts two optional arguments to change that.

Browse Source
This commit is contained in:
Robby Findler 2010-10-28 16:55:37 -05:00
parent 6a414bd18a
commit 3782c2e749
3 changed files with 34 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/2htdp/private/image-more.rkt
View File

@ -57,10 +57,10 @@
[parent bp]) min-width 100) [parent bp]) min-width 100)
(send f show #t))) (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% (let* ([bm (make-object bitmap%
(inexact->exact (ceiling (+ 1 (get-right image)))) (inexact->exact (ceiling width))
(inexact->exact (ceiling (+ 1 (get-bottom image)))))] (inexact->exact (ceiling height)))]
[bdc (make-object bitmap-dc% bm)]) [bdc (make-object bitmap-dc% bm)])
(send bdc set-smoothing 'aligned) (send bdc set-smoothing 'aligned)
(send bdc clear) (send bdc clear)

16
collects/2htdp/private/img-err.rkt
View File

@ -53,9 +53,21 @@
final-arg)]) final-arg)])
body ...))))] body ...))))]
[(define/chk (fn-name args ...) 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 ...) #'(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 ...)))]))) body ...)))])))
(define (map/i f l) (define (map/i f l)

21
collects/teachpack/2htdp/scribblings/image.scrbl
View File

@ -1443,7 +1443,7 @@ are not lost if the image is later clipped to its bounding box.
@;----------------------------------------------------------------------------- @;-----------------------------------------------------------------------------
@section{Exporting Images to Disk} @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 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 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 generally contains less information than the image that was written, and cannot be scaled
or manipulated as cleanly (by any image program). or manipulated as cleanly (by any image program).
@defproc[(save-image [image image?] [filename path-string?]) boolean?]{ @defproc[(save-image [image image?]
writes an image to the path specified by @racket[filename], using the [filename path-string?]
@tt{PNG} format.} [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.
}