(require scheme/class)

(define input%
    (class object%
        
        (field
            (last-mouse (vector 0 0 0))
            (last-button #f)
            (last-keys '())
            (new-keys '())
            (keys-pressed '())
            (selected 0)
            (zoom -20))
        
        (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 (bricks-in-list 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 cell (root wall (pos #:mutable) radius thresh))

(define selected 0)

(define (build-cell pos radius threshold)
    (with-state
        (push)
        (hint-unlit)
        (translate pos)
        (scale radius)
        (colour (vector 0.5 (+ 0.5 (* 0.5 (rndf))) 0.5))
        (let ((root (build-sphere 7 7)))
            (pop)
            (parent root)
            (scale threshold)
            (opacity 0.3)
            (colour (vector 0.5 (+ 0.5 (* 0.5 (rndf))) 0.5))
            
            (let ((wall (build-sphere 7 7)))
            (make-cell root wall pos radius threshold)))))

(define (cell-update cell input organism)
    (with-primitive (cell-root cell)
        (when (eq? (send input get-selected) (cell-wall cell))
            (translate (send input get-mouse-change)))

        (let ((dir (foldl
                (lambda (other cur)
                    (if (not (eq? cell other))
                        (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.005)))
                                (else
                                    cur)))
                        cur))
                (vector 0 0 0)
                organism)))
        (translate (vector (vx dir) (vy dir) 0)))
        
        (set-cell-pos! cell (vtransform (vector 0 0 0) (get-transform)))))


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

(define (build-organism count)
    (build-list count (lambda (_) (build-cell (vmul (vector (crndf) (crndf) 0) 15) 1 2))))

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

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


(clear)
(clear-colour (vector 0.2 0.3 0))
(define organism (build-organism 100))

(define input (make-object input%))

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

(every-frame (update))