(require scheme/class)

(define (worm-colour) (vector 1 1 1))

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; slow implementation of hermite curves for animation
(define (hermite s p1 p2 t1 t2)
    ; the bernstein polynomials
    (define (h1 s)
        (+ (- (* 2 (expt s 3))
                (* 3 (expt s 2))) 1))
    
    (define (h2 s)
        (+ (* -2 (expt s 3))
            (* 3 (expt s 2))))
    
    (define (h3 s)
        (+ (- (expt s 3) (* 2 (expt s 2))) s))
    
    (define (h4 s)
        (- (expt s 3) (expt s 2)))
    
    (vadd
        (vadd 
            (vmul p1 (h1 s))
            (vmul p2 (h2 s)))
        (vadd
            (vmul t1 (h3 s))
            (vmul t2 (h4 s)))))

; slow, stupid version for getting the tangent - not in the mood for
; maths today to see how you derive it directly, must be pretty simple
(define (hermite-tangent t p1 p2 t1 t2)
    (let ((p (hermite t p1 p2 t1 t2)))
        (list p (vsub (hermite (- t 0.01) p1 p2 t1 t2) p))))



(define insect-view%
    (class object%
        (init-field
            (id 0)
            (from (vector 0 0 0))
            (type 'none))
    
        (field
            (to (vector 0 0 0))
            (from-dir (vector 1 0 0))
            (to-dir (vector 1 0 0))
            (time 0)
            (tick 0))
                
        (define/public (move pos dur)
            (set! from to)
            (set! from-dir to-dir)
            (set! to pos)
            (set! to-dir (vnormalise (vsub from to)))
            (set! time 0)
            (set! tick dur))
        
        (define/public (update t d)
          #;(when (< time tick)
            (with-primitive root
                        (identity)
                        
                        (let ((h (hermite-tangent (/ time tick) from to (vmul from-dir 2) (vmul to-dir 2))
                                    #;(lerp-tangent (/ time tick) from to)))
                            
                            (translate (car h))
                            (concat (maim (vector 0 0 1) (vnormalise (cadr h))))
                        
                        (scale 0.2))))
            (set! time (+ time d)))
        
        (super-new)))

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

(define worm-insect-view%
    (class insect-view%
        (inherit-field from to from-dir to-dir time tick)      
        
        (field 
            (hidden #t)
            (from2 (vector 0 0 0))
            (from-dir2 (vector 0 0 0))
               (root (let ((p (build-ribbon 20)))
              (with-primitive p
                (translate (vector 0 0 -0.1))
                (hint-depth-sort)
                (hint-unlit)
                (colour (worm-colour))
                (texture (load-texture "textures/worm.png"))
                (let ((width (+ 2 (* 2 (rndf)))))
                    (pdata-index-map!
                        (lambda (i w)
                            width)
                        "w"))
                #;(pdata-map!
                    (lambda (c)
                        (vector 1 1 1))
                    "c"))
                p)))

        (define/override (move pos dur)
            (set! from2 from)
            (set! from to)
            (set! from-dir2 from-dir)
            (set! from-dir to-dir)
            (set! to pos)
            (set! to-dir (vmul (vsub to from) 5))
            (set! time 0)
            (set! tick dur))      

        (define/public (get-pos)
            to)

        (define/public (get-dir)
            to-dir)
         
        (define/override (update t d)
                    (let ((nt (/ time tick))) ; normalise time
                        (with-primitive root
                            (pdata-index-map!
                                (lambda (i p)
                                    (let ((st (- nt (* i 0.05))))
                                        (if (< st 0) 
                                            (hermite (+ st 1) from2 from (vmul from-dir2 2) (vmul from-dir 2))
                                            (hermite st from to (vmul from-dir 2) (vmul to-dir 2)))))
                            "p")))
        
        (set! time (+ time d)))
    
    (super-new)))

(clear)
(clear-colour 0.5)
(define w (make-object worm-insect-view% 0 (srndvec)))

(send w move (srndvec) 1)

(define next 0)

(every-frame
    (begin
        (when (> (time) next) 
            (printf "~a~n" (send w get-dir))
            (send w move (vmul (srndvec) 10) 5)
            (set! next (+ (time) 5)))
        (send w update (time) (delta))))