added circle and star-polygon

svn: r16617

collects/2htdp/image.ss

@@ -64,10 +64,12 @@ and they all have good sample contracts. (It is amazing what we can do with kids
          scale
          scale/xy
          
+         circle
          ellipse
          rectangle
          regular-polygon
          star
+         star-polygon
          triangle
          
          x-place?

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

@@ -18,9 +18,6 @@
          
          frame
          
-         ellipse
-         rectangle
-         
          show-image
          save-image
          bring-between
@@ -40,9 +37,14 @@
          image-width
          image-height
          
+         circle
+         ellipse
+         rectangle
+         
          regular-polygon
          triangle 
          star
+         star-polygon
          
          swizzle)
 
@@ -190,7 +192,7 @@
      (if (string? arg)
          (string->symbol arg)
          arg)]
-    [(width height)
+    [(width height radius)
      (check-arg fn-name
                 (and (real? arg)
                      (not (negative? arg)))
@@ -621,11 +623,7 @@
         (make-point 0 height)))
   
 
-;;       circle
-;;       ellipse
-;;       triangle
 ;;       line
-;;       star
 ;;       text
 
 (define/chk (triangle side-length mode color)
@@ -635,6 +633,16 @@
   (make-polygon/star side-length side-count mode color values))
 
 (define/chk (star-polygon side-length side-count step-count mode color)
+  (check-arg 'star-polygon
+             (step-count . < . side-count)
+             (format "number that is smaller than the side-count (~a)" side-count)
+             3
+             step-count)
+  (check-arg 'star-polygon
+             (= 1 (gcd side-count step-count))
+             (format "number that is relatively prime to the side-count (~a)" side-count)
+             3
+             step-count)
   (make-polygon/star side-length side-count mode color (λ (l) (swizzle l step-count))))
 
 (define/chk (star side-length mode color)
@@ -650,6 +658,11 @@
                   (make-bb (- r l) (- b t) (- b t))
                   #f))))
 
+(define (gcd a b)
+  (cond
+    [(zero? b) a]
+    [else (gcd b (modulo a b))]))
+
 ;; swizzle : (listof X)[odd-length] -> (listof X)
 ;; returns a list with the same elements, 
 ;; but reordered according to the step. Eg, if the step
@@ -682,6 +695,12 @@
               (make-bb width height height)
               #f))
 
+(define/chk (circle radius mode color)
+  (let ([w/h (* 2 radius)])
+    (make-image (make-ellipse w/h w/h 0 mode color)
+                (make-bb w/h w/h w/h)
+                #f)))
+
 (define (mode-color->pen mode color)
   (send the-pen-list find-or-create-pen color 1 
         (case mode

collects/mrlib/image-core.ss

@@ -151,8 +151,11 @@ has been moved out).
                   (null? p2-points))
              (and (not (or (null? p1-points)
                            (null? p2-points)))
-                  (eq-recur (rotate-to-zero (closest-to-zero p1-points) p1-points)
-                            (rotate-to-zero (closest-to-zero p2-points) p2-points)))))))
+                  (or (eq-recur (rotate-to-zero (closest-to-zero p1-points) p1-points)
+                                (rotate-to-zero (closest-to-zero p2-points) p2-points))
+                      (let ([p1-rev (reverse p1-points)])
+                        (eq-recur (rotate-to-zero (closest-to-zero p1-rev) p1-rev)
+                                  (rotate-to-zero (closest-to-zero p2-points) p2-points)))))))))
 
 (define (rotate-to-zero zero-p points)
   (let loop ([points points]
@@ -412,7 +415,7 @@ has been moved out).
        (send path line-to (point-x (car points)) (point-y (car points)))
        (send dc set-pen (mode-color->pen (polygon-mode simple-shape) (polygon-color simple-shape)))
        (send dc set-brush (mode-color->brush (polygon-mode simple-shape) (polygon-color simple-shape)))
-       (send dc draw-path path dx dy))]
+       (send dc draw-path path dx dy 'winding))]
     [else
      (let ([dx (+ dx (translate-dx simple-shape))]
            [dy (+ dy (translate-dy simple-shape))]

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

@@ -23,7 +23,19 @@ Existing images can be rotated, scaled, and overlaid on top of each other.
 
 @section{Basic Images}
 
-@defproc[(ellipse [width real?] [height real?] [mode mode?] [color (or/c symbol? string?)]) image?]{
+@defproc[(circle [radius (and/c real? positive?)] 
+                 [mode mode?]
+                 [color (or/c symbol? string?)])
+         image?]{
+  Constructs a circle with the given radius, height, mode, and color.
+  
+  @image-examples[(circle 30 "outline" "red")
+                  (circle 20 "solid" "blue")]
+  
+}
+
+
+@defproc[(ellipse [width (and/c real? positive?)] [height (and/c real? positive?)] [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")
@@ -49,17 +61,6 @@ Existing images can be rotated, scaled, and overlaid on top of each other.
                   (regular-polygon 20 6 "solid" "red")]
 }
 
-@defproc[(star [side-length (and/c positive? real?)] 
-               [mode mode?]
-               [color (or/c symbol? string?)])
-         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?)] 
                    [mode mode?]
                    [color (or/c symbol? string?)])
@@ -72,6 +73,38 @@ Existing images can be rotated, scaled, and overlaid on top of each other.
 @image-examples[(triangle 40 "solid" "tan")]
 }
 
+@defproc[(star [side-length (and/c real? positive?)] 
+               [mode mode?]
+               [color (or/c symbol? string?)])
+         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[(star-polygon [side-length (and/c real? positive?)]
+                       [side-count side-count?]
+                       [step-count step-count?]
+                       [mode mode?]
+                       [color (or/c symbol? string?)])
+         image?]{
+ 
+  Constructs an arbitrary regular star polygon (a generalization of the regular polygons). 
+  The polygon is enclosed by a regular polygon with @scheme[side-count] sides each
+  @scheme[side-length] long. The polygon is actually constructed by going from vertex to
+  vertex around the regular polgon, but skipping over every @scheme[step-count] verticies.
+  
+  For examples, if @scheme[side-count] is @scheme[5] and @scheme[step-count] is @scheme[2],
+  then this function produces a shape just like @scheme[star].
+  
+  @image-examples[(star-polygon 40 5 2 "solid" "seagreen")
+                  (star-polygon 40 7 3 "outline" "darkred")
+                  (star-polygon 20 10 3 "solid" "cornflowerblue")]
+ 
+}
+                
 @section{Overlaying Images}
 
 @defproc[(overlay [i1 image?] [i2 image?] [is image?] ...) image?]{

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

@@ -68,6 +68,17 @@
           (map loop (cdr (vector->list (struct->vector x))))))]
       [else x])))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; circle vs ellipse
+;;
+
+(check-equal? (ellipse 40 40 'outline 'black)
+              (circle 20 'outline 'black))
+(check-equal? (ellipse 60 60 'solid 'red)
+              (circle 30 'solid 'red))
+
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 ;; width and height
@@ -536,8 +547,9 @@
 ;;  regular polygon
 ;;
 
+;; note: the regular-polygon and the rectangle generate the points in reverse directions.
 (check-equal? (round-numbers (regular-polygon 100 4 'outline 'green))
               (round-numbers (rectangle 100 100 'outline 'green)))
 
-(check-equal? (swizzle (list 0 1 2 3 4))
+(check-equal? (swizzle (list 0 1 2 3 4) 2)
               (list 0 2 4 1 3))