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

improved crop so that it doesn't fail when the coordinates are out of range

Browse Source
This commit is contained in:
Robby Findler 2010-08-22 15:12:10 -05:00
parent 46e9a3b79b
commit 720a86052f
3 changed files with 33 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -280,7 +280,19 @@
;; 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)
(crop/internal x1 y1 width height image))
(check-arg 'crop
(x1 . <= . (image-width image))
(format "number that is smaller than the width (~a)" (image-width image))
1
x1)
(check-arg 'crop
(y1 . <= . (image-height image))
(format "number that is smaller than the width (~a)" (image-width 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)))
(define (crop/internal x1 y1 width height image)
(let* ([iw (min width (get-right image))]
@ -999,16 +1011,10 @@
(polar->posn b A))))
(polygon (triangle-vertices/saa side-a (radians angle-b) (radians angle-c)) mode color))
(define/chk (regular-polygon side-length side-count mode color)
(check-mode/color-combination 'regular-polygon 4 mode color)
(make-polygon/star side-length side-count mode color values))
(define/chk (star-polygon side-length side-count step-count mode color)
(check-mode/color-combination 'star-polygon 5 mode color)
(check-arg 'star-polygon

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

@ -1354,6 +1354,7 @@
;; this test case checks to make sure the number of crops doesn't
;; grow when normalizing shapes.
(let* ([an-image
(crop
0 0 50 50
@ -1369,7 +1370,7 @@
(ellipse 20 50 'solid 'red)
(ellipse 30 40 'solid 'black))))))]
[an-image+crop
(crop 40 40 10 10 an-image)])
(crop 5 5 10 10 an-image)])
(define (count-crops s)
(define crops 0)
@ -1384,6 +1385,13 @@
=>
(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"))))
(test (crop 20 20 100 100 (rectangle 40 40 "solid" "black"))
=>
(rectangle 20 20 "solid" "black"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; flipping
@ -1613,7 +1621,12 @@
(overlay/xy image coord coord image)
(underlay image image)
(underlay/xy image coord coord image)
(crop coord coord size size image)
(let ([i image])
(crop (min (image-width i) coord)
(min (image-height i) coord)
size
size
i))
(scale/xy factor factor image)
(scale factor image)
(rotate angle image)

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

@ -1019,7 +1019,8 @@ the parts that fit onto @racket[scene].
(scale/xy 1 1/2 (flip-vertical (star 40 "solid" "gray"))))]
}
@defproc[(crop [x real?] [y real?]
@defproc[(crop [x (and/c real? (<=/c (image-width image)))]
[y (and/c real? (<=/c (image-height image)))]
[width (and/c real? (not/c negative?))]
[height (and/c real? (not/c negative?))]
[image image?])
@ -1028,6 +1029,9 @@ 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 smaller than or equal to
the @racket[width] and @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