racket/collects/graphics/turtle-examples.ss
2008-02-24 21:27:36 +00:00

311 lines
10 KiB
Scheme

(module turtle-examples mzscheme
(require mzlib/math
mzlib/etc
"turtles.ss")
(provide regular-poly regular-polys radial-turtles spaced-turtles
spokes spyro-gyra neato graphics-bexam serp-size serp serp-nosplit
koch-size koch-split koch-draw lorenz lorenz1 peano-size
peano-position-turtle peano fern-size fern1 fern2 gapped-lines)
(define (regular-poly sides radius)
(local [(define theta (/ (* 2 pi) sides))
(define side-len (* 2 radius (sin (/ theta 2))))
(define (draw-sides n)
(cond
[(zero? n) (void)]
[else
(draw side-len)
(turn/radians theta)
(draw-sides (sub1 n))]))]
(tprompt (move radius)
(turn/radians (/ (+ pi theta) 2))
(draw-sides sides))))
(define (regular-polys sides s)
(local [(define (make-polys n)
(cond
[(zero? n) (void)]
[else
(regular-poly sides (* n 5))
(make-polys (sub1 n))]))]
(make-polys sides)))
(define (radial-turtles n)
(cond
[(zero? n) (void)]
[else
(split (turn/radians (/ pi (expt 2 (sub1 n)))))
(radial-turtles (sub1 n))]))
(define (spaced-turtles n)
(cond
[(zero? n) (void)]
[else
(split (move (expt 2 (+ n 1))))
(spaced-turtles (sub1 n))]))
(define (spokes)
(radial-turtles 4)
(spaced-turtles 5)
(turn/radians (/ pi 2))
(draw 10))
(define (spyro-gyra)
(radial-turtles 4)
(regular-poly 3 100))
(define (neato)
(local [(define (spiral d t)
(cond
[(<= 1 d)
(draw d)
(turn/radians t)
(spiral (- d 1) t)]
[else (void)]))]
(radial-turtles 4)
(spiral 30 (/ pi 12))))
(define (graphics-bexam)
(local [(define (gb d)
(cond
[(<= d 3)
(draw d)]
[else
(local [(define new-d (/ d 3))]
(gb new-d)
(turn/radians (- (/ pi 2)))
(gb new-d)
(turn/radians (/ pi 2))
(gb new-d)
(turn/radians (/ pi 2))
(gb new-d)
(turn/radians (- (/ pi 2)))
(gb new-d))]))
(define square-size (expt 3 5))]
(split (turn/radians (/ pi 2))
(move square-size)
(turn/radians (- (/ pi 2)))
(move square-size)
(turn/radians pi))
(split (move square-size)
(turn/radians (/ pi 2)))
(gb square-size)))
(define serp-size 120)
(define (serp distance)
(local [(define sqrt3 (sqrt 3))
(define -2pi/3 (- 0 (/ (* 2 pi) 3)))
(define pi/6 (/ pi 6))
(define -5pi/6 (- 0 (/ (* 5 pi) 6)))
(define pi/2 (/ pi 2))
(define (engine distance)
(cond
[(< distance 1) (void)]
[else
(local [(define side-half (* distance sqrt3))
(define side (* 2 side-half))]
(turn/radians -2pi/3)
(move distance)
(split (move distance)
(turn/radians -5pi/6)
(draw side)
(turn/radians -5pi/6)
(move distance)
(turn/radians pi)
(split (turn/radians -5pi/6)
(move side-half)
(turn/radians pi/6)))
(engine (/ distance 2)))]))]
(move (* 2 distance))
(turn/radians (/ (* 5 pi) 6))
(draw (* distance 2 (sqrt 3)))
(turn/radians (/ (* 2 pi) 3))
(move (* distance 2 (sqrt 3)))
(turn/radians (/ (* 2 pi) 3))
(draw (* distance 2 (sqrt 3)))
(turn/radians (/ (* 2 pi) 3))
(turn/radians (/ pi 6))
(move (* 2 distance))
(turn/radians pi)
(engine distance)))
(define (serp-nosplit distance)
(local [(define sqrt3 (sqrt 3))
(define -2pi/3 (- 0 (/ (* 2 pi) 3)))
(define pi/6 (/ pi 6))
(define -5pi/6 (- 0 (/ (* 5 pi) 6)))
(define pi/2 (/ pi 2))
(define (engine distance)
(cond
[(< distance 1) (void)]
[else
(local [(define side-half (* distance sqrt3))
(define side (* 2 side-half))]
(turn/radians -2pi/3)
(move distance)
(engine (/ distance 2))
(move distance)
(turn/radians -5pi/6)
(draw side)
(turn/radians -5pi/6)
(move distance)
(turn/radians pi)
(engine (/ distance 2))
(turn/radians -5pi/6)
(move side-half)
(turn/radians pi/6)
(engine (/ distance 2))
(move (- distance)))]))]
(move (* 2 distance))
(turn/radians (/ (* 5 pi) 6))
(draw (* distance 2 (sqrt 3)))
(turn/radians (/ (* 2 pi) 3))
(move (* distance 2 (sqrt 3)))
(turn/radians (/ (* 2 pi) 3))
(draw (* distance 2 (sqrt 3)))
(turn/radians (/ (* 2 pi) 3))
(turn/radians (/ pi 6))
(move (* 2 distance))
(turn/radians pi)
(engine distance)))
(define koch-size (expt 3 5))
(define (koch-split koch-size)
(local [(define (build-up-turtles n)
(cond
[(<= n 3) 'built]
[else (local [(define third (/ n 3))]
(split* 'stay-put
(move (* 2 third))
(begin (move third)
(turn/radians (- (/ pi 3))))
(begin (move third)
(turn/radians (- (/ pi 3)))
(move third)
(turn/radians (* 2 (/ pi 3)))))
(build-up-turtles third))]))]
(split* 'stay-put
(begin (move koch-size)
(turn/radians (/ (* 2 pi) 3)))
(begin (turn/radians (/ pi 3))
(move koch-size)
(turn/radians pi)))
(build-up-turtles koch-size)
(draw 3)))
(define (koch-draw koch-size)
(local [(define (side n)
(cond
[(<= n 3) (draw n)]
[else (local [(define third (/ n 3))]
(side third)
(turn/radians (- (/ pi 3)))
(side third)
(turn/radians (* 2 (/ pi 3)))
(side third)
(turn/radians (- (/ pi 3)))
(side third))]))]
(split* 'stay-put
(begin (move koch-size)
(turn/radians (/ (* 2 pi) 3)))
(begin (turn/radians (/ pi 3))
(move koch-size)
(turn/radians pi)))
(side koch-size)))
(define (lorenz a b c)
(local [(define (loop x y z)
(local [(define delta 0.01)
(define dx (* delta (* a (- y x))))
(define dy (* delta (- (* x b) y (* x z))))
(define dz (* delta (- (* x y) (* c z))))]
(draw-offset dx dz)
(sleep 0.05)
(erase-offset (- dx) (- dz))
(move-offset dx dz)
(loop (+ x dx)
(+ y dy)
(+ z dz))))]
(loop 1 1 1)))
(define (lorenz1) (lorenz 50 60 11))
(define peano-size (expt 3 6))
(define (peano-position-turtle)
(clear)
(move -270)
(turn/radians (/ pi 2))
(move 250)
(turn/radians (- (/ (* 3 pi) 4))))
(define (peano l)
(cond
[(<= l 3)
(draw l)]
[else
(local [(define new-l (/ l 3))]
(peano new-l)
(tprompt (peano new-l)
(split* (turn/radians (/ pi 2))
(turn/radians (- (/ pi 2))))
(peano new-l))
(tprompt (split* (turn/radians (/ pi 2))
(turn/radians (- (/ pi 2))))
(peano new-l))
(tprompt (split* (move new-l)
(begin (turn/radians (/ pi 2))
(move new-l)
(turn/radians (- (/ pi 2))))
(begin (turn/radians (- (/ pi 2)))
(move new-l)
(turn/radians (/ pi 2))))
(peano l))
(move (* 2 new-l)))]))
(define fern-size 30)
(define (fern1 n)
(cond
[(< 1 n)
(draw (/ n 2))
(tprompt (split* (turn/radians (/ pi 3))
(turn/radians (- (/ pi 3))))
(fern1 (/ n 2)))
(draw (/ n 2))
(turn/radians 0.08)
(fern1 (- n 1))]
[else (void)]))
;; need to backup a little for this one.
(define (fern2 n)
(local [(define d 0.04)
(define (fernd n sign)
(cond
[(< 1 n)
(draw (/ n 2))
(tprompt (turn/radians (/ pi 3))
(fernd (/ n 2) -))
(tprompt (turn/radians (- (/ pi 3)))
(fernd (/ n 2) +))
(draw (/ n 2))
(turn/radians (sign d))
(fernd (- n 1) sign)]
[else (void)]))]
(fernd n +)))
(define (gapped-lines)
(local [(define gaps 5)
(define lines 3)]
(tprompt
(turn/radians (/ pi 2))
(spaced-turtles lines)
(turn/radians (- (/ pi 2)))
(draw (* 4 (expt 2 gaps))))
(tprompt
(spaced-turtles gaps)
(turn/radians (/ pi 2))
(erase (* 4 (expt 2 lines)))))))