diff --git a/collects/2htdp/image.ss b/collects/2htdp/image.ss index 25c2426037..3ca112db06 100644 --- a/collects/2htdp/image.ss +++ b/collects/2htdp/image.ss @@ -71,6 +71,7 @@ and they all have good sample contracts. (It is amazing what we can do with kids square rhombus regular-polygon + polygon star star-polygon triangle diff --git a/collects/2htdp/private/image-more.ss b/collects/2htdp/private/image-more.ss index a5c7a2d729..11d951eb16 100644 --- a/collects/2htdp/private/image-more.ss +++ b/collects/2htdp/private/image-more.ss @@ -6,6 +6,7 @@ scheme/gui/base htdp/error scheme/math + lang/posn (for-syntax scheme/base)) (define (show-image g [extra-space 0]) @@ -214,6 +215,17 @@ arg] [(underline) (and arg #t)] + [(posns) + (check-arg fn-name + (and (list? arg) + (andmap posn? arg)) + 'list-of-posns + i arg) + (check-arg fn-name + (>= (length arg) 3) + 'list-of-at-least-three-posns + i arg) + arg] [else (error 'check "the function ~a has an argument with an unknown name: ~s" fn-name @@ -653,6 +665,11 @@ ;; rectangle +(define/chk (polygon posns mode color) + (make-a-polygon (map (λ (p) (make-point (posn-x p) (posn-y p))) posns) + mode + color)) + (define/chk (rectangle width height mode color) (make-a-polygon (rectangle-points width height) mode color)) @@ -901,6 +918,7 @@ square rhombus + polygon regular-polygon triangle isosceles-triangle diff --git a/collects/teachpack/2htdp/scribblings/image-gen.ss b/collects/teachpack/2htdp/scribblings/image-gen.ss index 63a4c83d75..cbaf4b9c66 100644 --- a/collects/teachpack/2htdp/scribblings/image-gen.ss +++ b/collects/teachpack/2htdp/scribblings/image-gen.ss @@ -1,6 +1,7 @@ #lang scheme/gui (require 2htdp/private/image-more + lang/posn mrlib/image-core) (define-namespace-anchor anchor) diff --git a/collects/teachpack/2htdp/scribblings/image-toc.ss b/collects/teachpack/2htdp/scribblings/image-toc.ss index 410b31fdd7..adc68393fa 100644 --- a/collects/teachpack/2htdp/scribblings/image-toc.ss +++ b/collects/teachpack/2htdp/scribblings/image-toc.ss @@ -207,6 +207,32 @@ (list '(line 30 -20 "red") 'image "12948ac080d.png") (list '(line -30 20 "red") 'image "69aaaa680d.png") (list '(line 30 30 "black") 'image "8e1ebaaf82.png") + (list + '(polygon + (list + (make-posn 0 0) + (make-posn 0 40) + (make-posn 20 40) + (make-posn 20 60) + (make-posn 40 60) + (make-posn 40 20) + (make-posn 20 20) + (make-posn 20 0)) + "solid" + "plum") + 'image + "150e1d5e9f.png") + (list + '(polygon + (list + (make-posn 0 0) + (make-posn -10 20) + (make-posn 60 0) + (make-posn -10 -20)) + "solid" + "burlywood") + 'image + "25354f2b84e.png") (list '(star-polygon 20 10 3 "solid" "cornflowerblue") 'image diff --git a/collects/teachpack/2htdp/scribblings/image.scrbl b/collects/teachpack/2htdp/scribblings/image.scrbl index 926c5d4bd5..81a0403719 100644 --- a/collects/teachpack/2htdp/scribblings/image.scrbl +++ b/collects/teachpack/2htdp/scribblings/image.scrbl @@ -1,8 +1,10 @@ #lang scribble/doc @(require (for-label (except-in 2htdp/image image?) - lang/htdp-beginner + ;lang/htdp-beginner;(only-in beginner-require) + lang/posn scheme/gui/base) + lang/posn "shared.ss" "image-util.ss" scribble/manual) @@ -162,6 +164,28 @@ other. The top and bottom pair of angles is @scheme[angle] and the left and righ (star-polygon 20 10 3 "solid" "cornflowerblue")] } + +@defproc[(polygon [verticies (listof posn?)] + [mode mode?] + [color (or/c symbol? string?)]) + image?]{ + Constructs a polygon connecting the given verticies. + + @image-examples[(polygon (list (make-posn 0 0) + (make-posn -10 20) + (make-posn 60 0) + (make-posn -10 -20)) + "solid" "burlywood") + (polygon (list (make-posn 0 0) + (make-posn 0 40) + (make-posn 20 40) + (make-posn 20 60) + (make-posn 40 60) + (make-posn 40 20) + (make-posn 20 20) + (make-posn 20 0)) + "solid" "plum")] +} @defproc[(line [x1 real?] [y1 real?] [color (or/c symbol? string?)]) image?]{ Constructs an image representing a line segment that connects the points diff --git a/collects/teachpack/2htdp/scribblings/img/150e1d5e9f.png b/collects/teachpack/2htdp/scribblings/img/150e1d5e9f.png new file mode 100644 index 0000000000..f659e69124 Binary files /dev/null and b/collects/teachpack/2htdp/scribblings/img/150e1d5e9f.png differ diff --git a/collects/teachpack/2htdp/scribblings/img/25354f2b84e.png b/collects/teachpack/2htdp/scribblings/img/25354f2b84e.png new file mode 100644 index 0000000000..953227b9f7 Binary files /dev/null and b/collects/teachpack/2htdp/scribblings/img/25354f2b84e.png differ diff --git a/collects/tests/2htdp/test-image.ss b/collects/tests/2htdp/test-image.ss index be82e56d18..4e9f29683a 100644 --- a/collects/tests/2htdp/test-image.ss +++ b/collects/tests/2htdp/test-image.ss @@ -1,6 +1,7 @@ #lang scheme/base (require "../../mrlib/image-core.ss" "../../2htdp/private/image-more.ss" + lang/posn scheme/math scheme/class scheme/gui/base @@ -179,6 +180,27 @@ (check-close (image-height (rotate 30 (ellipse 0 100 'solid 'blue))) (* (cos (* pi 1/6)) 100)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; polygon equality +;; + +(check-equal? (polygon (list (make-posn 0 0) + (make-posn 10 10) + (make-posn 10 0)) + "solid" "plum") + (polygon (list (make-posn 10 10) + (make-posn 10 0) + (make-posn 0 0)) + "solid" "plum")) + +(check-equal? (polygon (list (make-posn 0 0) + (make-posn 0 10) + (make-posn 10 10) + (make-posn 10 0)) + "solid" "plum") + (rectangle 10 10 "solid" "plum")) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; testing overlays