suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

added explode-star

Browse Source 
svn: r2541
This commit is contained in:
Robby Findler 2006-03-30 02:30:57 +00:00
parent 68334bd959
commit 26294f0232
2 changed files with 64 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/texpict/doc.txt
View File

@ -341,6 +341,15 @@ Basic Constructors:
Creates a fish, swimming either 'left or 'right.
[MrEd only, in utils.ss]
> (explode-star small-rad large-rad points line-size line-color)
Creates a star-shaped explosion thingy. The points are
aligned on two radii, one for the beginning of the points
and one for the end, large-rad and small-rad. points is
the number of spikes sitcking out, and line-size and
line-color are the thickness of the lines and the lines
color.
Combiners:
----------

53
collects/texpict/utils.ss
View File

@ -3,6 +3,7 @@
(require (lib "class.ss")
(lib "math.ss")
(lib "etc.ss")
(lib "contract.ss")
(lib "mred.ss" "mred"))
(require "mrpict.ss")
@ -934,4 +935,56 @@
0 0 0 2)
"blue"))
(provide/contract [explode-star
(-> number? number? number? number? (union (is-a?/c color%) string?) pict?)])
;; abstract-explosion number number number number color -> pict
(define (explode-star small-rad large-rad points line-size line-color)
(define (find-xy radius theta)
(values (* radius (cos theta))
(* radius (sin theta))))
(let ([roff (floor (/ large-rad 2))]
[fx #f]
[fy #f])
(dc
(lambda (dc dx dy)
(let ([old-pen (send dc get-pen)])
(send dc set-pen (send the-pen-list find-or-create-pen line-color line-size 'solid))
(let loop ([i points]
[lx #f]
[ly #f])
(cond
[(zero? i) (when (and lx ly)
(send dc draw-line
(+ dx large-rad lx)
(+ dy large-rad ly)
(+ dx large-rad fx)
(+ dy large-rad fy)))]
[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)])
(unless (and fx fy)
(set! fx x1)
(set! fy y1))
(when (and lx ly)
(send dc draw-line
(+ dx large-rad lx)
(+ dy large-rad ly)
(+ dx large-rad x1)
(+ dy large-rad y1)))
(send dc draw-line
(+ dx large-rad x1)
(+ dy large-rad y1)
(+ dx large-rad x2)
(+ dy large-rad y2))
(loop (- i 1)
x2
y2)))]))
(send dc set-pen old-pen)))
(* large-rad 2)
(* large-rad 2)
0
0)))
)