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

2htdp/image: relax the constraints on 'crop' so that you can crop outside the bounding box

Browse Source
This commit is contained in:
Robby Findler 2011-02-21 05:28:37 -06:00
parent c1668d894e
commit 6fff26ad12
3 changed files with 30 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -376,19 +376,7 @@
;; crop : number number number number image -> image
;; crops an image to be w x h from (x,y)
(define/chk (crop x1 y1 width height image)
(check-arg 'crop
(<= 0 x1 (image-width image))
(format "number that is between 0 than the width (~a)" (image-width image))
1
x1)
(check-arg 'crop
(<= 0 y1 (image-height image))
(format "number that is between 0 and the height (~a)" (image-height image))
2
y1)
(let ([w (min width (- (image-width image) x1))]
[h (min height (- (image-height image) y1))])
(crop/internal x1 y1 w h image)))
(crop/internal x1 y1 width height image))
(define (crop/internal x1 y1 width height image)
(let ([points (rectangle-points width height)]

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

@ -1507,15 +1507,18 @@
=>
(count-crops (normalize-shape (image-shape an-image+crop)))))
(check-exn #rx"crop" (λ () (crop 100 100 10 10 (rectangle 20 20 "solid" "black"))))
(check-exn #rx"crop" (λ () (crop 9 100 10 10 (rectangle 20 20 "solid" "black"))))
(check-exn #rx"crop" (λ () (crop 100 9 10 10 (rectangle 20 20 "solid" "black"))))
(check-exn #rx"crop" (λ () (crop -9 9 10 10 (rectangle 20 20 "solid" "black"))))
(check-exn #rx"crop" (λ () (crop 9 -9 10 10 (rectangle 20 20 "solid" "black"))))
(test (crop 20 20 100 100 (rectangle 40 40 "solid" "black"))
(test (image-width (crop 0 0 101 61 (rectangle 100 60 'outline 'black)))
=>
(rectangle 20 20 "solid" "black"))
101)
(test (image-height (crop 0 0 101 61 (rectangle 100 60 'outline 'black)))
=>
61)
(test (image-width (crop -1 -1 12 12 (rectangle 10 10 'outline (pen "black" 2 "solid" "round" "round"))))
=>
12)
(test (image-height (crop -1 -1 12 12 (rectangle 10 10 'outline (pen "black" 4 "solid" "round" "round"))))
=>
12)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;

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

@ -1141,8 +1141,8 @@ the parts that fit onto @racket[scene].
(scale/xy 1 1/2 (flip-vertical (star 40 "solid" "gray"))))]
}
@defproc[(crop [x (and/c real? (between/c 0 (image-width image)))]
[y (and/c real? (between/c 0 (image-height image)))]
@defproc[(crop [x real?]
[y real?]
[width (and/c real? (not/c negative?))]
[height (and/c real? (not/c negative?))]
[image image?])
@ -1151,9 +1151,6 @@ the parts that fit onto @racket[scene].
Crops @racket[image] to the rectangle with the upper left at the point (@racket[x],@racket[y])
and with @racket[width] and @racket[height].
The @racket[x] and @racket[y] arguments must be between 0 and
the @racket[width] or @racket[height], respectively.
@image-examples[(crop 0 0 40 40 (circle 40 "solid" "chocolate"))
(crop 40 60 40 60 (ellipse 80 120 "solid" "dodgerblue"))
(above
@ -1288,13 +1285,27 @@ more expensive than with the other shapes.
@defproc[(image-baseline [i image?]) (and/c integer? (not/c negative?) exact?)]{
Returns the distance from the top of the image to its baseline.
Unless the image was constructed with @racket[text] or @racket[text/font],
this will be the same as its height.
Unless the image was constructed with @racket[text], @racket[text/font]
or, in some cases, @racket[crop], this will be the same as its height.
@image-examples[(image-baseline (text "Hello" 24 "black"))
(image-height (text "Hello" 24 "black"))
(image-baseline (rectangle 100 100 "solid" "black"))
(image-height (rectangle 100 100 "solid" "black"))]
A @racket[crop]ped image's baseline is the same as the image's baseline, if the
cropping stays within the original image's bounding box. But if the cropping actually
enlarges the image, then the baseline can end up being smaller.
@image-examples[(image-height (rectangle 20 20 "solid" "black"))
(image-baseline (rectangle 20 20 "solid" "black"))
(image-height (crop 10 10 5 5 (rectangle 20 20 "solid" "black")))
(image-baseline (crop 10 10 5 5 (rectangle 20 20 "solid" "black")))
(image-height (crop 10 10 30 30 (rectangle 20 20 "solid" "black")))
(image-baseline (crop 10 10 30 30 (rectangle 20 20 "solid" "black")))]
}
@section{Image Predicates}