151 lines
4.5 KiB
Scheme
151 lines
4.5 KiB
Scheme
|
(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))))
|