Scheme Turtle
Aus ProgrammingWiki
Archivierte Version vom 2008-12-06T12:37:06+00:00. Aktuelle Version
<eval> (clear canvas) (move turtle 100 100)</eval>
(penwidth turtle 5) (pencolor turtle 255 0 0) (forward turtle 50) (right turtle 90) (forward turtle 50) (right turtle 90) (pencolor turtle 0 0 255) (forward turtle 50) (right turtle 90) (forward turtle 50)
(define t (clone turtle)) (forward t 50)
<eval> (clear canvas2) (move turtle2 200 200)</eval>
(define tree
(lambda(side)
(cond [(< side 2) #t]
[else
(penwidth turtle2 (/ side 10))
(forward turtle2 side)
(left turtle2 45)
(tree(/ side 2))
(right turtle2 90)
(tree(/ side 2))
(left turtle2 45)
(backward turtle2 side)])))(tree 100)
Die folgende Prozedure tree verwendet einen Parameter für die turtle.
<eval> (clear canvas3) (move turtle3 200 200)</eval>
(define tree
(lambda(side turtle)
(cond
((< side 2) #t)
(else
(penwidth turtle (/ side 10))
(forward turtle side)
(left turtle 45)
(tree (/ side 2) (clone turtle))
(right turtle 90)
(tree (/ side 2) (clone turtle))
(left turtle 45)
(backward turtle side)))))(tree 100 turtle3)
Zur Erforschung echter Rekursion verwenden wir die Prozedur random-walk.
<eval> (define random-maker</eval>
(let* ((multiplier 48271)
(modulus 2147483647)
(apply-congruence
(lambda (current-seed)
(let ((candidate (modulo (* current-seed multiplier)
modulus)))
(if (zero? candidate)
modulus
candidate))))
(coerce
(lambda (proposed-seed)
(if (integer? proposed-seed)
(- modulus (modulo proposed-seed modulus))
19860617)))) ;; an arbitrarily chosen birthday
(lambda (initial-seed)
(let ((seed (coerce initial-seed)))
(lambda args
(cond ((null? args)
(set! seed (apply-congruence seed))
(/ (- modulus seed) modulus))
((null? (cdr args))
(let* ((proposed-top
(ceiling (abs (car args))))
(exact-top
(if (inexact? proposed-top)
(inexact->exact proposed-top)
proposed-top))
(top
(if (zero? exact-top)
1
exact-top)))
(set! seed (apply-congruence seed))
(inexact->exact (floor (* top (/ seed modulus))))))
((eq? (cadr args) 'reset)
(set! seed (coerce (car args))))
(else
(display "random: unrecognized message")
(newline))))))))(define random
(random-maker 19781116)) ;; another arbitrarily chosen birthday
(clear canvas4) (move turtle4 200 200)
(define random-walk
(lambda (angle length n turtle)
(if (= n 0)
(penerase turtle)
(begin
(forward turtle length)
(right turtle angle)
(random-walk (+ 5 (random angle))(+ 5 (random length)) (- n 1) turtle)
;(sleep-for-a-while 0.01)
(left turtle angle)
(backward turtle length)))))(random-walk 360 20 50 turtle4)