(require-library "graphics.ss" "graphics")

(define pi 3.1415926536)
(define pi/2 (/ pi 2))
(define pi/3 (/ pi 3))

(define x-color
  (lambda (r g b)
    (make-rgb (/ r 256) (/ g 256) (/ b 256))))

(define brown  (x-color 165 42 42))
(define brown4 (x-color 128 48 0))
(define brown3 (x-color 160 64 0))
(define green4 (x-color 0 144 0))
(define green3 (x-color 0 156 0))
(define green2 (x-color 0 188 0))


(define initial-color-sequence
  (list brown4 brown3 green4 green3 green2))





(define sphere-color (make-rgb 1 0 0))
(define sphere-factor 0.7)
(define sphere-diameter-factor 0.1)

(define draw-sphere
  (lambda (v p thick d)
    (let* ((diameter (* thick sphere-diameter-factor))
           (real-p (make-posn (- (posn-x p) (/ diameter 2))
                              (+ (posn-y p) (/ diameter 5)))))
      ((draw-solid-ellipse v)
       real-p
       diameter
       diameter
       sphere-color))))









(define len-shrink-factor 0.5)
(define thick-shrink-factor 0.7)
(define size-factor 0.9)
(define delta-factor 0.9)
(define max-depth 4)


















(define grow
  (lambda (v n d p0 phi len thickness color-sequence)
    (if (< n max-depth)
        (let ((this-rgb (car color-sequence))
              (p1 (polar-add p0 (+ phi pi/2) thickness))
              (p2 (polar-add p0 phi len))
              (p3 (polar-add p0 (- phi pi/2) thickness)))
          ((draw-solid-polygon v) (list p1 p2 p3) (make-posn 0 0) this-rgb)
          (let loop ((t 0.05) (i 0) (delta 0.1))
            (if (< t 1)
                (let ((new-d (if (odd? i) (- d) d)))
                  (grow v
                        (+ n 1)
                        new-d
                        (polar-add p0 phi (* t len))
                        (+ phi (* new-d pi/3))
                        (* len len-shrink-factor (- 1 t))
                        (* thickness thick-shrink-factor)
                        (cdr color-sequence))
                  (loop (+ t delta) (+ i 1) (* delta delta-factor)))))
          


          (if (= n 1)
              (draw-sphere v 
                           (polar-add p0 phi (* sphere-factor len))
                           len
                           d))))))


















(define christmas-tree
  (lambda (size)
    (open-graphics)
    (let* ((v (open-viewport "Christmas Tree" size size))
           (root (make-posn (/ size 2) size)))
      (grow v 0 1 root (- pi/2) (* size-factor size) 6
            initial-color-sequence)
      (get-mouse-click v)
      (close-viewport v)
      (close-graphics))))













(define polar-add
  (lambda (p phi r)
    (let ((x (posn-x p))
          (y (posn-y p)))
      (make-posn (+ x (* r (cos phi)))
                 (+ y (* r (sin phi)))))))