#lang scheme

(require fluxus-015/fluxus)
(provide (all-defined-out))

(define-struct plant (rules branches leaves))

(define (build-plant pos terrain rule)
    ; sit on terrain
    (with-primitive terrain
        (let ((int (line-intersect (vector (vx pos) 1000 (vz pos))
                        (vector (vx pos) 0 (vz pos))))) 
            (when (not (null? int)) ; otherwise fallen off world            
                (let* ((pos (cdr (assoc "p" (car int))))
                        (str rule)) 
                    (with-state
                        (translate pos)
                        (rotate (vector 0 0 90))
                        (let ((objects (build-from-string str 20 0.75 (vector 1 0.4 0.2) (vector 0 1 0))))
                            (make-plant rule (car objects) (cadr objects)))))))))

(define (destroy-plant plant)
    (for-each
        (lambda (branch)
            (destroy branch))
        (plant-branches plant))
    (for-each
        (lambda (leaf)
            (destroy leaf))
        (plant-leaves plant)))

(define (leaf-intersection leaf pos plant light-pos)
    (foldl 
        (lambda (other-leaf intersects)
            (cond
                (intersects #t) ; already found an intersection
                ((eq? leaf other-leaf) intersects) ; same leaf
                ((< (vy pos) 0) #t) ; underground
                ((< (vdist pos (with-primitive other-leaf (vtransform (vector 0 0 0) (get-transform)))) 1.5) #t) ; distance
                (else
                    (with-primitive other-leaf ; check for intersection
                        (let ((world->object (minverse (get-transform))))
                            (not (null? (line-intersect (vtransform pos world->object)
                                        (vtransform light-pos world->object)))))))))
        #f
        (plant-leaves plant)))


(define (plant-trace-leaves plant light-pos)
    (foldl
        (lambda (leaf light)
            (let ((pos (with-primitive leaf (vtransform (vector 0 0 0) (get-transform))))
                    
                    #;(line (with-state 
                            (hint-none)(hint-unlit)(hint-wire)
                            (build-ribbon 2))))
                
                #;(with-primitive line
                    (pdata-set! "p" 0 pos)
                    (pdata-set! "p" 1 light-pos))
                
                
                (with-primitive 
                    leaf
                    ;        (hint-unlit)
                    (cond ((leaf-intersection leaf pos plant light-pos)
                            (colour (vector 1 0 0))                  
                            0) ; no score for a leaf blocked by another leaf
                        (else
                            (let* ((l (vsub light-pos pos))
                                    (ln (vnormalise l))
                                    (n1 (vnormalise (vtransform-rot (pdata-ref "n" 0) (get-transform))))
                                    (n2 (vnormalise (vtransform-rot (pdata-ref "n" 4) (get-transform))))
                                    (score1 (vdot ln n1))
                                    (score2 (vdot ln n2))
                                    (score (- (+ (if (< score1 0) 0 score1)
                                                (if (< score2 0) 0 score2)) 0.1)))
                                ;                (printf "~a~n" score)
                                (colour (vmix (vector 0 1 0) (vector 1 0 0) (+ score 0.5)))
                                (+ light (/ score (* 0.1 (min 100 (vmag l)))))))))))
        0
        (plant-leaves plant)))

; builds objects from a string
(define (build-from-string string angle branch-scale branch-col leaf-col)
    (let ((d 0) 
            (leaves '()) 
            (branches '()))
        (for-each 
            (lambda (char)
                (let ((angle (+ angle (* 0 (grndf)))))
                    (cond 
                        ((char=? #\F char) 
                            (with-state
                                (hint-cast-shadow)
                                (translate (vector 1 0 0))
                                (scale (vector 1 1 1))
                                (rotate (vector 0 90 0))         
                                (colour branch-col)
                                (set! branches (cons (load-primitive "meshes/branch.obj") branches)))
                            (translate (vector 1 0 0)))
                        ((char=? #\L char)
                            (with-state
                                (hint-depth-sort)
                                (hint-cast-shadow)
                                ; (hint-normal)
                                (translate (vector 0.8 0 0))
                                ;(scale (vector 0.5 0.25 0.25))
                                (rotate (vector 90 0 0))         
                                (colour leaf-col)
                                (texture (load-texture "textures/leaf-solid.png"))
                                (let ((l (load-primitive "meshes/leaf.obj")))
                                    ;(with-primitive l (apply-transform))
                                    (set! leaves (cons l leaves)))))
                        ((char=? #\f char) (translate (vector 1 0 0)))
                        ((char=? #\/ char) (rotate (vector angle 0 0)))
                        ((char=? #\\ char) (rotate (vector (- angle) 0 0)))
                        ((char=? #\+ char) (rotate (vector 0 angle 0)))
                        ((char=? #\- char) (rotate (vector 0 (- angle) 0)))
                        ((char=? #\^ char) (rotate (vector 0 0 angle)))
                        ((char=? #\& char) (rotate (vector 0 0 (- angle))))
                        ((char=? #\| char) (rotate (vector 0 0 180)))
                        ((char=? #\[ char) (set! d (+ d 1)) (push) #;(scale (vector branch-scale branch-scale branch-scale)))
                            ((char=? #\] char) (when (> d 0) (set! d (- d 1)) (pop))))))
            (string->list string))
        (for ((i (in-range 0 d))) (pop))
        (list branches leaves)))