56 lines
1.1 KiB
Scheme
56 lines
1.1 KiB
Scheme
|
|
||
|
(define pi (* 2 (acos 0)))
|
||
|
|
||
|
(define res 200)
|
||
|
|
||
|
(define data
|
||
|
(letrec
|
||
|
((delta (/ (* 2 pi) res))
|
||
|
(vect (make-vector res))
|
||
|
(iter
|
||
|
(lambda (q)
|
||
|
(if (< q res)
|
||
|
(begin
|
||
|
(vector-set!
|
||
|
vect q
|
||
|
(cons (cos (* q delta))
|
||
|
(sin (* q delta))))
|
||
|
(iter (+ 1 q)))))))
|
||
|
(iter 0)
|
||
|
vect))
|
||
|
|
||
|
(define draw-circle
|
||
|
(lambda (radius)
|
||
|
(letrec
|
||
|
((iter
|
||
|
(lambda (q)
|
||
|
(if (< q res)
|
||
|
(begin
|
||
|
(draw-line
|
||
|
(* radius (car (vector-ref data q)))
|
||
|
(* radius (cdr (vector-ref data q))))
|
||
|
(iter (+ 1 q)))))))
|
||
|
(draw-move radius 0)
|
||
|
(iter 0)
|
||
|
(draw-line radius 0))))
|
||
|
|
||
|
(define steps 8)
|
||
|
|
||
|
(define circles
|
||
|
(lambda (maxrad)
|
||
|
(letrec
|
||
|
((iter
|
||
|
(lambda (q)
|
||
|
(if (< q maxrad)
|
||
|
(begin
|
||
|
(draw-color 0 (/ (* 255.0 q) maxrad) 0)
|
||
|
(draw-circle q)
|
||
|
(iter (+ q steps)))))))
|
||
|
(iter 1))))
|
||
|
|
||
|
(circles 100)
|
||
|
|
||
|
|
||
|
|
||
|
|