added examples to the 2htdp/image documentation

svn: r16616

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

@@ -22,6 +22,7 @@
          rectangle
          
          show-image
+         save-image
          bring-between
          
          image-snip->image
@@ -80,6 +81,17 @@
     (send (new button% [label "2"] [callback (λ x (scale-adjust add1))] [parent bp]) min-width 100)
     (send f show #t)))
 
+(define (save-image image filename)
+  (let* ([bm (make-object bitmap% 
+               (inexact->exact (ceiling (+ 1 (image-width image)))) 
+               (inexact->exact (ceiling (+ 1 (image-height image)))))]
+         [bdc (make-object bitmap-dc% bm)])
+    (send bdc set-smoothing 'aligned)
+    (send bdc clear)
+    (render-image image bdc 0 0)
+    (send bdc set-bitmap #f)
+    (send bm save-file filename 'png)))
+
 
 ;                                                                                                 
 ;                                                                                                 
@@ -197,6 +209,12 @@
                 'side-count
                 i arg)
      arg]
+    [(step-count)
+     (check-arg fn-name
+                (step-count? arg)
+                'step-count
+                i arg)
+     arg]
     [(angle)
      (check-arg fn-name
                 (angle? arg)
@@ -232,6 +250,9 @@
 (define (side-count? i)
   (and (integer? i)
        (3 . <= .  i)))
+(define (step-count? i)
+  (and (integer? i)
+       (1 . <= .  i)))
 
 (define (bitmap->image bm [mask-bm (send bm get-loaded-mask)])
   (make-image (make-bitmap bm mask-bm 0 1 #f)
@@ -609,10 +630,15 @@
 
 (define/chk (triangle side-length mode color)
   (make-polygon/star side-length 3 mode color values))
+
 (define/chk (regular-polygon side-length side-count mode color)
   (make-polygon/star side-length side-count mode color values))
+
+(define/chk (star-polygon side-length side-count step-count mode color)
+  (make-polygon/star side-length side-count mode color (λ (l) (swizzle l step-count))))
+
 (define/chk (star side-length mode color)
-  (make-polygon/star side-length 5 mode color swizzle))
+  (make-polygon/star side-length 5 mode color (λ (l) (swizzle l 2))))
 
 (define (make-polygon/star side-length side-count mode color adjust)
   (let ([poly (make-polygon 
@@ -620,22 +646,21 @@
                mode
                color)])
     (let-values ([(l t r b) (simple-bb poly)])
-      (printf "l ~s t ~s r ~s b ~s\n" l t r b)
       (make-image (make-translate (- l) (- t) poly)
                   (make-bb (- r l) (- b t) (- b t))
                   #f))))
 
 ;; swizzle : (listof X)[odd-length] -> (listof X)
 ;; returns a list with the same elements, 
-;; but reordered so the even elements come first 
-;; and then the odd elements afterwards
-(define (swizzle l)
+;; but reordered according to the step. Eg, if the step
+;; is 2, we get the even elements and then the odd ones.
+(define (swizzle l step)
   (let ([v (list->vector l)])
     (let loop ([i 0])
       (cond
         [(= i (vector-length v)) '()]
         [else
-         (cons (vector-ref v (modulo (* i 2) (vector-length v)))
+         (cons (vector-ref v (modulo (* i step) (vector-length v)))
                (loop (+ i 1)))]))))
 
 ;; regular-polygon-points : number number -> (listof point)

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

@@ -0,0 +1,44 @@
+#lang scheme/gui
+
+(require 2htdp/private/image-more
+         "image-util.ss")
+
+(define-namespace-anchor anchor)
+(define ns (namespace-anchor->namespace anchor))
+(define expressions
+  (parameterize ([current-namespace ns])
+    (putenv "PLTSHOWIMAGES" "show")
+    (let-values ([(in out) (make-pipe)])
+      (thread
+       (λ () 
+         (parameterize ([current-output-port out])
+           (dynamic-require "image.scrbl" #f))
+         (close-output-port out)))
+      (let loop ()
+        (let ([exp (read in)])
+          (if (eof-object? exp)
+              '()
+              (cons exp (loop))))))))
+
+(define-namespace-anchor image-anchor)
+(define image-ns (namespace-anchor->namespace anchor))
+
+(define (handle-image exp)
+  (printf "saving ~s\n" exp)
+  (parameterize ([current-namespace image-ns])
+    (save-image (eval exp)
+                (build-path "img" (exp->filename exp)))))
+
+(let ([ht (make-hash)])
+  (for-each
+   (λ (exp)
+     (when (hash-ref ht (exp->filename exp) #f)
+       (error 'image-gen.ss
+              "~s and ~s go to the same string, namely ~s"
+              (hash-ref ht (exp->filename exp))
+              exp
+              (exp->filename exp)))
+     (hash-set! ht (exp->filename exp) exp))
+   expressions))
+
+(for-each handle-image expressions)

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

@@ -0,0 +1,45 @@
+#lang scheme/base
+(require scribble/base
+         scribble/core
+         scribble/manual
+         scribble/scheme
+         (for-syntax scheme/base))
+(provide image-examples
+         exp->filename)
+
+(define-syntax (image-examples stx)
+  (syntax-case stx ()
+    [(_ exp ...)
+     (when (getenv "PLTSHOWIMAGES")
+       (for-each (λ (exp) (printf "~s\n" (syntax->datum exp)))
+                 (syntax->list #'(exp ...))))
+     #'(interleave 
+         (list (schemeinput exp) ...)
+         (list 'exp ...))]))
+
+(define (interleave expr-paras val-list+outputs)
+  (make-table
+   plain
+   (map list
+        (apply append
+               (list (make-paragraph plain (format "Example~a:"
+                                                   (if (or (null? expr-paras)
+                                                           (null? (cdr expr-paras)))
+                                                       ""
+                                                       "s"))))
+               (map (λ (x exp) 
+                      (list x 
+                            (let ([fn (format "2htdp/scribblings/img/~a" (exp->filename exp))])
+                              (if (file-exists? fn)
+                                  (schemeblock #,(image fn))
+                                  (make-paragraph
+                                   error-color 
+                                   (format "missing image! ~a" (exp->filename exp)))))))
+                    expr-paras
+                    val-list+outputs)))))
+
+(define (exp->filename exp)
+  (regexp-replace*
+   #rx"[() '\\/\"]"
+   (format "~s.png" exp)
+   "_"))

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

@@ -4,6 +4,7 @@
                      lang/htdp-beginner
                      scheme/gui/base)
           "shared.ss"
+          "image-util.ss"
           scribble/manual)
 
 @teachpack["image"]{Images}
@@ -24,10 +25,16 @@ Existing images can be rotated, scaled, and overlaid on top of each other.
 
 @defproc[(ellipse [width real?] [height real?] [mode mode?] [color (or/c symbol? string?)]) image?]{
   Constructs an ellipsis with the given width, height, mode, and color.
+  
+  @image-examples[(ellipse 40 20 "outline" "black")
+                  (ellipse 20 40 "solid" "blue")]
+  
 }
 
 @defproc[(rectangle [width real?] [height real?] [mode mode?] [color (or/c symbol? string?)]) image?]{
   Constructs a rectangle with the given width, height, mode, and color.
+  @image-examples[(rectangle 40 20 "outline" 'black)
+                  (rectangle 20 40 "solid" 'blue)]
 }
 
 @defproc[(regular-polygon [side-length (and/c positive? real?)] 
@@ -36,6 +43,10 @@ Existing images can be rotated, scaled, and overlaid on top of each other.
                           [color (or/c symbol? string?)])
          image?]{
   Constructs a regular polygon with @scheme[side-count] sides.
+
+  @image-examples[(regular-polygon 30 3 "outline" "red")
+                  (regular-polygon 20 4 "outline" "blue")
+                  (regular-polygon 20 6 "solid" "red")]
 }
 
 @defproc[(star [side-length (and/c positive? real?)] 
@@ -44,6 +55,9 @@ Existing images can be rotated, scaled, and overlaid on top of each other.
          image?]{
   Constructs a star with five points. The @scheme[side-length] argument 
   determines the side length of the enclosing pentagon.
+
+  @image-examples[(star 40 "solid" "gray")]
+  
 }
 
 @defproc[(triangle [side-length (and/c positive? real?)] 
@@ -54,62 +68,124 @@ Existing images can be rotated, scaled, and overlaid on top of each other.
   The @scheme[side-length] argument 
   determines the 
   length of the side of the triangle.
+
+@image-examples[(triangle 40 "solid" "tan")]
 }
 
-                
 @section{Overlaying Images}
 
 @defproc[(overlay [i1 image?] [i2 image?] [is image?] ...) image?]{
   Overlays all of its arguments building a single image. The first argument goes
   on top of the second argument, which goes on top of the third argument, etc.
   The images are all lined up on their upper-right corners
-}
+
+  @image-examples[(overlay (ellipse 60 30 "solid" "purple")
+                           (rectangle 30 60 "solid" "orange"))
+                  (overlay (ellipse 10 10 "solid" "red")
+                           (ellipse 30 30 "solid" "black")
+                           (ellipse 50 50 "solid" "red")
+                           (ellipse 70 70 "solid" "black"))]
+  
+  }
 
 @defproc[(overlay/places [x-place x-place?] [y-place y-place?] [i1 image?] [i2 image?] [is image?]) image?]{
   Overlays all of its image arguments, much like the @scheme[overlay] 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[(overlay/places "middle" "middle"
+                                  (rectangle 30 60 "solid" "orange")
+                                  (ellipse 60 30 "solid" "purple"))
+                  (overlay/places "right" "bottom"
+                                  (rectangle 20 20 "solid" "red")
+                                  (rectangle 30 30 "solid" "black")
+                                  (rectangle 40 40 "solid" "red")
+                                  (rectangle 50 50 "solid" "black"))]
+                                  
+  
+  }
 
 @defproc[(overlay/xy [i1 image?] [x real?] [y real?] [i2 image?]) image?]{
   Constructs an image by overlaying @scheme[i1] on top of @scheme[i2] after
   shifting @scheme[i2] over by @scheme[x] pixels to the right and @scheme[y] 
   pixels down.
+  @image-examples[(overlay/xy (ellipse 40 40 "outline" "black")
+                              25 
+                              25
+                              (ellipse 10 10 "solid" "forestgreen"))
+                  (overlay/xy (rectangle 10 10 "outline" "red")
+                              10 0
+                              (rectangle 10 10 "outline" "black"))
+                  (overlay/xy (rectangle 10 10 "solid" "red")
+                              10 10
+                              (rectangle 10 10 "solid" "black"))
+                  (overlay/xy (rectangle 10 10 "solid" "red")
+                              -10 -10
+                              (rectangle 10 10 "solid" "black"))]
 }
 
 @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.
-}
+
+  @image-examples[(beside (ellipse 20 70 "solid" "gray")
+                          (ellipse 20 50 "solid" "darkgray")
+                          (ellipse 20 30 "solid" "dimgray")
+                          (ellipse 20 10 "solid" "black"))]
+                          
+  
+  }
 
 @defproc[(beside/places [y-place y-place?] [i1 image?] [i2 image?] [is image?] ...) image?]{
   Constructs an image by placing all of the argument images in a horizontal row, lined
   up as indicated by the @scheme[y-place] argument. For example, if @scheme[y-place]
   is @scheme["middle"], then the images are placed side by side with their centers 
   lined up with each other.
-}
+
+  @image-examples[(beside/places "bottom"
+                                 (ellipse 20 70 "solid" "lightsteelblue")
+                                 (ellipse 20 50 "solid" "mediumslateblue")
+                                 (ellipse 20 30 "solid" "slateblue")
+                                 (ellipse 20 10 "solid" "navy"))
+                  
+                  (beside/places "center"
+                                 (ellipse 20 70 "solid" "mediumorchid")
+                                 (ellipse 20 50 "solid" "darkorchid")
+                                 (ellipse 20 30 "solid" "purple")
+                                 (ellipse 20 10 "solid" "indigo"))]
+                                 
+  
+  }
 
 @section{Rotating, Scaling, and Framing Images}
 
 @defproc[(rotate [angle angle?] [image image?]) image?]{
   Rotates @scheme[image] by @scheme[angle] degrees.                                                        
+
+          @image-examples[(rotate 45 (ellipse 60 20 "solid" "olivedrab"))
+                          (rotate 5 (rectangle 50 50 "outline" "black"))]
+          
 }
 
 @defproc[(scale [factor real?] [image image?]) image?]{
-  Scales @scheme[image] by @scheme[factor]. For example,
-  scaling @scheme[(ellipse 40 60 "solid" "blue")] by @scheme[2] produces
-  @scheme[(ellipse 80 120 "solid" "blue")].
+  Scales @scheme[image] by @scheme[factor]. 
+         
+         @image-examples[(scale 2 (ellipse 20 30 "solid" "blue"))
+                         (ellipse 40 60 "solid" "blue")]
+  
+  
+  
 }
 
 @defproc[(scale/xy [x-factor real?] [y-factor real?] [image image?]) image?]{
   Scales @scheme[image] by @scheme[x-factor] horizontally and by 
-  @scheme[y-factor] vertically. For example,
-  @schemeblock[(scale/xy 3 
-                         2 
-                         (ellipse 40 60 "solid" "blue"))] 
-  produces
-  @scheme[(ellipse 120 120 "solid" "blue")].
+  @scheme[y-factor] vertically. 
+  
+  @image-examples[(scale/xy 3 
+                            2 
+                            (ellipse 20 30 "solid" "blue")) 
+                  (ellipse 60 60 "solid" "blue")]
 }
 
 
@@ -118,9 +194,17 @@ Existing images can be rotated, scaled, and overlaid on top of each other.
   with a black, single pixel frame drawn around the 
   bounding box of the image.
   
+  @image-examples[(frame (ellipse 20 20 "outline" "black"))]
+  
   Generally speaking, this function is useful to 
   debug image constructions, i.e., to see where
   certain sub-images appear within some larger image.
+  
+  @image-examples[(beside/places "bottom"
+                                 (ellipse 20 70 "solid" "lightsteelblue")
+                                 (frame (ellipse 20 50 "solid" "mediumslateblue"))
+                                 (ellipse 20 30 "solid" "slateblue")
+                                 (ellipse 20 10 "solid" "navy"))]
 }
 
 @section{Image Properties}