diff --git a/collects/2htdp/image.ss b/collects/2htdp/image.ss index 3e1fe09bfc..b3390d3b06 100644 --- a/collects/2htdp/image.ss +++ b/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? diff --git a/collects/2htdp/private/image-more.ss b/collects/2htdp/private/image-more.ss index 58ce429211..9a38042193 100644 --- a/collects/2htdp/private/image-more.ss +++ b/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 diff --git a/collects/mrlib/image-core.ss b/collects/mrlib/image-core.ss index 20bbcedb4b..e5b1ce6d40 100644 --- a/collects/mrlib/image-core.ss +++ b/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))] diff --git a/collects/teachpack/2htdp/scribblings/image.scrbl b/collects/teachpack/2htdp/scribblings/image.scrbl index 146adca8bc..55a7e0107c 100644 --- a/collects/teachpack/2htdp/scribblings/image.scrbl +++ b/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?]{ diff --git a/collects/teachpack/2htdp/scribblings/img/_circle_20__solid___blue__.png b/collects/teachpack/2htdp/scribblings/img/_circle_20__solid___blue__.png new file mode 100644 index 0000000000..8d9a9a112c Binary files /dev/null and b/collects/teachpack/2htdp/scribblings/img/_circle_20__solid___blue__.png differ diff --git a/collects/teachpack/2htdp/scribblings/img/_circle_30__outline___red__.png b/collects/teachpack/2htdp/scribblings/img/_circle_30__outline___red__.png new file mode 100644 index 0000000000..0dd50084e1 Binary files /dev/null and b/collects/teachpack/2htdp/scribblings/img/_circle_30__outline___red__.png differ diff --git a/collects/teachpack/2htdp/scribblings/img/_star-polygon_20_10_3__solid___cornflowerblue__.png b/collects/teachpack/2htdp/scribblings/img/_star-polygon_20_10_3__solid___cornflowerblue__.png new file mode 100644 index 0000000000..f7a36ef716 Binary files /dev/null and b/collects/teachpack/2htdp/scribblings/img/_star-polygon_20_10_3__solid___cornflowerblue__.png differ diff --git a/collects/teachpack/2htdp/scribblings/img/_star-polygon_40_5_2__solid___seagreen__.png b/collects/teachpack/2htdp/scribblings/img/_star-polygon_40_5_2__solid___seagreen__.png new file mode 100644 index 0000000000..ef08dc0821 Binary files /dev/null and b/collects/teachpack/2htdp/scribblings/img/_star-polygon_40_5_2__solid___seagreen__.png differ diff --git a/collects/teachpack/2htdp/scribblings/img/_star-polygon_40_7_3__outline___darkred__.png b/collects/teachpack/2htdp/scribblings/img/_star-polygon_40_7_3__outline___darkred__.png new file mode 100644 index 0000000000..192971e046 Binary files /dev/null and b/collects/teachpack/2htdp/scribblings/img/_star-polygon_40_7_3__outline___darkred__.png differ diff --git a/collects/teachpack/2htdp/scribblings/img/_star_40__solid___gray__.png b/collects/teachpack/2htdp/scribblings/img/_star_40__solid___gray__.png index ccecddf5d7..1e0951d5c7 100644 Binary files a/collects/teachpack/2htdp/scribblings/img/_star_40__solid___gray__.png and b/collects/teachpack/2htdp/scribblings/img/_star_40__solid___gray__.png differ diff --git a/collects/tests/2htdp/test-image.ss b/collects/tests/2htdp/test-image.ss index 292f045db1..b651402514 100644 --- a/collects/tests/2htdp/test-image.ss +++ b/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))