groworld/plant-eyes/test-scripts/insect-test.scm

97 lines
2.9 KiB
Scheme
Raw Permalink Normal View History

2009-09-28 08:57:29 +00:00
(require scheme/class)
(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 1))
(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)
(set! time (+ time d)))
(super-new)))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(define (add-blendshape key model)
(let ((b (load-primitive model))
(pname (string-append "p" (number->string key))))
(pdata-add pname "v")
(pdata-index-map!
(lambda (i p)
(with-primitive b (pdata-ref "p" i)))
pname)
(destroy b)))
(define (set-blendshape key)
(pdata-copy (string-append "p" (number->string key)) "p"))
(define spider-insect-view%
(class insect-view%
(inherit-field from to from-dir to-dir time tick)
(field
(root (let ((p (with-state
(hint-unlit)
(colour (vector 0 0 0))
(load-primitive "meshes/spider-1.obj"))))
(with-primitive p
(pdata-copy "p" "p0")
(add-blendshape 1 "meshes/spider-2.obj")
(add-blendshape 2 "meshes/spider-3.obj") p)))
(anim-t 0)
(anim-d (* 0.2 (rndf)))
(blendshape 0))
(define/override (update t d)
(with-primitive root
(when (> anim-t anim-d)
(set! anim-t 0)
(set! blendshape (modulo (+ blendshape 1) 3))
(set-blendshape blendshape))
(identity)
(let ((h (hermite-tangent from to (vmul from-dir 2) (vmul to-dir 2) (/ time tick))
#;(vlerp-tangent from to (/ time tick))))
(translate (car h))
(concat (maim (vector 0 0 1) (vnormalise (cadr h))))
(scale 1)))
(set! time (+ time d))
(set! anim-t (+ anim-t d)))
(super-new)))
(clear)
(clear-colour 0.5)
(define s (make-object spider-insect-view% 0 (vector 0 0 0) 'spider))
(define t 0)
(every-frame
(begin
(when (> (time) t)
(set! t (+ (time) 1))
(send s move (vmul (srndvec) 10) 1))
(send s update (time) (delta))))