added polygon

svn: r16735

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

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

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)

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

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

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