revised the coordinates for place-image and fixed up the docs a bit

svn: r17643

collects/2htdp/image.ss

@@ -88,6 +88,8 @@ and they all have good sample contracts. (It is amazing what we can do with kids
          line
          add-line
          add-curve
+         scene+line
+         scene+curve
          text
          text/font
          bitmap

collects/2htdp/private/image-more.ss

@@ -290,7 +290,7 @@
 
 ;; place-image : image x y scene -> scene
 (define/chk (place-image image1 x1 y1 image2) 
-  (place-image/internal image1 x1 y1 image2 'left 'top))
+  (place-image/internal image1 x1 y1 image2 'middle 'middle))
 (define/chk (place-image/align image1 x1 y1 x-place y-place image2)
   (place-image/internal image1 x1 y1 image2 x-place y-place))
 
@@ -309,6 +309,28 @@
                 (if (< dx 0) (- dx) 0)
                 (if (< dy 0) (- dy) 0)))))
 
+(define/chk (scene+line image x1 y1 x2 y2 color)
+  (let* ([dx (abs (min 0 x1 x2))]
+         [dy (abs (min 0 y1 y2))])
+    (make-image (make-overlay
+                 (make-crop (rectangle-points (get-right image) (get-bottom image))
+                            (make-line-segment (make-point x1 y1) (make-point x2 y2) color))
+                 (image-shape image))
+                (image-bb image)
+                #f)))
+
+(define/chk (scene+curve image x1 y1 angle1 pull1 x2 y2 angle2 pull2 color)
+  (let* ([dx (abs (min 0 x1 x2))]
+         [dy (abs (min 0 y1 y2))])
+    (make-image (make-overlay
+                 (make-crop (rectangle-points (get-right image) (get-bottom image))
+                            (make-curve-segment (make-point x1 y1) angle1 pull1
+                                                (make-point x2 y2) angle2 pull2
+                                                color))
+                 (image-shape image))
+                (image-bb image)
+                #f)))
+
 ;; frame : image -> image
 ;; draws a black frame around a image where the bounding box is
 ;; (useful for debugging images)
@@ -931,7 +953,8 @@
          line
          add-line
          add-curve
-         
+         scene+line
+         scene+curve
          text
          text/font
          

collects/2htdp/tests/test-image.ss

@@ -987,6 +987,35 @@
         =>
         (+ bl 10)))
 
+(test (scene+line (rectangle 100 100 'solid 'black)
+                  10 10 
+                  90 50
+                  "red")
+      =>
+      (add-line (rectangle 100 100 'solid 'black)
+                10 10 
+                90 50
+                "red"))
+
+(test (image-width (scene+line (rectangle 100 100 'solid 'black)
+                               -10 -20
+                               110 120
+                               "green"))
+      =>
+      100)
+(test (image-height (scene+line (rectangle 100 100 'solid 'black)
+                               -10 -20
+                               110 120
+                               'purple))
+      =>
+      100)
+(test (image-baseline (scene+line (rectangle 100 100 'solid 'black)
+                                  -10 -20
+                                  110 120
+                                  'olive))
+      =>
+      100)
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 ;;  curves
@@ -1033,6 +1062,27 @@
        (rectangle 100 100 'solid 'black)
        20 80 90 1/3 80 20 90 1/3 'white))
 
+(test (add-curve (rectangle 100 100 'solid 'black)
+                 10 10 0 1/4
+                 90 90 0 1/4
+                 'white)
+      =>
+      (scene+curve (rectangle 100 100 'solid 'black)
+                   10 10 0 1/4
+                   90 90 0 1/4
+                   'white))
+(test (scene+curve (rectangle 100 100 'solid 'black)
+                   10 10 0 1/4
+                   110 110 0 1/4
+                   'red)
+      
+      =>
+      (crop 0 0 100 100
+            (add-curve (rectangle 100 100 'solid 'black)
+                       10 10 0 1/4
+                       110 110 0 1/4
+                       'red)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 ;;  bitmap tests
@@ -1195,38 +1245,43 @@
                     (rectangle 10 10 'solid 'black)
                     (rectangle 10 10 'solid 'green)))
 
-(test (place-image (circle 4 'solid 'black)
+(test (place-image/align (circle 4 'solid 'black)
                          10 10
+                         'left 'top
                          (rectangle 40 40 'solid 'orange))
       =>
       (underlay/xy (rectangle 40 40 'solid 'orange)
                    10 10
                    (circle 4 'solid 'black)))
 
-(test (place-image (circle 4 'solid 'black)
+(test (place-image/align (circle 4 'solid 'black)
                          50 50
+                         'left 'top
                          (rectangle 40 40 'solid 'orange))
       =>
       (rectangle 40 40 'solid 'orange))
 
-(test (place-image (circle 4 'solid 'black)
+(test (place-image/align (circle 4 'solid 'black)
                          36 36
+                         'left 'top
                          (rectangle 40 40 'solid 'orange))
       =>
       (underlay/xy (rectangle 40 40 'solid 'orange)
                    36 36
                    (crop 0 0 4 4 (circle 4 'solid 'black))))
 
-(test (place-image (circle 8 'solid 'black)
+(test (place-image/align (circle 8 'solid 'black)
                          -4 -4
+                         'left 'top
                          (rectangle 40 40 'solid 'orange))
       =>
       (overlay/xy (crop 4 4 16 16 (circle 8 'solid 'black))
                   0 0
                   (rectangle 40 40 'solid 'orange)))
 
-(test (place-image (circle 4 'solid 'black)
+(test (place-image/align (circle 4 'solid 'black)
                          -4 0
+                         'left 'top
                          (rectangle 40 40 'solid 'orange))
       =>
       (overlay/xy (crop 4 0 4 8 (circle 4 'solid 'black))

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)
+   (list '(image-height (text "Hello" 24 "black")) 'val 41)
-   (list '(image-baseline (text "Hello" 24 "black")) 'val 18)
+   (list '(image-baseline (text "Hello" 24 "black")) 'val 31)
    (list
     '(image-height
       (overlay (circle 20 "solid" "orange") (circle 30 "solid" "purple")))
@@ -75,6 +75,90 @@
     '(rotate 45 (ellipse 60 20 "solid" "olivedrab"))
     'image
     "28daec71a64.png")
+   (list
+    '(scene+curve
+      (rectangle 100 100 "solid" "black")
+      -20
+      -20
+      0
+      1
+      120
+      120
+      0
+      1
+      "red")
+    'image
+    "25dd3e2d97c.png")
+   (list
+    '(scene+curve
+      (add-curve
+       (rectangle 40 100 "solid" "black")
+       20
+       10
+       180
+       1/2
+       20
+       90
+       180
+       1/2
+       "white")
+      20
+      10
+      0
+      1/2
+      20
+      90
+      0
+      1/2
+      "white")
+    'image
+    "1132401ea93.png")
+   (list
+    '(scene+curve
+      (rectangle 100 100 "solid" "black")
+      20
+      20
+      0
+      1
+      80
+      80
+      0
+      1
+      "white")
+    'image
+    "6efa12ea15.png")
+   (list
+    '(scene+curve
+      (rectangle 100 100 "solid" "black")
+      20
+      20
+      0
+      1/3
+      80
+      80
+      0
+      1/3
+      "white")
+    'image
+    "353ed4578.png")
+   (list
+    '(scene+line (rectangle 40 40 "solid" "gray") -10 50 50 -10 "maroon")
+    'image
+    "1f5944ec1ed.png")
+   (list
+    '(scene+line
+      (ellipse 80 60 "outline" "darkolivegreen")
+      (+ 40 (* 40 (cos (* pi 1/4))))
+      (+ 30 (* 30 (sin (* pi 1/4))))
+      (+ 40 (* 40 (cos (* pi 5/4))))
+      (+ 30 (* 30 (sin (* pi 5/4))))
+      "darkolivegreen")
+    'image
+    "2353974cf1b.png")
+   (list
+    '(scene+line (ellipse 40 40 "outline" "maroon") 0 40 40 0 "maroon")
+    'image
+    "2b944b7ab91.png")
    (list
     '(beside
       (place-image/align
@@ -127,39 +211,39 @@
    (list
     '(place-image
       (circle 4 "solid" "white")
-      16
       18
+      20
       (place-image
        (circle 4 "solid" "white")
-       -2
-       4
-       (place-image
-        (circle 4 "solid" "white")
-        12
        0
+       6
        (place-image
         (circle 4 "solid" "white")
-         6
+        14
-         12
+        2
+        (place-image
+         (circle 4 "solid" "white")
+         8
+         14
          (rectangle 24 24 "solid" "goldenrod")))))
     'image
-    "1178fdd1294.png")
+    "ab1841ea36.png")
    (list
     '(place-image
       (triangle 64 "solid" "red")
-      -8
+      24
-      -8
+      24
       (rectangle 48 48 "solid" "gray"))
     'image
-    "2875b40781.png")
+    "13e518b230e.png")
    (list
     '(place-image
       (triangle 32 "solid" "red")
-      8
+      24
-      8
+      24
       (rectangle 48 48 "solid" "gray"))
     'image
-    "2bea495d1f.png")
+    "126418b230e.png")
    (list
     '(above/align
       "left"
@@ -383,46 +467,74 @@
    (list '(text "Hello" 24 "olive") 'image "1bbeedc0d6.png")
    (list
     '(add-curve
-      (add-curve
+      (rectangle 100 100 "solid" "black")
-       (rectangle 40 100 'solid 'black)
+      -20
-       20
+      -20
-       10
-       180
-       1/2
-       20
-       90
-       180
-       1/2
-       'white)
-      20
-      10
       0
-      1/2
+      1
-      20
+      120
-      90
+      120
       0
-      1/2
+      1
-      'white)
+      "red")
     'image
-    "13121248a3c.png")
+    "1532990d5cb.png")
-   (list
-    '(add-curve (rectangle 100 100 'solid 'black) 20 20 0 1 80 80 0 1 'white)
-    'image
-    "df251e846.png")
    (list
     '(add-curve
-      (rectangle 100 100 'solid 'black)
+      (add-curve
+       (rectangle 40 100 "solid" "black")
        20
+       10
+       180
+       1/2
        20
+       90
+       180
+       1/2
+       "white")
+      20
+      10
       0
-      1/3
+      1/2
-      80
+      20
-      80
+      90
       0
-      1/3
+      1/2
-      'white)
+      "white")
     'image
-    "12472655f6c.png")
+    "2751bdfe579.png")
+   (list
+    '(add-curve
+      (rectangle 100 100 "solid" "black")
+      20
+      20
+      0
+      1
+      80
+      80
+      0
+      1
+      "white")
+    'image
+    "fa1a9f17b6.png")
+   (list
+    '(add-curve
+      (rectangle 100 100 "solid" "black")
+      20
+      20
+      0
+      1/3
+      80
+      80
+      0
+      1/3
+      "white")
+    'image
+    "2a1f3988f.png")
+   (list
+    '(add-line (rectangle 40 40 "solid" "gray") -10 50 50 -10 "maroon")
+    'image
+    "12b0447b10c.png")
    (list
     '(add-line
       (ellipse 80 60 "outline" "darkolivegreen")

collects/teachpack/2htdp/scribblings/image.scrbl

@@ -200,6 +200,8 @@ other. The top and bottom pair of angles is @scheme[angle] and the left and righ
 
   Adds a line to the image @scheme[image], starting from the point (@scheme[x1],@scheme[y1])
   and going to the point (@scheme[x2],@scheme[y2]).
+  Unlike @scheme[scene+line], if the line passes outside of @scheme[image], the image
+  gets larger to accomodate the line.
   
   @image-examples[(add-line (ellipse 40 40 "outline" "maroon")
                             0 40 40 0 "maroon")
@@ -208,7 +210,9 @@ other. The top and bottom pair of angles is @scheme[angle] and the left and righ
                             (+ 30 (* 30 (sin (* pi 1/4))))
                             (+ 40 (* 40 (cos (* pi 5/4))))
                             (+ 30 (* 30 (sin (* pi 5/4))))
-                            "darkolivegreen")]
+                            "darkolivegreen")
+                  (add-line (rectangle 40 40 "solid" "gray")
+                            -10 50 50 -10 "maroon")]
 }
 
 @defproc[(add-curve [image image?] 
@@ -229,24 +233,34 @@ The @scheme[pull1] and @scheme[pull2] arguments control how
 long the curve tries to stay with that angle. Larger numbers
 mean that the curve stays with the angle longer.
 
-@image-examples[(add-curve (rectangle 100 100 'solid 'black)
+Unlike @scheme[scene+curve], if the line passes outside of @scheme[image], the image
+  gets larger to accomodate the curve.
+
+
+@image-examples[(add-curve (rectangle 100 100 "solid" "black")
                            20 20 0 1/3
                            80 80 0 1/3
-                           'white)
+                           "white")
-                (add-curve (rectangle 100 100 'solid 'black)
+                (add-curve (rectangle 100 100 "solid" "black")
                            20 20 0 1 
                            80 80 0 1
-                           'white)
+                           "white")
                 (add-curve 
                  (add-curve 
-                  (rectangle 40 100 'solid 'black)
+                  (rectangle 40 100 "solid" "black")
                   20 10 180 1/2
                   20 90 180 1/2
-                  'white)
+                  "white")
                  20 10 0 1/2
                  20 90 0 1/2
-                 'white)]
+                 "white")
+                        
+                (add-curve (rectangle 100 100 "solid" "black")
+                           -20 -20 0 1 
+                           120 120 0 1
+                           "red")]
 }
+
 @defproc[(text [string string?] [font-size (and/c integer? (<=/c 1 255))] [color image-color?])
          image?]{
                 
@@ -506,26 +520,26 @@ and universes using @scheme[2htdp/universe].
   
  @image-examples[(place-image 
                   (triangle 32 "solid" "red")
-                  8 8
+                  24 24
                   (rectangle 48 48 "solid" "gray"))
                  
                  (place-image 
                   (triangle 64 "solid" "red")
-                  -8 -8
+                  24 24
                   (rectangle 48 48 "solid" "gray"))
                  
                  (place-image
                   (circle 4 "solid" "white")
-                  16 18
+                  18 20
                   (place-image
                    (circle 4 "solid" "white")
-                   -2 4
+                   0 6
                    (place-image
                     (circle 4 "solid" "white")
-                    12 0
+                    14 2
                     (place-image
                      (circle 4 "solid" "white")
-                     6 12
+                     8 14
                      (rectangle 24 24 "solid" "goldenrod")))))]
 }
 @defproc[(place-image/align [image image?] [x real?] [y real?] [x-place x-place?] [y-place y-place?][scene image?])
@@ -558,6 +572,74 @@ and universes using @scheme[2htdp/universe].
                                      (rectangle 32 32 "outline" "black")))]
 }
 
+@defproc[(scene+line [image image?]
+                     [x1 real?] [y1 real?]
+                     [x2 real?] [y2 real?]
+                     [color image-color?])
+         image?]{
+
+  Adds a line to the image @scheme[scene], starting from the point (@scheme[x1],@scheme[y1])
+  and going to the point (@scheme[x2],@scheme[y2]); unlike
+  @scheme[add-line], this function crops the resulting image to the size of @scheme[scene].
+  
+  @image-examples[(scene+line (ellipse 40 40 "outline" "maroon")
+                              0 40 40 0 "maroon")
+                  (scene+line (ellipse 80 60 "outline" "darkolivegreen")
+                              (+ 40 (* 40 (cos (* pi 1/4))))
+                              (+ 30 (* 30 (sin (* pi 1/4))))
+                              (+ 40 (* 40 (cos (* pi 5/4))))
+                              (+ 30 (* 30 (sin (* pi 5/4))))
+                              "darkolivegreen")
+                  (scene+line (rectangle 40 40 "solid" "gray")
+                              -10 50 50 -10 "maroon")]
+}
+
+@defproc[(scene+curve [scene image?] 
+                      [x1 real?] [y1 real?] [angle1 angle?] [pull1 real?]
+                      [x2 real?] [y2 real?] [angle2 angle?] [pull2 real?]
+                      [color image-color?])
+         image?]{
+
+Adds a curve to @scheme[scene], starting at the point
+(@scheme[x1],@scheme[y1]), and ending at the point
+(@scheme[x2],@scheme[y2]).
+
+The @scheme[angle1] and @scheme[angle2] arguments specify the 
+angle that the curve has as it leaves the initial point and
+as it reaches the final point, respectively. 
+
+The @scheme[pull1] and @scheme[pull2] arguments control how
+long the curve tries to stay with that angle. Larger numbers
+mean that the curve stays with the angle longer.
+
+Unlike @scheme[add-curve], this function crops the curve, only showing
+the parts that fit onto @scheme[scene].
+
+@image-examples[(scene+curve (rectangle 100 100 "solid" "black")
+                             20 20 0 1/3
+                             80 80 0 1/3
+                             "white")
+                (scene+curve (rectangle 100 100 "solid" "black")
+                             20 20 0 1 
+                             80 80 0 1
+                             "white")
+                (scene+curve 
+                 (add-curve 
+                  (rectangle 40 100 "solid" "black")
+                  20 10 180 1/2
+                  20 90 180 1/2
+                  "white")
+                 20 10 0 1/2
+                 20 90 0 1/2
+                 "white")
+                        
+                (scene+curve (rectangle 100 100 "solid" "black")
+                             -20 -20 0 1 
+                             120 120 0 1
+                             "red")]
+}
+
+                
 @section{Rotating, Scaling, Cropping, and Framing Images}
 
 @defproc[(rotate [angle angle?] [image image?]) image?]{