added 'add-line', changed the way images in examples are saved

svn: r16727

collects/2htdp/image.ss

@@ -14,6 +14,7 @@ improvments/changes wrt to htdp/image:
   - equal comparisions are more efficient
   - added rotation & scaling
   - got rid of pinholes (see the new overlay, beside, and above functions)
+  - a bunch of new polygon functions
 
 Equality change: equality is now based on the structure of the construction of the picture. 
 This means that some equalities that were there before are no longer true. For example,
@@ -76,6 +77,7 @@ and they all have good sample contracts. (It is amazing what we can do with kids
          isosceles-triangle
          right-triangle
          line
+         add-line
          text
          text/font
          

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

@@ -669,18 +669,26 @@
                                 (make-point x1 y1)
                                 color))
             w h)))
-  #|
+
 (define/chk (add-line image x1 y1 x2 y2 color)
-  (make-image (make-overlay
-               (make-translate 
-                x1 y1
-                (make-line-segment (make-point 0 0)
-                                   (make-point x2 y2)
-                                   color))
-               (make-bb w h h)
-               #f))
-|#
-;;       line
+  (let* ([dx (abs (min 0 x1 x2))]
+         [dy (abs (min 0 y1 y2))]
+         [bottom (max (+ y1 dy)
+                      (+ y2 dy)
+                      (+ dy (image-bottom image)))]
+         [right (max (+ x1 dx)
+                     (+ x2 dx)
+                     (+ dx (image-right image)))]
+         [baseline (+ dy (image-baseline image))])
+    ;(printf "dx ~s orig-right ~s\n" dx (image-right image))
+    (make-image (make-translate
+                 dx dy
+                 (make-overlay
+                  (make-line-segment (make-point x1 y1) (make-point x2 y2) color)
+                  (image-shape image)))
+                (make-bb right bottom baseline)
+                #f)))
+
 
 ;; this is just so that 'text' objects can be sized.
 (define text-sizing-bm (make-object bitmap-dc% (make-object bitmap% 1 1)))
@@ -875,6 +883,7 @@
          star-polygon
          
          line
+         add-line
          
          text
          text/font

collects/teachpack/2htdp/scribblings/image-gen.ss

@@ -27,19 +27,39 @@
 
 (define (handle-image exp)
   (printf ".") (flush-output)
-  (let ([i (length mapping)])
-    (let ([result (parameterize ([current-namespace image-ns]) (eval exp))])
-      (cond
-        [(image? result)
-         (let ([fn (format "~a.png" i)])
-           (set! mapping (cons `(list ',exp 'image ,fn) mapping))
-           (save-image result (build-path "img" fn)))]
-        [else
-         (unless (equal? result (read/write result))
-           (error 'handle-image "expression ~s produced ~s, which I can't write"
-                  exp result))
-         (set! mapping (cons `(list ',exp 'val ,result) mapping))]))))
+  (let ([result (parameterize ([current-namespace image-ns]) (eval exp))])
+    (cond
+      [(image? result)
+       (let ([fn (exp->filename exp)])
+         (set! mapping (cons `(list ',exp 'image ,fn) mapping))
+         (save-image result (build-path "img" fn)))]
+      [else
+       (unless (equal? result (read/write result))
+         (error 'handle-image "expression ~s produced ~s, which I can't write"
+                exp result))
+       (set! mapping (cons `(list ',exp 'val ,result) mapping))])))
 
+(define (exp->filename exp)
+  (let loop ([prev 0])
+    (let ([candidate 
+           (format "~a~a.png" 
+                   (number->string (abs (equal-hash-code exp)) 16)  ;; abs to avoid filenames beginning with hyphens
+                   (if (zero? prev) 
+                       ""
+                       (format "-~a" (string->number prev 16))))])
+      (cond
+        [(anywhere? candidate mapping)
+         (loop (+ prev 1))]
+        [else
+         candidate]))))
+
+(define (anywhere? x sexp)
+  (let loop ([sexp sexp])
+    (cond
+      [(pair? sexp) (or (loop (car sexp))
+                        (loop (cdr sexp)))]
+      [else (equal? x sexp)])))
+                     
 (define (read/write result)
   (let-values ([(in out) (make-pipe)])
     (thread (λ () (write result out) (close-output-port out)))

collects/teachpack/2htdp/scribblings/image-toc.ss

@@ -28,18 +28,21 @@
       (ellipse 20 30 "solid" "slateblue")
       (ellipse 20 10 "solid" "navy"))
     'image
-    "49.png")
-   (list '(frame (ellipse 20 20 "outline" "black")) 'image "48.png")
-   (list '(ellipse 60 60 "solid" "blue") 'image "47.png")
-   (list '(scale/xy 3 2 (ellipse 20 30 "solid" "blue")) 'image "46.png")
-   (list '(ellipse 40 60 "solid" "blue") 'image "45.png")
-   (list '(scale 2 (ellipse 20 30 "solid" "blue")) 'image "44.png")
-   (list '(rotate 5 (rectangle 50 50 "outline" "black")) 'image "43.png")
-   (list '(rotate 45 (ellipse 60 20 "solid" "olivedrab")) 'image "42.png")
+    "33aaed94.png")
+   (list '(frame (ellipse 20 20 "outline" "black")) 'image "b3e371c.png")
+   (list '(ellipse 60 60 "solid" "blue") 'image "80c7ec4.png")
+   (list '(scale/xy 3 2 (ellipse 20 30 "solid" "blue")) 'image "1bebb5af.png")
+   (list '(ellipse 40 60 "solid" "blue") 'image "3f9b7651.png")
+   (list '(scale 2 (ellipse 20 30 "solid" "blue")) 'image "1a14c856.png")
+   (list '(rotate 5 (rectangle 50 50 "outline" "black")) 'image "24e78945.png")
+   (list
+    '(rotate 45 (ellipse 60 20 "solid" "olivedrab"))
+    'image
+    "36abd0a6.png")
    (list
     '(beside/places "baseline" (text "ijy" 18 "black") (text "ijy" 24 "black"))
     'image
-    "41.png")
+    "128db302.png")
    (list
     '(beside/places
       "center"
@@ -48,7 +51,7 @@
       (ellipse 20 30 "solid" "purple")
       (ellipse 20 10 "solid" "indigo"))
     'image
-    "40.png")
+    "120469a1.png")
    (list
     '(beside/places
       "bottom"
@@ -57,7 +60,7 @@
       (ellipse 20 30 "solid" "slateblue")
       (ellipse 20 10 "solid" "navy"))
     'image
-    "39.png")
+    "1cdad38e.png")
    (list
     '(beside
       (ellipse 20 70 "solid" "gray")
@@ -65,7 +68,7 @@
       (ellipse 20 30 "solid" "dimgray")
       (ellipse 20 10 "solid" "black"))
     'image
