Scheme Turtle

Wiki-Quelltext dieser Seite.

<language>Scheme</language>
<eval>
(clear canvas)
(move turtle 100 100)

(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>

<canvas></canvas>

<eval>
(clear canvas2)
(move turtle2 200 200)

(define tree
 (lambda(side winkel) 
  (cond [(< side 4) #t] 
        [else  
          (penwidth turtle2 (+ (/ side 10) 1 ))    
          (forward turtle2 side)  
          (left turtle2 winkel)  
          (tree (/ side 2) winkel)  
          (left turtle2 winkel)  
          (tree (/ side 2) winkel)  
          (right turtle2 (* 4 winkel))  
          (tree (/ side 2) winkel)  
          (left turtle2 winkel)  
          (tree (/ side 2) winkel)  
          (left turtle2 winkel)  
          (backward turtle2 side)])))

(tree 100 25)
</eval>

<canvas></canvas>

Die folgende Prozedure <tt>tree</tt> verwendet einen Parameter für die ''turtle''.

<eval>
(clear canvas3)
(move turtle3 200 200)

(define tree
 (lambda(side turtle) 
  (cond 
    ((< side 2) #t)
    (else  
      (penwidth turtle (+ (/ side 10) 1 ))    
      (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)
</eval>
<canvas></canvas>

Zur Erforschung echter Rekursion verwenden wir die Prozedur <tt>random-walk</tt>. 

<code hidden>
(define random-maker
  (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))))))))
</code>
<eval>
(define random
  (random-maker 19768116))  ;; Anfangswert verändern!

(clear canvas4)
(move turtle4 200 310)
(pencolor turtle4 0 0 200)

(define random-walk
  (lambda (angle length n turtle)
    (if (= n 0)
        ;(penerase turtle)
        (pencolor turtle4 220 0 0)
        (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 1000 turtle4)
</eval>
<canvas h=500></canvas>