added the radial-star primitive
This commit is contained in:
parent
168434bd21
commit
a612830b8e
|
@ -87,6 +87,7 @@ and they all have good sample contracts. (It is amazing what we can do with kids
|
||||||
polygon
|
polygon
|
||||||
star
|
star
|
||||||
star-polygon
|
star-polygon
|
||||||
|
radial-star
|
||||||
triangle
|
triangle
|
||||||
isosceles-triangle
|
isosceles-triangle
|
||||||
right-triangle
|
right-triangle
|
||||||
|
|
|
@ -924,6 +924,32 @@
|
||||||
(make-a-polygon (adjust (regular-polygon-points side-length side-count))
|
(make-a-polygon (adjust (regular-polygon-points side-length side-count))
|
||||||
mode color))
|
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)
|
(define (make-a-polygon points mode color)
|
||||||
(let* ([poly (make-polygon points mode color)]
|
(let* ([poly (make-polygon points mode color)]
|
||||||
[ltrb (simple-bb poly)]
|
[ltrb (simple-bb poly)]
|
||||||
|
@ -1087,6 +1113,7 @@
|
||||||
right-triangle
|
right-triangle
|
||||||
star
|
star
|
||||||
star-polygon
|
star-polygon
|
||||||
|
radial-star
|
||||||
|
|
||||||
line
|
line
|
||||||
add-line
|
add-line
|
||||||
|
|
|
@ -114,11 +114,18 @@
|
||||||
(if (string? arg)
|
(if (string? arg)
|
||||||
(string->symbol arg)
|
(string->symbol arg)
|
||||||
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
|
(check-arg fn-name
|
||||||
(and (real? arg)
|
(and (real? arg)
|
||||||
(not (negative? 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)
|
i arg)
|
||||||
arg]
|
arg]
|
||||||
[(dx dy x1 y1 x2 y2 pull1 pull2)
|
[(dx dy x1 y1 x2 y2 pull1 pull2)
|
||||||
|
|
File diff suppressed because it is too large
Load Diff
|
@ -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?)]
|
@defproc*[([(polygon [vertices (listof posn?)]
|
||||||
[mode mode?]
|
[mode mode?]
|
||||||
[color image-color?])
|
[color image-color?])
|
||||||
|
|
Loading…
Reference in New Issue
Block a user