-    "38.png")
+    "5965553.png")
    (list
     '(overlay/xy
       (rectangle 10 10 "solid" "red")
@@ -73,7 +76,7 @@
       -10
       (rectangle 10 10 "solid" "black"))
     'image
-    "37.png")
+    "2e92034e.png")
    (list
     '(overlay/xy
       (rectangle 10 10 "solid" "red")
@@ -81,7 +84,7 @@
       10
       (rectangle 10 10 "solid" "black"))
     'image
-    "36.png")
+    "107a175b.png")
    (list
     '(overlay/xy
       (rectangle 10 10 "outline" "red")
@@ -89,7 +92,7 @@
       0
       (rectangle 10 10 "outline" "black"))
     'image
-    "35.png")
+    "f404e3c.png")
    (list
     '(overlay/xy
       (ellipse 40 40 "outline" "black")
@@ -97,7 +100,7 @@
       25
       (ellipse 10 10 "solid" "forestgreen"))
     'image
-    "34.png")
+    "28fdf75c.png")
    (list
     '(overlay/places
       "right"
@@ -107,7 +110,7 @@
       (rectangle 40 40 "solid" "red")
       (rectangle 50 50 "solid" "black"))
     'image
-    "33.png")
+    "1331b42e.png")
    (list
     '(overlay/places
       "middle"
@@ -115,7 +118,7 @@
       (rectangle 30 60 "solid" "orange")
       (ellipse 60 30 "solid" "purple"))
     'image
