added the radial-star primitive

This commit is contained in:
Robby Findler 2010-06-25 11:01:53 -05:00
parent 168434bd21
commit a612830b8e
5 changed files with 571 additions and 518 deletions

View File

@ -87,6 +87,7 @@ and they all have good sample contracts. (It is amazing what we can do with kids
polygon
star
star-polygon
radial-star
triangle
isosceles-triangle
right-triangle

View File

@ -924,6 +924,32 @@
(make-a-polygon (adjust (regular-polygon-points side-length side-count))
mode color))
(define/chk (radial-star point-count radius1 radius2 mode color)
(make-a-polygon (star-points radius1 radius2 point-count) mode color))
(define (star-points in-small-rad in-large-rad points)
(let* ([small-rad (- in-small-rad 1)]
[large-rad (- in-large-rad 1)]
[roff (floor (/ large-rad 2))])
(let loop ([i points])
(cond
[(zero? i) '()]
[else
(let* ([this-p (- i 1)]
[theta1 (* 2 pi (/ this-p points))]
[theta2 (* 2 pi (/ (- this-p 1/2) points))])
(let-values ([(x1 y1) (find-xy small-rad theta1)]
[(x2 y2) (find-xy large-rad theta2)])
(let ([p1 (make-point (+ large-rad x1)
(+ large-rad y1))]
[p2 (make-point (+ large-rad x2)
(+ large-rad y2))])
(list* p1 p2 (loop (- i 1))))))]))))
(define (find-xy radius theta)
(values (* radius (cos theta))
(* radius (sin theta))))
(define (make-a-polygon points mode color)
(let* ([poly (make-polygon points mode color)]
[ltrb (simple-bb poly)]
@ -1087,6 +1113,7 @@
right-triangle
star
star-polygon
radial-star
line
add-line

View File

@ -114,11 +114,18 @@
(if (string? arg)
(string->symbol arg)
arg)]
[(width height radius side-length side-length1 side-length2)
[(width height radius radius1 radius2 side-length side-length1 side-length2)
(check-arg fn-name
(and (real? arg)
(not (negative? arg)))
'non-negative-real-number
'non\ negative\ real\ number
i arg)
arg]
[(point-count)
(check-arg fn-name
(and (integer? arg)
(>= arg 2))
'integer\ greater\ than\ 2
i arg)
arg]
[(dx dy x1 y1 x2 y2 pull1 pull2)

View File

@ -109,15 +109,6 @@
(rectangle 40 100 "solid" "black")
20
10
180
1/2
20
90
180
1/2
"white")
20
10
0
1/2
20
@ -619,6 +610,11 @@
"burlywood")
'image
"25354f2b84e.png")
(list '(radial-star 32 30 40 "outline" "black") 'image "1fdee89ec7d.png")
(list
'(radial-star 8 8 64 "solid" "darkslategray")
'image
"296a50fddcd.png")
(list
'(star-polygon 20 10 3 "solid" "cornflowerblue")
'image
@ -652,4 +648,4 @@
(list '(ellipse 20 40 "solid" "blue") 'image "25451dd2997.png")
(list '(ellipse 40 20 "outline" "black") 'image "8cb34e62d4.png")
(list '(circle 20 "solid" "blue") 'image "54d58bf7f6.png")
(list '(circle 30 "outline" "red") 'image "262a4fa650a.png")))
(list '(circle 30 "outline" "red") 'image "262a4fa650a.png"))))

View File

@ -251,6 +251,28 @@ other. The top and bottom pair of angles is @racket[angle] and the left and righ
}
@defproc*[([(radial-star [point-count (and/c integer? (>=/c 2))]
[inner-radius (and/c real? (not/c negative?))]
[outer-radius (and/c real? (not/c negative?))]
[mode mode?]
[color image-color?])
image?]
[(radial-star [point-count (and/c integer? (>=/c 2))]
[inner-radius (and/c real? (not/c negative?))]
[outer-radius (and/c real? (not/c negative?))]
[outline-mode (or/c 'outline "outline")]
[pen-or-color (or/c pen? image-color?)])
image?])]{
Constructs a star-like polygon where the star is specified by two radii and a number of points.
The first radius determines where the points begin, the second determines where they end, and
the @scheme[point-count] argument determines how many points the star has.
@image-examples[(radial-star 8 8 64 "solid" "darkslategray")
(radial-star 32 30 40 "outline" "black")]
}
@defproc*[([(polygon [vertices (listof posn?)]
[mode mode?]
[color image-color?])