;; Koch-Kurven

(load "turtle.scm")

;; Schneeflocke

(define snowflake-side
  (lambda (turtle distance depth)
    (if (= depth 0)
	(turtle-forward! turtle distance)
	(let* ((part (/ distance 3.0))
	       (side (/ part (sqrt 2.0))))
	  (snowflake-side turtle part (- depth 1))
	  (turtle-turn-left! turtle (degrees 45))
	  (snowflake-side turtle side (- depth 1))
	  (turtle-turn-right! turtle (degrees 90))
	  (snowflake-side turtle side (- depth 1))
	  (turtle-turn-left! turtle (degrees 45))
	  (snowflake-side turtle part (- depth 1))))))

(define snowflake
  (lambda (turtle side-length depth)
    (snowflake-side turtle side-length depth)
    (turtle-turn-right! turtle (degrees 60))
    (snowflake-side turtle side-length depth)
    (turtle-turn-right! turtle (degrees 60))
    (snowflake-side turtle side-length depth)
    (turtle-turn-right! turtle (degrees 60))
    (snowflake-side turtle side-length depth)
    (turtle-turn-right! turtle (degrees 60))
    (snowflake-side turtle side-length depth)
    (turtle-turn-right! turtle (degrees 60))
    (snowflake-side turtle side-length depth)))

;; C-Kurve

(define c-curve
  (lambda (turtle distance depth)
    (if (= depth 0)
	(turtle-forward! turtle distance)
	(let ((side (/ distance (sqrt 2.0))))
	  (turtle-turn-right! turtle (degrees 45))
	  (c-curve turtle side (- depth 1))
	  (turtle-turn-left! turtle (degrees 90))
	  (c-curve turtle side (- depth 1))
	  (turtle-turn-right! turtle (degrees 45))))))

;; Sierpinski-Dreieck

(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 sierpinski
  (lambda (turtle distance)
    (letrec
	((engine
	  (lambda (distance)
	    (if (< distance 1)
		'pappnase
		(let* ((side-half (* distance sqrt3))
		       (side (* 2 side-half)))
		  (turtle-turn-left! turtle -2pi/3)
		  (turtle-up! turtle)
		  (turtle-forward! turtle distance)
		  (turtle-down! turtle)
		  (engine (/ distance 2))
		  (turtle-up! turtle)		
		  (turtle-forward! turtle distance)
		  (turtle-down! turtle)		
		  (turtle-turn-left! turtle -5pi/6)
		  (turtle-forward! turtle side)
		  (turtle-turn-left! turtle -5pi/6)
		  (turtle-up! turtle)		
		  (turtle-forward! turtle distance)
		  (turtle-down! turtle)		
		  (turtle-turn-left! turtle pi)
		  (engine (/ distance 2))
		  (turtle-turn-left! turtle -5pi/6)
		  (turtle-up! turtle)
		  (turtle-forward! turtle side-half)
		  (turtle-down! turtle)
		  (turtle-turn-left! turtle pi/6)
		  (engine (/ distance 2))
		  (turtle-up! turtle)
		  (turtle-forward! turtle (- distance))
		  (turtle-down! turtle))))))
      (turtle-up! turtle)
      (turtle-forward! turtle (* 2 distance))
      (turtle-down! turtle)
      (turtle-turn-left! turtle (/ (* 5 pi) 6))
      (turtle-forward! turtle (* distance 2 (sqrt 3)))
      (turtle-turn-left! turtle (/ (* 2 pi) 3))
      (turtle-up! turtle)
      (turtle-forward! turtle (* distance 2 (sqrt 3)))
      (turtle-down! turtle)
      (turtle-turn-left! turtle (/ (* 2 pi) 3))
      (turtle-forward! turtle (* distance 2 (sqrt 3)))
      (turtle-turn-left! turtle (/ (* 2 pi) 3))
      (turtle-turn-left! turtle (/ pi 6))
      (turtle-up! turtle)
      (turtle-forward! turtle (* 2 distance))
      (turtle-down! turtle)
      (turtle-turn-left! turtle pi)
      (engine distance))))


(define canvas (make-bitmap-canvas 400 400))
(define frame (make-frame "Koch" canvas))
(show-frame frame)
(define turtle (make-turtle canvas 200 200))
; (snowflake turtle 100 5)
; (sierpinski turtle 100)
; (c-curve turtle 100 12)