(require scheme/class)

(define photon-thresh 0.1)

(define (contains? a l)
    (cond 
        ((null? l) #f)
        ((eq? (car l) a) #t)
        (else (contains? a (cdr l)))))

(define (remove a l)
    (cond
        ((null? l) l)
        ((eq? (car l) a) (remove a (cdr l)))
        (else (cons (car l) (remove a (cdr l))))))

(define input%
    (class object%
        
        (field
            (last-mouse (vector 0 0 0))
            (last-button #f)
            (last-keys '())
            (new-keys '())
            (keys-pressed '())
            (selected 0)
            (zoom -50))
        
        (define/public (pre-update)
            (when (and (not last-button) (mouse-button 1))
                (set! selected (select (mouse-x) (mouse-y) 2))))
        
        (define/public (update)
            (set! last-button (mouse-button 1))
            (set! new-keys (append (keys-down) '() #;(get-special-keys-pressed)))
            (set! keys-pressed (filter
                    (lambda (key)
                        (not (contains? key last-keys)))
                    new-keys))
            (set! last-keys new-keys)
            (when (key-pressed "-") (set! zoom (* zoom 1.1)))
            (when (key-pressed "=") (set! zoom (* zoom 0.9)))
            (set-camera-transform (mtranslate (vector 0 0 zoom))))
        
        (define/public (get-keys-pressed)
            keys-pressed)
        
        (define/public (get-selected)
            selected)
        
        (define/public (mouse-b n)
            (mouse-button n))
        
        (define/public (get-pos-from-mouse)
            (let* ((ndcpos (vector (* (- (/ (mouse-x) (vx (get-screen-size))) 0.5) (* -2 zoom))
                            (* (- (- (/ (mouse-y) (vy (get-screen-size))) 0.5)) (* -1.5 zoom)) -10))
                    (scrpos (vtransform ndcpos (minverse (get-camera-transform)))))
                scrpos))        
        
        (define/public (get-mouse-change)
            (let ((r (if last-button (vsub (get-pos-from-mouse) last-mouse)
                            (vector 0 0 0))))
                (set! last-mouse (get-pos-from-mouse))
                r))
        
        (super-new)))

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

(define-struct photons (root))

(define (build-photons photon-count)
    (with-state
        (hint-depth-sort)
        (texture (load-texture "textures/star.png"))
        (let ((p (build-particles photon-count)))
            (with-primitive p
                (pdata-map!
                    (lambda (s)
                        (vector 2 2 0))
                    "s")
                (pdata-map!
                    (lambda (c)
                        (vector 1 1 1))
                    "c")
                (pdata-map!
                    (lambda (p)
                        (vector 1 1000 1))
                    "p"))
            (make-photons p))))

(define (photons-update light)
    (with-primitive (photons-root light)
        (for ((i (in-range 0 30)))
            (let ((p (vector (* (crndf) 30) (* (rndf) 30) 0)))
                (if (> (snoise (* 0.03 (vx p)) (* 0.03 (vy p)) (* 0.1 (time))) photon-thresh)
                    (pdata-set! "p" (random (pdata-size)) p)
                    (pdata-set! "p" (random (pdata-size)) (vector 0 1000 0)))))))

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

(define-struct resources ((water #:mutable)))

(define (build-resources)
    (make-resources (build-list 5 (lambda (_)
         (with-state
            (translate (vmul (vector (crndf) (- (rndf)) 0) 30))
            (translate (vector 0 -10 10))
            (opacity 0.5)
            (scale (vector 10 10 1))
            (colour (vector 0.5 0.5 1))
            (build-sphere 10 10))))))

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

(define-struct cell (root 
        wall 
        (pos #:mutable) 
        radius 
        thresh
        (dragging #:mutable)
        (connected #:mutable)
        (energy #:mutable)
        type))

(define (build-cell pos radius threshold type)
    (with-state
        (push)
        (hint-unlit)
        (translate pos)
        (scale radius)
        (let ((root (build-sphere 7 7)))
            (pop)
            (parent root)
            (scale threshold)
            (opacity 0.3)
            (if (eq? type 'photo)
                (colour (vector 0 1 0))
                (colour (vector 1 0.5 0)))
            (let ((wall (build-sphere 7 7)))
                (make-cell root wall pos radius threshold #f '() 0 type)))))

(define (cell-connect! cell other)
    (set-cell-connected! cell (cons other (cell-connected cell)))
    (set-cell-connected! other (cons cell (cell-connected other))))

(define (cell-disconnect cell other)
    (set-cell-connected! cell (remove other (cell-connected cell)))
    (set-cell-connected! other (remove cell (cell-connected other))))

(define (choose l)
    (list-ref l (random (length l))))

(define (cell-divide cell organism)
    (let ((new-cell (build-cell 
                    (vadd (cell-pos cell) (vmul (srndvec) 3))
                    (cell-radius cell) (cell-thresh cell) 
            (choose '(photo struct struct struct absorb)))))
        (cell-connect! cell new-cell)
        (set-organism-cells! organism (cons new-cell
                (organism-cells organism)))))

(define (cell-update cell input organism photons)
    
    (with-primitive (cell-wall cell)
        (if (null? (cell-connected cell))
            (hide 1)
            (hide 0)))
    
    (with-primitive (cell-root cell)
        (cond ((eq? (cell-type cell) 'photo)
                (colour (vmul (vector 0.5 1 0.5) (+ 0.5 (cell-energy cell)))))
            ((eq? (cell-type cell) 'struct)
                (colour (vmul (vector 1 0.7 0.3) (+ 0.5 (cell-energy cell)))))
            ((eq? (cell-type cell) 'absorb)
                (when (> (cell-energy cell) 1)
                    (set-cell-energy! cell 0)
                    (cell-divide cell organism))
                (colour (vmul (vector 0.5 0.5 1) (+ 0.5 (cell-energy cell))))))
        
        
        (when (or (eq? (send input get-selected) (cell-wall cell))
                (eq? (send input get-selected) (cell-root cell)))
            (translate (send input get-mouse-change))
            (for-each            
                (lambda (other)
                    (when (and (not (eq? cell other))
                            (not (contains? other (cell-connected cell))))
                        
                        (let ((dist (vdist (cell-pos cell) (cell-pos other))))
                            (when (< dist (+ (cell-thresh cell) (cell-thresh other)))
                                (cell-connect! other cell)))))
                (organism-cells organism)))                
        
        
        (let ((dir (foldl
                        (lambda (other cur)
                            (let ((dist (vdist (cell-pos cell) (cell-pos other))))
                                (cond 
                                    ; inside nucleus
                                    ((< dist (+ (cell-radius cell) (cell-radius other)))
                                        (vadd cur (vmul (vsub (cell-pos cell) (cell-pos other)) (* 0.1 (/ 1 dist)))))
                                    ((< dist (+ (cell-thresh cell) (cell-thresh other)))
                                        (vadd cur (vmul (vsub (cell-pos cell) (cell-pos other)) -0.01)))
                                    (else
                                        (cell-disconnect cell other)
                                        cur))))
                        (vector 0 0 0)
                        (cell-connected cell))))
            (when (eq? (cell-type cell) 'photo)
                (translate (vector (vx dir) (vy dir) 0))))
        
        (when (and (eq? (cell-type cell) 'photo)
                (not (null? (cell-connected cell))))
            (with-primitive (photons-root photons)
                (set-cell-energy! cell 
                    (+ (pdata-fold 
                            (lambda (p v)
                                (if (< (vdist (cell-pos cell) p) (cell-radius cell))
                                    (+ 0.2 v)
                                    v))
                            0 "p") (cell-energy cell)))))
        
        (when (zero? (random 10))
            (for-each
                (lambda (other)
                    (when (> (cell-energy other) 0.1)
                        (set-cell-energy! cell (+ (cell-energy cell) (* (cell-energy other) 0.49)))
                        (set-cell-energy! other (* (cell-energy other) 0.49))))
                (cell-connected cell)))
        
        (set-cell-pos! cell (vtransform (vector 0 0 0) (get-transform)))))


;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

(define-struct organism ((cells #:mutable)))

(define (build-organism count)
    (make-organism 
        (build-list count 
            (lambda (_)
                (build-cell (vmul (vector (crndf) (crndf) 0) 5) 1 2 
                    (choose '(struct struct struct photo absorb)))))))

(define (organism-update organism input photons)
    (for-each
        (lambda (cell)
            (cell-update cell input organism photons))
        (organism-cells organism)))

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


(clear)
(clear-colour (vector 0.2 0.1 0.1))
(define organism (build-organism 10))
(define photons (build-photons 40))
(define input (make-object input%))
(define resources (build-resources))

(define sky (with-state
    (colour (vector 0.3 0.5 0.2))
    (translate (vector 0 30 -10))
    (scale (vector 150 60 0))
    (build-plane)))

(define (update)
    (send input pre-update)
    (organism-update organism input photons)
    (photons-update photons)
    (send input update))

(every-frame (update))