diff --git a/collects/2htdp/image.ss b/collects/2htdp/image.ss index eeb3fb0d4c..bf2612ed7d 100644 --- a/collects/2htdp/image.ss +++ b/collects/2htdp/image.ss @@ -52,6 +52,9 @@ and they all have good sample contracts. (It is amazing what we can do with kids (provide overlay overlay/align overlay/xy + underlay + underlay/align + underlay/xy beside beside/align diff --git a/collects/2htdp/private/image-more.ss b/collects/2htdp/private/image-more.ss index aa8142316f..7b0e94034e 100644 --- a/collects/2htdp/private/image-more.ss +++ b/collects/2htdp/private/image-more.ss @@ -307,10 +307,14 @@ ;; overlay : image image image ... -> image ;; places images on top of each other with their upper left corners aligned. last one goes on the bottom - (define/chk (overlay image image2 . image3) (overlay/internal 'left 'top image (cons image2 image3))) +;; underlay : image image image ... -> image +(define (underlay image image2 . image3) + (let ([imgs (reverse (list* image image2 image3))]) + (overlay/internal 'left 'top (car imgs) (cdr imgs)))) + ;; overlay/align : string string image image image ... -> image ;; the first string has to be one of "center" "middle" "left" or "right" (or symbols) ;; the second string has to be one of "center" "middle" "top" "bottom" or "baseline" (or symbols) @@ -322,6 +326,10 @@ (define/chk (overlay/align x-place y-place image image2 . image3) (overlay/internal x-place y-place image (cons image2 image3))) +(define/chk (underlay/align x-place y-place image image2 . image3) + (let ([imgs (reverse (list* image image2 image3))]) + (overlay/internal x-place y-place (car imgs) (cdr imgs)))) + (define (overlay/internal x-place y-place fst rst) (let loop ([fst fst] [rst rst]) @@ -346,14 +354,16 @@ (case x-place [(left) 0] [(middle) (/ (image-right image) 2)] - [(right) (image-right image)])) + [(right) (image-right image)] + [else (error 'find-x-spot "~s" x-place)])) (define (find-y-spot y-place image) (case y-place [(top) 0] [(middle) (/ (image-bottom image) 2)] [(bottom) (image-bottom image)] - [(baseline) (image-baseline image)])) + [(baseline) (image-baseline image)] + [else (error 'find-y-spot "~s" y-place)])) ;; overlay/xy : image number number image -> image ;; places images on top of each other with their upper-left corners offset by the two numbers @@ -366,6 +376,14 @@ (if (< dx 0) 0 dx) (if (< dy 0) 0 dy))) +(define/chk (underlay/xy image dx dy image2) + (overlay/δ image2 + (if (< dx 0) 0 dx) + (if (< dy 0) 0 dy) + image + (if (< dx 0) (- dx) 0) + (if (< dy 0) (- dy) 0))) + (define (overlay/δ image1 dx1 dy1 image2 dx2 dy2) (make-image (make-overlay (make-translate dx1 dy1 (image-shape image1)) (make-translate dx2 dy2 (image-shape image2))) @@ -943,6 +961,10 @@ (provide overlay overlay/align overlay/xy + underlay + underlay/align + underlay/xy + beside beside/align above diff --git a/collects/2htdp/tests/test-image.ss b/collects/2htdp/tests/test-image.ss index abb3d83197..64eb05ce34 100644 --- a/collects/2htdp/tests/test-image.ss +++ b/collects/2htdp/tests/test-image.ss @@ -285,9 +285,9 @@ #f)) (test (overlay/align 'middle - 'middle - (ellipse 100 50 'solid 'green) - (ellipse 50 100 'solid 'red)) + 'middle + (ellipse 100 50 'solid 'green) + (ellipse 50 100 'solid 'red)) => (make-image (make-overlay @@ -297,9 +297,9 @@ #f)) (test (overlay/align 'middle - 'middle - (ellipse 50 100 'solid 'red) - (ellipse 100 50 'solid 'green)) + 'middle + (ellipse 50 100 'solid 'red) + (ellipse 100 50 'solid 'green)) => (make-image (make-overlay @@ -310,9 +310,9 @@ (test (overlay/align 'right - 'bottom - (ellipse 50 100 'solid 'red) - (ellipse 100 50 'solid 'green)) + 'bottom + (ellipse 50 100 'solid 'red) + (ellipse 100 50 'solid 'green)) => (make-image (make-overlay @@ -322,9 +322,9 @@ #f)) (test (overlay/align 'right - 'baseline - (ellipse 50 100 'solid 'red) - (ellipse 100 50 'solid 'green)) + 'baseline + (ellipse 50 100 'solid 'red) + (ellipse 100 50 'solid 'green)) => (make-image (make-overlay @@ -413,13 +413,136 @@ #f)) (test (above (ellipse 50 100 'solid 'red) - (ellipse 100 50 'solid 'blue)) + (ellipse 100 50 'solid 'blue)) => (above/align 'left (ellipse 50 100 'solid 'red) (ellipse 100 50 'solid 'blue))) + +(test (underlay (ellipse 100 100 'solid 'blue) + (ellipse 120 120 'solid 'red)) + => + (make-image + (make-overlay + (make-translate 0 0 (image-shape (ellipse 120 120 'solid 'red))) + (make-translate 0 0 (image-shape (ellipse 100 100 'solid 'blue)))) + (make-bb 120 + 120 + 120) + #f)) + +(test (underlay/xy (ellipse 100 100 'solid 'blue) + 0 0 + (ellipse 120 120 'solid 'red)) + => + (underlay (ellipse 100 100 'solid 'blue) + (ellipse 120 120 'solid 'red))) + + +(test (underlay/xy (ellipse 50 100 'solid 'red) + -25 25 + (ellipse 100 50 'solid 'green)) + => + (make-image + (make-overlay + (make-translate 0 25 (image-shape (ellipse 100 50 'solid 'green))) + (make-translate 25 0 (image-shape (ellipse 50 100 'solid 'red)))) + (make-bb 100 + 100 + 100) + #f)) + +(test (underlay/xy (ellipse 100 50 'solid 'green) + 10 10 + (ellipse 50 100 'solid 'red)) + => + (make-image + (make-overlay + (make-translate 10 10 (image-shape (ellipse 50 100 'solid 'red))) + (make-translate 0 0 (image-shape (ellipse 100 50 'solid 'green)))) + (make-bb 100 + 110 + 110) + #f)) + +(test (underlay (ellipse 100 50 'solid 'green) + (ellipse 50 100 'solid 'red)) + => + (make-image + (make-overlay + (make-translate 0 0 (image-shape (ellipse 50 100 'solid 'red))) + (make-translate 0 0 (image-shape (ellipse 100 50 'solid 'green)))) + (make-bb 100 + 100 + 100) + #f)) + +(test (underlay (ellipse 100 100 'solid 'blue) + (ellipse 120 120 'solid 'red) + (ellipse 140 140 'solid 'green)) + => + (make-image + (make-overlay + (make-translate + 0 0 + (make-overlay + (make-translate 0 0 (image-shape (ellipse 140 140 'solid 'green))) + (make-translate 0 0 (image-shape (ellipse 120 120 'solid 'red))))) + (make-translate 0 0 (image-shape (ellipse 100 100 'solid 'blue)))) + (make-bb 140 140 140) + #f)) + +(test (underlay/align 'middle + 'middle + (ellipse 100 50 'solid 'green) + (ellipse 50 100 'solid 'red)) + => + (make-image + (make-overlay + (make-translate 25 0 (image-shape (ellipse 50 100 'solid 'red))) + (make-translate 0 25 (image-shape (ellipse 100 50 'solid 'green)))) + (make-bb 100 100 100) + #f)) + +(test (underlay/align 'middle + 'middle + (ellipse 50 100 'solid 'red) + (ellipse 100 50 'solid 'green)) + => + (make-image + (make-overlay + (make-translate 0 25 (image-shape (ellipse 100 50 'solid 'green))) + (make-translate 25 0 (image-shape (ellipse 50 100 'solid 'red)))) + (make-bb 100 100 100) + #f)) + +(test (underlay/align 'right + 'bottom + (ellipse 50 100 'solid 'red) + (ellipse 100 50 'solid 'green)) + => + (make-image + (make-overlay + (make-translate 0 50 (image-shape (ellipse 100 50 'solid 'green))) + (make-translate 50 0 (image-shape (ellipse 50 100 'solid 'red)))) + (make-bb 100 100 100) + #f)) + +(test (underlay/align "right" + "baseline" + (ellipse 50 100 'solid 'red) + (ellipse 100 50 'solid 'green)) + => + (make-image + (make-overlay + (make-translate 0 50 (image-shape (ellipse 100 50 'solid 'green))) + (make-translate 50 0 (image-shape (ellipse 50 100 'solid 'red)))) + (make-bb 100 100 100) + #f)) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; testing normalization diff --git a/collects/teachpack/2htdp/scribblings/image-gen.ss b/collects/teachpack/2htdp/scribblings/image-gen.ss index cbaf4b9c66..753806ba2e 100644 --- a/collects/teachpack/2htdp/scribblings/image-gen.ss +++ b/collects/teachpack/2htdp/scribblings/image-gen.ss @@ -28,7 +28,13 @@ (define (handle-image exp) (printf ".") (flush-output) - (let ([result (parameterize ([current-namespace image-ns]) (eval exp))]) + (let ([result + (with-handlers ([exn:fail? + (λ (x) + (printf "\nerror evaluating:\n") + (pretty-print exp) + (raise x))]) + (parameterize ([current-namespace image-ns]) (eval exp)))]) (cond [(image? result) (let ([fn (exp->filename exp)]) diff --git a/collects/teachpack/2htdp/scribblings/image-toc.ss b/collects/teachpack/2htdp/scribblings/image-toc.ss index 5ff0c76d67..314d641b85 100644 --- a/collects/teachpack/2htdp/scribblings/image-toc.ss +++ b/collects/teachpack/2htdp/scribblings/image-toc.ss @@ -8,8 +8,8 @@ (list (list '(image-height (rectangle 100 100 "solid" "black")) 'val 100) (list '(image-baseline (rectangle 100 100 "solid" "black")) 'val 100) - (list '(image-height (text "Hello" 24 "black")) 'val 24.0) - (list '(image-baseline (text "Hello" 24 "black")) 'val 18.0) + (list '(image-height (text "Hello" 24 "black")) 'val 41.0) + (list '(image-baseline (text "Hello" 24 "black")) 'val 31.0) (list '(image-height (overlay (circle 20 "solid" "orange") (circle 30 "solid" "purple"))) @@ -114,6 +114,76 @@ (ellipse 20 10 "solid" "black")) 'image "28c73238138.png") + (list + '(underlay/xy + (underlay/xy + (ellipse 40 40 "solid" "gray") + 10 + 15 + (ellipse 10 10 "solid" "forestgreen")) + 20 + 15 + (ellipse 10 10 "solid" "forestgreen")) + 'image + "201c231dce2.png") + (list + '(underlay/xy + (rectangle 20 20 "solid" "red") + -20 + -20 + (rectangle 20 20 "solid" "black")) + 'image + "42f9f9e4cf.png") + (list + '(underlay/xy + (rectangle 20 20 "solid" "red") + 20 + 20 + (rectangle 20 20 "solid" "black")) + 'image + "157ab5efca7.png") + (list + '(underlay/xy + (rectangle 20 20 "outline" "black") + 20 + 0 + (rectangle 20 20 "outline" "black")) + 'image + "26bd803042c.png") + (list + '(underlay/align + "right" + "top" + (rectangle 50 50 "solid" "seagreen") + (rectangle 40 40 "solid" "silver") + (rectangle 30 30 "solid" "seagreen") + (rectangle 20 20 "solid" "silver")) + 'image + "ff2fcb7b87.png") + (list + '(underlay/align + "middle" + "middle" + (rectangle 30 60 "solid" "orange") + (ellipse 60 30 "solid" "purple")) + 'image + "2d1e52503d7.png") + (list + '(underlay + (ellipse 10 60 "solid" "red") + (ellipse 20 50 "solid" "black") + (ellipse 30 40 "solid" "red") + (ellipse 40 30 "solid" "black") + (ellipse 50 20 "solid" "red") + (ellipse 60 10 "solid" "black")) + 'image + "28253f4c3c.png") + (list + '(underlay + (rectangle 30 60 "solid" "orange") + (ellipse 60 30 "solid" "purple")) + 'image + "9858b8d5d.png") (list '(overlay/xy (overlay/xy diff --git a/collects/teachpack/2htdp/scribblings/image.scrbl b/collects/teachpack/2htdp/scribblings/image.scrbl index 3698a01242..bc1f123196 100644 --- a/collects/teachpack/2htdp/scribblings/image.scrbl +++ b/collects/teachpack/2htdp/scribblings/image.scrbl @@ -318,6 +318,70 @@ other. The top and bottom pair of angles is @scheme[angle] and the left and righ (ellipse 10 10 "solid" "forestgreen"))] } +@defproc[(underlay [i1 image?] [i2 image?] [is image?] ...) image?]{ + Underlays all of its arguments building a single image. + + It behaves like @scheme[overlay], but with the arguments in the reverse order. + That is, the first argument goes + underneath of the second argument, which goes underneath the third argument, etc. + The images are all lined up on their upper-left corners. + + @image-examples[(underlay (rectangle 30 60 "solid" "orange") + (ellipse 60 30 "solid" "purple")) + (underlay (ellipse 10 60 "solid" "red") + (ellipse 20 50 "solid" "black") + (ellipse 30 40 "solid" "red") + (ellipse 40 30 "solid" "black") + (ellipse 50 20 "solid" "red") + (ellipse 60 10 "solid" "black"))] + + } + +@defproc[(underlay/align [x-place x-place?] [y-place y-place?] [i1 image?] [i2 image?] [is image?] ...) image?]{ + Underlays all of its image arguments, much like the @scheme[underlay] function, but using + @scheme[x-place] and @scheme[y-place] to determine where the images are lined up. For example, if + @scheme[x-place] and @scheme[y-place] are both @scheme["middle"], then the images are lined up + on their centers. + + @image-examples[(underlay/align "middle" "middle" + (rectangle 30 60 "solid" "orange") + (ellipse 60 30 "solid" "purple")) + (underlay/align "right" "top" + (rectangle 50 50 "solid" "seagreen") + (rectangle 40 40 "solid" "silver") + (rectangle 30 30 "solid" "seagreen") + (rectangle 20 20 "solid" "silver"))] + + + } + +@defproc[(underlay/xy [i1 image?] [x real?] [y real?] [i2 image?]) image?]{ + Constructs an image by underlaying @scheme[i1] underneath of @scheme[i2] after + shifting @scheme[i2] over by @scheme[x] pixels to the right and @scheme[y] + pixels down. + + This is the same as @scheme[(overlay/xy i2 (- x) (- y) i1)]. + + @image-examples[(underlay/xy (rectangle 20 20 "outline" "black") + 20 0 + (rectangle 20 20 "outline" "black")) + (underlay/xy (rectangle 20 20 "solid" "red") + 20 20 + (rectangle 20 20 "solid" "black")) + (underlay/xy (rectangle 20 20 "solid" "red") + -20 -20 + (rectangle 20 20 "solid" "black")) + (underlay/xy + (underlay/xy (ellipse 40 40 "solid" "gray") + 10 + 15 + (ellipse 10 10 "solid" "forestgreen")) + 20 + 15 + (ellipse 10 10 "solid" "forestgreen"))] +} + + @defproc[(beside [i1 image?] [i2 image?] [is image?] ...) image?]{ Constructs an image by placing all of the argument images in a horizontal row, aligned along their top edges. diff --git a/collects/teachpack/2htdp/scribblings/img/157ab5efca7.png b/collects/teachpack/2htdp/scribblings/img/157ab5efca7.png new file mode 100644 index 0000000000..59966a6bc9 Binary files /dev/null and b/collects/teachpack/2htdp/scribblings/img/157ab5efca7.png differ diff --git a/collects/teachpack/2htdp/scribblings/img/201c231dce2.png b/collects/teachpack/2htdp/scribblings/img/201c231dce2.png new file mode 100644 index 0000000000..0f7fef2922 Binary files /dev/null and b/collects/teachpack/2htdp/scribblings/img/201c231dce2.png differ diff --git a/collects/teachpack/2htdp/scribblings/img/26bd803042c.png b/collects/teachpack/2htdp/scribblings/img/26bd803042c.png new file mode 100644 index 0000000000..ba29f9ce76 Binary files /dev/null and b/collects/teachpack/2htdp/scribblings/img/26bd803042c.png differ diff --git a/collects/teachpack/2htdp/scribblings/img/28253f4c3c.png b/collects/teachpack/2htdp/scribblings/img/28253f4c3c.png new file mode 100644 index 0000000000..b9aa3d8d5f Binary files /dev/null and b/collects/teachpack/2htdp/scribblings/img/28253f4c3c.png differ diff --git a/collects/teachpack/2htdp/scribblings/img/2d1e52503d7.png b/collects/teachpack/2htdp/scribblings/img/2d1e52503d7.png new file mode 100644 index 0000000000..3d05fa71d1 Binary files /dev/null and b/collects/teachpack/2htdp/scribblings/img/2d1e52503d7.png differ diff --git a/collects/teachpack/2htdp/scribblings/img/42f9f9e4cf.png b/collects/teachpack/2htdp/scribblings/img/42f9f9e4cf.png new file mode 100644 index 0000000000..6f62addfae Binary files /dev/null and b/collects/teachpack/2htdp/scribblings/img/42f9f9e4cf.png differ diff --git a/collects/teachpack/2htdp/scribblings/img/9858b8d5d.png b/collects/teachpack/2htdp/scribblings/img/9858b8d5d.png new file mode 100644 index 0000000000..d3abd4688e Binary files /dev/null and b/collects/teachpack/2htdp/scribblings/img/9858b8d5d.png differ diff --git a/collects/teachpack/2htdp/scribblings/img/ff2fcb7b87.png b/collects/teachpack/2htdp/scribblings/img/ff2fcb7b87.png new file mode 100644 index 0000000000..0930b8b91a Binary files /dev/null and b/collects/teachpack/2htdp/scribblings/img/ff2fcb7b87.png differ