added support for examples that don't return images

svn: r16626

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

@@ -1,6 +1,7 @@
 #lang scheme/gui
 
-(require 2htdp/private/image-more)
+(require 2htdp/private/image-more
+         mrlib/image-core)
 
 (define-namespace-anchor anchor)
 (define ns (namespace-anchor->namespace anchor))
@@ -25,20 +26,33 @@
 (define mapping '())
 
 (define (handle-image exp)
-  (let* ([i (length mapping)]
+  (printf ".") (flush-output)
-         [fn (format "~a.png" i)])
+  (let ([i (length mapping)])
-    (printf "saving ~s\n" exp)
+    (let ([result (parameterize ([current-namespace image-ns]) (eval exp))])
-    (set! mapping (cons (list exp fn) mapping))
+      (cond
-    (parameterize ([current-namespace image-ns])
+        [(image? result)
-      (save-image (eval exp)
+         (let ([fn (format "~a.png" i)])
-                  (build-path "img" fn)))))
+           (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 (read/write result)
+  (let-values ([(in out) (make-pipe)])
+    (thread (λ () (write result out) (close-output-port out)))
+    (read in)))
 
 (for-each handle-image expressions)
+(printf "\n")
+
 (call-with-output-file "image-toc.ss"
   (λ (port)
     (fprintf port "#lang scheme/base\n(provide mapping)\n")
-    (fprintf port ";; this file is generated by image-gen.ss -- do not edit\n\n")
+    (fprintf port ";; this file is generated by image-gen.ss -- do not edit\n;; note that the file that creates this file depends on this file\n;; it is always safe to simply define (and provide) mapping as the empty list\n\n")
     (pretty-print
-     `(define mapping (list ,@(map (λ (l) `(list ',(car l) ,(cadr l))) mapping)))
+     `(define mapping (list ,@mapping))
      port))
   #:exists 'truncate)

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

@@ -1,9 +1,25 @@
 #lang scheme/base
 (provide mapping)
 ;; this file is generated by image-gen.ss -- do not edit
+;; note that the file that creates this file depends on this file
+;; it is always safe to simply define (and provide) mapping as the empty list
 
 (define mapping
   (list
+   (list
+    '(image-height
+      (overlay (circle 20 "solid" "orange") (circle 30 "solid" "purple")))
+    'val
+    60)
+   (list '(image-height (circle 30 "solid" "orange")) 'val 60)
+   (list '(image-height (ellipse 30 40 "solid" "orange")) 'val 40)
+   (list
+    '(image-width
+      (beside (circle 20 "solid" "orange") (circle 20 "solid" "purple")))
+    'val
+    80)
+   (list '(image-width (circle 30 "solid" "orange")) 'val 60)
+   (list '(image-width (ellipse 30 40 "solid" "orange")) 'val 30)
    (list
     '(beside/places
       "bottom"
@@ -11,16 +27,18 @@
       (frame (ellipse 20 50 "solid" "mediumslateblue"))
       (ellipse 20 30 "solid" "slateblue")
       (ellipse 20 10 "solid" "navy"))
+    'image
     "38.png")
-   (list '(frame (ellipse 20 20 "outline" "black")) "37.png")
+   (list '(frame (ellipse 20 20 "outline" "black")) 'image "37.png")
-   (list '(ellipse 60 60 "solid" "blue") "36.png")
+   (list '(ellipse 60 60 "solid" "blue") 'image "36.png")
-   (list '(scale/xy 3 2 (ellipse 20 30 "solid" "blue")) "35.png")
+   (list '(scale/xy 3 2 (ellipse 20 30 "solid" "blue")) 'image "35.png")
-   (list '(ellipse 40 60 "solid" "blue") "34.png")
+   (list '(ellipse 40 60 "solid" "blue") 'image "34.png")
-   (list '(scale 2 (ellipse 20 30 "solid" "blue")) "33.png")
+   (list '(scale 2 (ellipse 20 30 "solid" "blue")) 'image "33.png")
-   (list '(rotate 5 (rectangle 50 50 "outline" "black")) "32.png")
+   (list '(rotate 5 (rectangle 50 50 "outline" "black")) 'image "32.png")
-   (list '(rotate 45 (ellipse 60 20 "solid" "olivedrab")) "31.png")
+   (list '(rotate 45 (ellipse 60 20 "solid" "olivedrab")) 'image "31.png")
    (list
     '(beside/places "baseline" (text "ijy" 18 "black") (text "ijy" 24 "black"))
+    'image
     "30.png")
    (list
     '(beside/places
@@ -29,6 +47,7 @@
       (ellipse 20 50 "solid" "darkorchid")
       (ellipse 20 30 "solid" "purple")
       (ellipse 20 10 "solid" "indigo"))
+    'image
     "29.png")
    (list
     '(beside/places
@@ -37,6 +56,7 @@
       (ellipse 20 50 "solid" "mediumslateblue")
       (ellipse 20 30 "solid" "slateblue")
       (ellipse 20 10 "solid" "navy"))
+    'image
     "28.png")
    (list
     '(beside
@@ -44,6 +64,7 @@
       (ellipse 20 50 "solid" "darkgray")
       (ellipse 20 30 "solid" "dimgray")
       (ellipse 20 10 "solid" "black"))
+    'image
     "27.png")
    (list
     '(overlay/xy
@@ -51,6 +72,7 @@
       -10
       -10
       (rectangle 10 10 "solid" "black"))
+    'image
     "26.png")
    (list
     '(overlay/xy
@@ -58,6 +80,7 @@
       10
       10
       (rectangle 10 10 "solid" "black"))
+    'image
     "25.png")
    (list
     '(overlay/xy
@@ -65,6 +88,7 @@
       10
       0
       (rectangle 10 10 "outline" "black"))
+    'image
     "24.png")
    (list
     '(overlay/xy
@@ -72,6 +96,7 @@
       25
       25
       (ellipse 10 10 "solid" "forestgreen"))
+    'image
     "23.png")
    (list
     '(overlay/places
@@ -81,6 +106,7 @@
       (rectangle 30 30 "solid" "black")
       (rectangle 40 40 "solid" "red")
       (rectangle 50 50 "solid" "black"))
+    'image
     "22.png")
    (list
     '(overlay/places
@@ -88,6 +114,7 @@
       "middle"
       (rectangle 30 60 "solid" "orange")
       (ellipse 60 30 "solid" "purple"))
+    'image
     "21.png")
    (list
     '(overlay
@@ -97,34 +124,39 @@
       (ellipse 40 40 "solid" "black")
       (ellipse 50 50 "solid" "red")
       (ellipse 60 60 "solid" "black"))
+    'image
     "20.png")
    (list
     '(overlay
       (ellipse 60 30 "solid" "purple")
       (rectangle 30 60 "solid" "orange"))
+    'image
     "19.png")
    (list
     '(text/font "not really a link" 18 "blue" #f 'roman 'normal 'normal #t)
+    'image
     "18.png")
    (list
     '(text/font "Goodbye" 18 "indigo" #f 'modern 'italic 'normal #f)
+    'image
     "17.png")
    (list
     '(text/font "Hello" 24 "olive" "Gill Sans" 'swiss 'normal 'bold #f)
+    'image
     "16.png")
-   (list '(text "Goodbye" 36 "indigo") "15.png")
+   (list '(text "Goodbye" 36 "indigo") 'image "15.png")
-   (list '(text "Hello" 24 "olive") "14.png")
+   (list '(text "Hello" 24 "olive") 'image "14.png")
-   (list '(star-polygon 20 10 3 "solid" "cornflowerblue") "13.png")
+   (list '(star-polygon 20 10 3 "solid" "cornflowerblue") 'image "13.png")
-   (list '(star-polygon 40 7 3 "outline" "darkred") "12.png")
+   (list '(star-polygon 40 7 3 "outline" "darkred") 'image "12.png")
-   (list '(star-polygon 40 5 2 "solid" "seagreen") "11.png")
+   (list '(star-polygon 40 5 2 "solid" "seagreen") 'image "11.png")
-   (list '(star 40 "solid" "gray") "10.png")
+   (list '(star 40 "solid" "gray") 'image "10.png")
-   (list '(triangle 40 "solid" "tan") "9.png")
+   (list '(triangle 40 "solid" "tan") 'image "9.png")
-   (list '(regular-polygon 20 6 "solid" "red") "8.png")
+   (list '(regular-polygon 20 6 "solid" "red") 'image "8.png")
-   (list '(regular-polygon 20 4 "outline" "blue") "7.png")
+   (list '(regular-polygon 20 4 "outline" "blue") 'image "7.png")
-   (list '(regular-polygon 30 3 "outline" "red") "6.png")
+   (list '(regular-polygon 30 3 "outline" "red") 'image "6.png")
-   (list '(rectangle 20 40 "solid" 'blue) "5.png")
+   (list '(rectangle 20 40 "solid" 'blue) 'image "5.png")
-   (list '(rectangle 40 20 "outline" 'black) "4.png")
+   (list '(rectangle 40 20 "outline" 'black) 'image "4.png")
-   (list '(ellipse 20 40 "solid" "blue") "3.png")
+   (list '(ellipse 20 40 "solid" "blue") 'image "3.png")
-   (list '(ellipse 40 20 "outline" "black") "2.png")
+   (list '(ellipse 40 20 "outline" "black") 'image "2.png")
-   (list '(circle 20 "solid" "blue") "1.png")
+   (list '(circle 20 "solid" "blue") 'image "1.png")
-   (list '(circle 30 "outline" "red") "0.png")))
+   (list '(circle 30 "outline" "red") 'image "0.png")))

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

@@ -6,8 +6,7 @@
          (for-syntax scheme/base)
          "image-toc.ss")
 
-(provide image-examples
+(provide image-examples)
-         exp->filename)
 
 (define-syntax (image-examples stx)
   (syntax-case stx ()
@@ -31,21 +30,25 @@
                                                        "s"))))
                (map (λ (x exp) 
                       (list x 
-                            (let ([fn (format "2htdp/scribblings/img/~a" (exp->filename exp))])
+                            (let ([line (exp->line exp)])
+                              (case (car line)
+                                [(val)
+                                 (schemeblock #,(schemeresult #,(cadr line)))]
+                                [(image)
+                                 (let ([fn (format "2htdp/scribblings/img/~a" (cadr line))])
                                    (if (file-exists? fn)
                                        (schemeblock #,(image fn))
                                        (make-paragraph
                                         error-color 
-                                   (format "missing image! ~a" (exp->filename exp)))))))
+                                        (format "missing image! ~a" (cadr line)))))]))))
                     expr-paras
                     val-list+outputs)))))
 
-(define (exp->filename exp) 
+(define (exp->line exp)
   (let ([fn (assoc exp mapping)])
     (cond 
-      [fn 
+      [fn (cdr fn)]
-       (cadr fn)]
       [else
        (unless (getenv "PLTSHOWIMAGES")
          (fprintf (current-error-port) "exp->filename: unknown exp ~s\n" exp))
-       "unk.png"])))
+       (list 'image "unk.png")])))

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

@@ -286,11 +286,21 @@ Existing images can be rotated, scaled, and overlaid on top of each other.
 
 @defproc[(image-width [i image?]) (and/c number? positive?)]{
   Returns the width of @scheme[i].
+                       
+  @image-examples[(image-width (ellipse 30 40 "solid" "orange"))
+                  (image-width (circle 30 "solid" "orange"))
+                  (image-width (beside (circle 20 "solid" "orange")
+                                       (circle 20 "solid" "purple")))]
 }
 
 @defproc[(image-height [i image?]) (and/c number? positive?)]{
   Returns the height of @scheme[i].
-}
+  
+  @image-examples[(image-height (ellipse 30 40 "solid" "orange"))
+                  (image-height (circle 30 "solid" "orange"))
+                  (image-height (overlay (circle 20 "solid" "orange")
+                                         (circle 30 "solid" "purple")))]
+  }
 
 @section{Image Predicates}
 
@@ -367,7 +377,7 @@ are equal. Similarly, constructing a 20x10 rectangle and
 then rotating it by 90 degress is equal to a 10x20 rectangle
 (provided they have the same color and mode).
 
-Equality testing contains a two surprises, though:
+Equality testing may contain a few nuances, though:
 @itemize[
   @item{Overlaying two images in opposite orders is never equal. For example,
         these two images are not @scheme[equal]:
@@ -390,4 +400,18 @@ Equality testing contains a two surprises, though:
          small roundoff errors that make the images draw slightly differently. 
          
          To combat this problem, use @scheme[equal~?] to compare the images,
-         or @scheme[check-within] for test suites involving images.}]
+         or @scheme[check-within] for test suites involving images.}
+   @item{In order to make equality on images created with 
+         @scheme[text] and @scheme[text/font]
+         work well, each string passed to either of those functions results
+         in a number of horizontally aligned images, one for each letter in the
+         string. This means that, for example
+         @schemeblock[(equal? (beside/places "baseline"
+                                             (text "a" 18 "black")
+                                             (text "b" 18 "black"))
+                              (text "ab" 18 "black"))]
+         is true, but that subtle aspects of font drawing may be wrong, since
+         the underlying toolkit only gets a single letter at a time, instead
+         of the entire word (or sentence).
+         }
+]