-    "32.png")
+    "10078cfc.png")
    (list
     '(overlay
       (ellipse 10 10 "solid" "red")
@@ -125,49 +128,75 @@
       (ellipse 50 50 "solid" "red")
       (ellipse 60 60 "solid" "black"))
     'image
-    "31.png")
+    "975b778.png")
    (list
     '(overlay
       (ellipse 60 30 "solid" "purple")
       (rectangle 30 60 "solid" "orange"))
     'image
-    "30.png")
+    "cd2e82.png")
    (list
     '(text/font "not really a link" 18 "blue" #f 'roman 'normal 'normal #t)
     'image
-    "29.png")
+    "11536865.png")
    (list
     '(text/font "Goodbye" 18 "indigo" #f 'modern 'italic 'normal #f)
     'image
-    "28.png")
+    "2c27a4ab.png")
    (list
     '(text/font "Hello" 24 "olive" "Gill Sans" 'swiss 'normal 'bold #f)
     'image
-    "27.png")
-   (list '(text "Goodbye" 36 "indigo") 'image "26.png")
-   (list '(text "Hello" 24 "olive") 'image "25.png")
-   (list '(line 30 -20 "red") 'image "24.png")
-   (list '(line -30 20 "red") 'image "23.png")
-   (list '(line 30 30 "black") 'image "22.png")
-   (list '(star-polygon 20 10 3 "solid" "cornflowerblue") 'image "21.png")
-   (list '(star-polygon 40 7 3 "outline" "darkred") 'image "20.png")
-   (list '(star-polygon 40 5 2 "solid" "seagreen") 'image "19.png")
-   (list '(star 40 "solid" "gray") 'image "18.png")
-   (list '(regular-polygon 20 8 "solid" "red") 'image "17.png")
-   (list '(regular-polygon 20 4 "outline" "blue") 'image "16.png")
-   (list '(regular-polygon 30 3 "outline" "red") 'image "15.png")
-   (list '(rhombus 80 150 "solid" "mediumpurple") 'image "14.png")
-   (list '(rhombus 40 45 "solid" "magenta") 'image "13.png")
-   (list '(rectangle 20 40 "solid" "blue") 'image "12.png")
-   (list '(rectangle 40 20 "outline" "black") 'image "11.png")
-   (list '(square 50 "outline" "darkmagenta") 'image "10.png")
-   (list '(square 40 "solid" "slateblue") 'image "9.png")
-   (list '(isosceles-triangle 60 330 "solid" "lightseagreen") 'image "8.png")
-   (list '(isosceles-triangle 60 30 "solid" "aquamarine") 'image "7.png")
-   (list '(isosceles-triangle 200 170 "solid" "seagreen") 'image "6.png")
-   (list '(right-triangle 36 48 "solid" "black") 'image "5.png")
-   (list '(triangle 40 "solid" "tan") 'image "4.png")
-   (list '(ellipse 20 40 "solid" "blue") 'image "3.png")
-   (list '(ellipse 40 20 "outline" "black") 'image "2.png")
-   (list '(circle 20 "solid" "blue") 'image "1.png")
-   (list '(circle 30 "outline" "red") 'image "0.png")))
+    "3a5f8054.png")
+   (list '(text "Goodbye" 36 "indigo") 'image "f6b7cc9.png")
+   (list '(text "Hello" 24 "olive") 'image "116768e2.png")
+   (list
+    '(add-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
+    "3c068285.png")
+   (list
+    '(add-line (ellipse 40 40 "outline" "maroon") 0 40 40 0 "maroon")
+    'image
+    "370a84fa.png")
+   (list '(line 30 -20 "red") 'image "35ca3e57.png")
+   (list '(line -30 20 "red") 'image "149f7bed.png")
+   (list '(line 30 30 "black") 'image "216299fe.png")
+   (list
+    '(star-polygon 20 10 3 "solid" "cornflowerblue")
+    'image
+    "1564e03e.png")
+   (list '(star-polygon 40 7 3 "outline" "darkred") 'image "33ded4e2.png")
+   (list '(star-polygon 40 5 2 "solid" "seagreen") 'image "35eefac.png")
+   (list '(star 40 "solid" "gray") 'image "194b0e44.png")
+   (list '(regular-polygon 20 8 "solid" "red") 'image "1343ddbd.png")
+   (list '(regular-polygon 40 4 "outline" "blue") 'image "36dc3be7.png")
+   (list '(regular-polygon 50 3 "outline" "red") 'image "110659e0.png")
+   (list '(rhombus 80 150 "solid" "mediumpurple") 'image "1817baf0.png")
+   (list '(rhombus 40 45 "solid" "magenta") 'image "eab359b.png")
+   (list '(rectangle 20 40 "solid" "blue") 'image "3f241026.png")
+   (list '(rectangle 40 20 "outline" "black") 'image "2c0ddeae.png")
+   (list '(square 50 "outline" "darkmagenta") 'image "97be4d.png")
+   (list '(square 40 "solid" "slateblue") 'image "5da309d.png")
+   (list
+    '(isosceles-triangle 60 330 "solid" "lightseagreen")
+    'image
+    "2fa1cd58.png")
+   (list
+    '(isosceles-triangle 60 30 "solid" "aquamarine")
+    'image
+    "1ea53369.png")
+   (list
+    '(isosceles-triangle 200 170 "solid" "seagreen")
+    'image
+    "1a19d76d.png")
+   (list '(right-triangle 36 48 "solid" "black") 'image "17923882.png")
+   (list '(triangle 40 "solid" "tan") 'image "264fff73.png")
+   (list '(ellipse 20 40 "solid" "blue") 'image "33bc4cc8.png")
+   (list '(ellipse 40 20 "outline" "black") 'image "3603dbc6.png")
+   (list '(circle 20 "solid" "blue") 'image "90999b2.png")
+   (list '(circle 30 "outline" "red") 'image "115c97e6.png")))

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

@@ -126,8 +126,8 @@ other. The top and bottom pair of angles is @scheme[angle] and the left and righ
          image?]{
   Constructs a regular polygon with @scheme[side-count] sides.
 
-  @image-examples[(regular-polygon 30 3 "outline" "red")
-                  (regular-polygon 20 4 "outline" "blue")
+  @image-examples[(regular-polygon 50 3 "outline" "red")
+                  (regular-polygon 40 4 "outline" "blue")
                   (regular-polygon 20 8 "solid" "red")]
 }
 
@@ -171,7 +171,26 @@ other. The top and bottom pair of angles is @scheme[angle] and the left and righ
                   (line -30 20 "red")
                   (line 30 -20 "red")]
 }
-                
+
+@defproc[(add-line [image image?]
+                   [x1 real?] [y1 real?]
+                   [x2 real?] [y2 real?]
+                   [color (or/c symbol? string?)])
+         image?]{
+
+  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]).
+  
+  @image-examples[(add-line (ellipse 40 40 "outline" "maroon")
+                            0 40 40 0 "maroon")
+                  (add-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")]
+}
+
 @defproc[(text [string string?] [font-size (and/c integer? (<=/c 1 255))] [color (or/c symbol? string?)])
          image?]{