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

add place-images and place-images/align

Browse Source
This commit is contained in:
Robby Findler 2013-09-30 16:43:13 -05:00
parent f03bc18f68
commit 575ed235f0
5 changed files with 112 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
pkgs/htdp-pkgs/htdp-doc/teachpack/2htdp/scribblings/image.scrbl
View File

@ -1086,6 +1086,55 @@ a black outline.
(rectangle 32 32 "outline" "black")))]
}
@defproc[(place-images [images (listof image?)]
[posns (listof posn?)]
[scene image?])
image?]{
Places each of @racket[images] into @racket[scene] like
@racket[place-image] would, using the coordinates
in @racket[posns] as the @racket[_x]
and @racket[_y] arguments to @racket[place-image].
@crop-warning
@image-examples[(place-images
(list (circle 4 "solid" "white")
(circle 4 "solid" "white")
(circle 4 "solid" "white")
(circle 4 "solid" "white"))
(list (make-posn 18 20)
(make-posn 0 6)
(make-posn 14 2)
(make-posn 8 14))
(rectangle 24 24 "solid" "goldenrod"))]
}
@defproc[(place-images/align [images (listof image?)]
[posns (listof posn?)]
[x-place x-place?]
[y-place y-place?]
[scene image?])
image?]{
Like @racket[place-images], except that it places the images
with respect to @racket[x-place] and @racket[y-place].
@crop-warning
@image-examples[(place-images/align
(list (triangle 48 "solid" "yellowgreen")
(triangle 48 "solid" "yellowgreen")
(triangle 48 "solid" "yellowgreen")
(triangle 48 "solid" "yellowgreen"))
(list (make-posn 64 64)
(make-posn 64 48)
(make-posn 64 32)
(make-posn 64 16))
"right" "bottom"
(rectangle 64 64 "solid" "mediumgoldenrod"))]
}
@defproc[(scene+line [scene image?]
[x1 real?] [y1 real?]
[x2 real?] [y2 real?]

2
pkgs/htdp-pkgs/htdp-lib/2htdp/image.rkt
View File

@ -66,6 +66,8 @@ and they all have good sample contracts. (It is amazing what we can do with kids
frame
place-image
place-image/align
place-images
place-images/align
scale
scale/xy

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

@ -425,6 +425,23 @@
"when x-place or y-place is ~e or ~e, the the first image argument must have a pinhole"
'pinhole "pinhole"))
(place-image/internal image1 x1 y1 image2 x-place y-place))
(define/chk (place-images images zero-or-more-posns image2)
(check-place-images-dependency 'place-images images zero-or-more-posns)
(for/fold ([image2 image2]) ([image1 (in-list (reverse images))]
[posn (in-list (reverse zero-or-more-posns))])
(place-image/internal
image1 (posn-x posn) (posn-y posn) image2 'middle 'middle)))
(define/chk (place-images/align images zero-or-more-posns x-place y-place image2)
(check-place-images-dependency 'place-images/align images zero-or-more-posns)
(for/fold ([image2 image2]) ([image1 (in-list (reverse images))]
[posn (in-list (reverse zero-or-more-posns))])
(place-image/internal
image1 (posn-x posn) (posn-y posn) image2 x-place y-place)))
(define (check-place-images-dependency who images zero-or-more-posns)
(check-dependencies who
(= (length images) (length zero-or-more-posns))
"expected images and posns arguments to have the same length"))
(define (place-image/internal image orig-dx orig-dy scene x-place y-place)
(let ([dx (- orig-dx (find-x-spot x-place image))]
@ -1472,7 +1489,8 @@
place-image
place-image/align
place-images
place-images/align
save-image
save-svg-image

14
pkgs/htdp-pkgs/htdp-lib/2htdp/private/img-err.rkt
View File

@ -126,6 +126,9 @@
i
arg)
(to-img arg)]
[(images)
(check-arg fn-name (and (list? arg) (andmap image? arg)) 'image-list i arg)
arg]
[(mode)
(check-arg fn-name
(mode? arg)
@ -249,6 +252,17 @@
'list-of-at-least-three-posns
i arg)
arg]
[(zero-or-more-posns)
(check-arg fn-name
(and (list? arg)
(andmap posn? arg))
'list-of-posns
i arg)
(check-arg fn-name
(andmap real-valued-posn? arg)
'list-of-posns-with-real-valued-x-and-y-coordinates
i arg)
arg]
[(int0-255-1 int0-255-2 int0-255-3 int0-255-4)
(check-arg fn-name (and (integer? arg) (<= 0 arg 255))
'integer\ between\ 0\ and\ 255 i arg)

28
pkgs/htdp-pkgs/htdp-test/2htdp/tests/test-image.rkt
View File

@ -1624,6 +1624,34 @@
2 7
(circle 4 'solid 'black)))
(let ()
(define image1 (circle 8 'solid 'red))
(define image2 (rectangle 40 4 'solid 'blue))
(define image3 (rectangle 4 40 'solid 'green))
(define background (rectangle 40 40 'solid 'black))
(define spot 20)
(define p (make-posn spot spot))
(test (place-images (list image1 image2 image3)
(list (make-posn 30 10) p p)
background)
=>
(place-image image1 30 10
(place-image image2 spot spot
(place-image image3 spot spot
background))))
(test (place-images/align (list image1 image2 image3)
(list (make-posn 30 10) p p)
'center 'center
background)
=>
(place-image image1 30 10
(place-image image2 spot spot
(place-image image3 spot spot
background)))))
;; this test case checks to make sure the number of crops doesn't
;; grow when normalizing shapes.