(require scheme/class)

(define (build-ring n sr er)
    (let ((p (build-polygons (+ (* n 2) 2) 'triangle-strip)))
        (with-primitive p
            (pdata-index-map!
                (lambda (i p)
                    (let ((a (* (/ (quotient i 2) n) (* 2 3.141)))
                            (s (if (odd? i) sr er)))
                        (vector (* (cos a) s) (* (sin a) s) (if (odd? i) 0 1))))
                "p")
            (recalc-normals 1))
        p))


(define twig%
    (class object%
        (init-field
            (size 100)
            (radius 1)
            (speed 0.2))
        (field
            (root (build-locator))
            (child-twigs '())
            (age 0)
            (tx (mident))
            (next-ring-time 0))
        
        (define/public (build pos dir)
            (with-primitive root
                (translate pos)
                (if dir  (concat (maim dir (vector 0 0 1)))       
                    (rotate (vmul (crndvec) 20)))))
        
        (define/public (update)
            (when (and (< age size) (< next-ring-time (time)))
                (set! next-ring-time (+ (time) speed))
                (with-state
                    (parent root)
                    (hint-none)
                    (hint-wire)
                    (backfacecull 0)
                    (let* ((s (- size age))
                            (sr (* radius (/ s size))) 
                            (er (* radius (/ (- s 1) size))))
                        (translate (vector 0 0 age))
                        (when (zero? (random 10))
                            (with-state
                                (identity)
                                (set! child-twigs (cons 
                                        (make-object twig% (/ size 2) sr speed) child-twigs))
                                (send (car child-twigs) build (vector 0 0 age) #f)))
                        
                        (build-ring 5 sr er)))
                (set! age (+ age 1)))
            (for-each 
                (lambda (child)
                    (send child update))
                child-twigs))
        
        
        
        
        (super-new)))

(define seed%
    (class object%
        (field 
            (twigs '())
            (debounce #t)
            (debounce-time 0))
        
        (define/public (add-twig dir)
            (let ((t (make-object twig% 20 1 0.1)))
                (set! twigs (cons (with-state
                            (colour (vector 0.3 0.8 0.4))
                            (send t build (vector 0 0 0) dir) t) twigs))))
        
        
        (define/public (update)
            
            (when (and debounce (key-pressed " "))
                (add-twig (vtransform-rot (vector 0 0 1) (minverse (get-camera-transform))))         
                (set! debounce #f)
                (set! debounce-time (+ (time) 1)))
            
            (when (> (time) debounce-time)
                (set! debounce #t)) 
            
            (for-each 
                (lambda (twig)
                    (send twig update))
                twigs))
        
        (super-new)))


(clear)
(show-axis 1)
(clear-colour (vector 0.2 0.5 0.3))
  
(fog (vector 0.2 0.5 0.3) 0.1 1 100) 
(define s (make-object seed%))

(every-frame (send s update))