Scheme Turtle

Aus ProgrammingWiki
Archivierte Version vom 2008-12-06T14:12:38+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)

Ihr Browser unterstützt Canvas nicht.

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

Ihr Browser unterstützt Canvas nicht.

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)

Ihr Browser unterstützt Canvas nicht.

Zur Erforschung echter Rekursion verwenden wir die Prozedur random-walk.

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

<eval> (define random</eval>

 (random-maker 19768678116))  ;; Anfangswert verändern!

(clear canvas4) (move turtle4 200 110) (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 50 turtle4)

Ihr Browser unterstützt Canvas nicht.