diff --git a/pkgs/htdp-pkgs/htdp-doc/teachpack/2htdp/scribblings/image.scrbl b/pkgs/htdp-pkgs/htdp-doc/teachpack/2htdp/scribblings/image.scrbl index 8d775245f7..9c7d447f1e 100644 --- a/pkgs/htdp-pkgs/htdp-doc/teachpack/2htdp/scribblings/image.scrbl +++ b/pkgs/htdp-pkgs/htdp-doc/teachpack/2htdp/scribblings/image.scrbl @@ -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?] diff --git a/pkgs/htdp-pkgs/htdp-lib/2htdp/image.rkt b/pkgs/htdp-pkgs/htdp-lib/2htdp/image.rkt index c5e52152bb..c4c310cb0d 100644 --- a/pkgs/htdp-pkgs/htdp-lib/2htdp/image.rkt +++ b/pkgs/htdp-pkgs/htdp-lib/2htdp/image.rkt @@ -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 diff --git a/pkgs/htdp-pkgs/htdp-lib/2htdp/private/image-more.rkt b/pkgs/htdp-pkgs/htdp-lib/2htdp/private/image-more.rkt index b0c1057e2a..ebe1c9bb33 100644 --- a/pkgs/htdp-pkgs/htdp-lib/2htdp/private/image-more.rkt +++ b/pkgs/htdp-pkgs/htdp-lib/2htdp/private/image-more.rkt @@ -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 diff --git a/pkgs/htdp-pkgs/htdp-lib/2htdp/private/img-err.rkt b/pkgs/htdp-pkgs/htdp-lib/2htdp/private/img-err.rkt index 398d4c5c46..1c786a7413 100644 --- a/pkgs/htdp-pkgs/htdp-lib/2htdp/private/img-err.rkt +++ b/pkgs/htdp-pkgs/htdp-lib/2htdp/private/img-err.rkt @@ -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) diff --git a/pkgs/htdp-pkgs/htdp-test/2htdp/tests/test-image.rkt b/pkgs/htdp-pkgs/htdp-test/2htdp/tests/test-image.rkt index e4f55e447e..48fe228de1 100644 --- a/pkgs/htdp-pkgs/htdp-test/2htdp/tests/test-image.rkt +++ b/pkgs/htdp-pkgs/htdp-test/2htdp/tests/test-image.rkt @@ -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.