FoAM/groworld
12
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

loadsa particles

Browse source
This commit is contained in:
Dave Griffiths 2009-06-23 08:31:12 +01:00
parent 057656012d
commit c465ec71ae
3 changed files with 232 additions and 133 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

365
plant-eyes/plant-eyes.scm
View file

@ -1,7 +1,7 @@
(require scheme/class) (require scheme/class)
(clear) (clear)
(define (build-ring n sr er) (define (build-ring n sr er)
(let ((p (build-polygons (+ (* n 2) 2) 'triangle-strip))) (let ((p (build-polygons (+ (* n 2) 2) 'triangle-strip)))
(with-primitive p (with-primitive p
@ -11,7 +11,7 @@
(s (* (if (odd? i) sr er) 5))) (s (* (if (odd? i) sr er) 5)))
(vector (* (cos a) s) (* (sin a) s) (if (odd? i) 0 5 )))) (vector (* (cos a) s) (* (sin a) s) (if (odd? i) 0 5 ))))
"p") "p")
(recalc-normals 1)) (recalc-normals 1))
p)) p))
@ -34,64 +34,132 @@
(with-primitive root (with-primitive root
(translate pos) (translate pos)
(cond (dir (cond (dir
(concat (maim dir (vector 0 0 1))) (concat (maim dir (vector 0 0 1)))
(rotate (vector 0 -90 0))) (rotate (vector 0 -90 0)))
(else (rotate (vmul (crndvec) 20)))))) (else (rotate (vmul (crndvec) 20))))))
(define/public (update) (define/public (update t)
(for-each (for-each
(lambda (child) (lambda (child)
(send child update)) (send child update t))
child-twigs) child-twigs)
(when (and (< age size) (< next-ring-time (time))) (when (and (< age size) (< next-ring-time t))
(set! next-ring-time (+ (time) speed)) (set! next-ring-time (+ t speed))
(let ((p (with-state (let ((p (with-state
(parent root) (parent root)
(hint-depth-sort) (hint-depth-sort)
(colour (vector 0.8 1 0.6)) (colour (vector 0.8 1 0.6))
(texture (load-texture "textures/skin.png")) (texture (load-texture "textures/skin.png"))
;(hint-none) ;(hint-none)
;(hint-wire) ;(hint-wire)
(backfacecull 1) (backfacecull 1)
(let* ((s (- size age)) (let* ((s (- size age))
(sr (* radius (/ s size))) (sr (* radius (/ s size)))
(er (* radius (/ (- s 1) size)))) (er (* radius (/ (- s 1) size))))
(translate (vector 0 0 (* age 5))) (translate (vector 0 0 (* age 5)))
(when (zero? (random 3)) (when (zero? (random 3))
(with-state (with-state
(identity) (identity)
(set! child-twigs (cons (set! child-twigs (cons
(make-object twig% (/ size 2) sr speed) child-twigs)) (make-object twig% (/ size 2) sr speed) child-twigs))
(send (car child-twigs) build (vector 0 0 (* age 5) ) #f))) (send (car child-twigs) build (vector 0 0 (* age 5) ) #f)))
(build-ring 5 sr er))))) (build-ring 5 sr er)))))
(with-primitive camera (parent p))) (with-primitive camera (parent p)))
(set! age (+ age 1)))) (set! age (+ age 1))))
(super-new))) (super-new)))
(define pickup%
(class object%
(init-field
(pos (vector 0 0 0)))
(field
(col (vmul (rndvec) 0.1))
(root (let ((p (with-state
(translate pos)
(hint-depth-sort)
(blend-mode 'src-alpha 'one)
(texture (load-texture "textures/particle.png"))
(build-particles 20))))
(with-primitive p
(pdata-add "vel" "v")
(pdata-map!
(lambda (vel)
(vmul (vector (crndf) (* 2 (rndf)) (crndf)) 0.02))
"vel")
(pdata-map!
(lambda (s)
(vector 2 2 2))
"s")
(pdata-map!
(lambda (c)
col)
"c"))
p)))
(define/public (get-pos)
pos)
(define/public (update t)
(with-primitive root
(pdata-op "+" "p" "vel")
(pdata-op "*" "c" 0.996)
(pdata-op "*" "s" 1.005)
(when (zero? (random 5))
(let ((reset (random (pdata-size))))
(pdata-set! "c" reset col)
(pdata-set! "p" reset (vector 0 0 0))
(pdata-set! "s" reset (vector 2 2 2))))))
(super-new)))
(define seed% (define seed%
(class object% (class object%
(field (field
(twigs '()) (twigs '())
(pickups (build-list 10 (lambda (_)
(make-object pickup% (vmul (vsub (crndvec) (vector 0 1 0)) 50)))))
(indicator (let ((p (with-state
(hint-depth-sort)
;(blend-mode 'src-alpha 'one )
(texture (load-texture "textures/particle.png"))
(build-particles 200))))
(with-primitive p
(pdata-add "vel" "v")
(pdata-map!
(lambda (vel)
(srndvec))
"vel")
(pdata-map!
(lambda (c)
(vector 0 0 0.1))
"c")
(pdata-map!
(lambda (s)
(let ((sz (rndf)))
(vector sz sz sz)))
"s"))
p))
(debounce #t) (debounce #t)
(debounce-time 0) (debounce-time 0)
(pos (vector 0 0 0))
(root (with-state (root (with-state
(scale 5) (scale 5)
(translate (vector 0 0 0)) (translate pos)
(texture (load-texture "textures/skin.png")) (texture (load-texture "textures/skin.png"))
(backfacecull 0) (backfacecull 0)
(opacity 0.6) (opacity 0.6)
(colour (vector 0.8 1 0.6)) (colour (vector 0.8 1 0.6))
(hint-depth-sort) (hint-depth-sort)
(hint-unlit) (hint-unlit)
(load-primitive "meshes/seed.obj")))) (load-primitive "meshes/seed.obj"))))
(define/public (add-twig dir) (define/public (add-twig dir)
(let ((t (make-object twig% 10 0.2 2))) (let ((t (make-object twig% 10 0.2 2)))
@ -100,22 +168,46 @@
(send t build (vector 0 0 0) dir) t) twigs)))) (send t build (vector 0 0 0) dir) t) twigs))))
(define/public (update) (define/public (update t)
(let ((closest (foldl
(lambda (pickup r)
(if (< (vdist (send pickup get-pos) pos)
(vdist pos r))
(send pickup get-pos) r))
(vector 999 999 999)
pickups)))
(with-primitive indicator
(pdata-op "+" "p" "vel")
(when (< (sin (* 2 t)) 0)
(let ((reset (random (pdata-size))))
(let ((pos (vmul (vnormalise (vsub closest pos)) 10)))
(pdata-set! "vel" reset (vadd (vmul (srndvec) 0.01)
(vmul (vsub closest pos) (* (rndf) 0.01))))
(pdata-set! "p" reset pos))))))
(with-primitive root
(scale (+ 1 (* 0.001 (sin (* 2 t))))))
(when (key-pressed "r") (with-primitive camera (parent 1))) (when (key-pressed "r") (with-primitive camera (parent 1)))
(when (and debounce (key-pressed " ")) (when (and debounce (key-pressed " "))
(add-twig (vtransform-rot (vector 0 0 1) (minverse (get-camera-transform)))) (add-twig (vtransform-rot (vector 0 0 1) (minverse (get-camera-transform))))
(set! debounce #f) (set! debounce #f)
(set! debounce-time (+ (time) 1))) (set! debounce-time (+ t 1)))
(when (> (time) debounce-time) (when (> t debounce-time)
(set! debounce #t)) (set! debounce #t))
(for-each (for-each
(lambda (twig) (lambda (twig)
(send twig update)) (send twig update t))
twigs)) twigs)
(for-each
(lambda (pickup)
(send pickup update t))
pickups))
(super-new))) (super-new)))
@ -124,90 +216,90 @@
(with-state (with-state
(scale 5 ) (scale 5 )
(translate (vector 0 0 0)) (translate (vector 0 0 0))
(with-state (with-state
(texture (load-texture "textures/top.png")) (texture (load-texture "textures/top.png"))
(translate (vector 0 20 0)) (translate (vector 0 20 0))
(rotate (vector 90 0 0)) (rotate (vector 90 0 0))
(scale 40) (scale 40)
(hint-unlit) (hint-unlit)
(build-plane)) (build-plane))
(with-state (with-state
(texture (load-texture "textures/left.png")) (texture (load-texture "textures/left.png"))
(translate (vector 0 0 -20)) (translate (vector 0 0 -20))
(rotate (vector 0 0 0)) (rotate (vector 0 0 0))
(scale 40) (scale 40)
(hint-unlit) (hint-unlit)
(build-plane)) (build-plane))
(with-state (with-state
(texture (load-texture "textures/back.png")) (texture (load-texture "textures/back.png"))
(translate (vector 20 0 0)) (translate (vector 20 0 0))
(rotate (vector 0 90 0)) (rotate (vector 0 90 0))
(scale 40) (scale 40)
(hint-unlit) (hint-unlit)
(build-plane)) (build-plane))
(with-state (with-state
(texture (load-texture "textures/right.png")) (texture (load-texture "textures/right.png"))
(translate (vector 0 0 20)) (translate (vector 0 0 20))
(rotate (vector 0 0 0)) (rotate (vector 0 0 0))
(scale 40) (scale 40)
(hint-unlit) (hint-unlit)
(build-plane)) (build-plane))
(with-state (with-state
(texture (load-texture "textures/front.png")) (texture (load-texture "textures/front.png"))
(translate (vector -20 0 0)) (translate (vector -20 0 0))
(rotate (vector 0 90 0)) (rotate (vector 0 90 0))
(scale 40) (scale 40)
(hint-unlit) (hint-unlit)
(build-plane)) (build-plane))
(with-state (with-state
(texture (load-texture "textures/bottom.png")) (texture (load-texture "textures/bottom.png"))
(opacity 0.8) (opacity 0.8)
(hint-depth-sort) (hint-depth-sort)
(translate (vector 0 2 0)) (translate (vector 0 2 0))
(rotate (vector 90 0 0)) (rotate (vector 90 0 0))
(scale 40) (scale 40)
(hint-unlit) (hint-unlit)
(build-plane)) (build-plane))
; soil ; soil
(with-state (with-state
(texture (load-texture "textures/sback.png")) (texture (load-texture "textures/sback.png"))
(translate (vector 0 -15 -19.99)) (translate (vector 0 -15 -19.99))
(rotate (vector 0 0 0)) (rotate (vector 0 0 0))
(scale 40) (scale 40)
(hint-unlit) (hint-unlit)
(build-plane)) (build-plane))
(with-state (with-state
(texture (load-texture "textures/sleft.png")) (texture (load-texture "textures/sleft.png"))
(translate (vector 19.9 -15 0)) (translate (vector 19.9 -15 0))
(rotate (vector 0 90 0)) (rotate (vector 0 90 0))
(scale 40) (scale 40)
(hint-unlit) (hint-unlit)
(build-plane)) (build-plane))
(with-state (with-state
(texture (load-texture "textures/sfront.png")) (texture (load-texture "textures/sfront.png"))
(translate (vector 0 -15 19.9)) (translate (vector 0 -15 19.9))
(rotate (vector 0 0 0)) (rotate (vector 0 0 0))
(scale 40) (scale 40)
(hint-unlit) (hint-unlit)
(build-plane)) (build-plane))
(with-state (with-state
(texture (load-texture "textures/sright.png")) (texture (load-texture "textures/sright.png"))
(translate (vector -19.9 -15 0)) (translate (vector -19.9 -15 0))
(rotate (vector 0 90 0)) (rotate (vector 0 90 0))
(scale 40) (scale 40)
(hint-unlit) (hint-unlit)
(build-plane))) (build-plane)))
(lock-camera camera) (lock-camera camera)
(camera-lag 0.05) (camera-lag 0.05)
@ -216,10 +308,17 @@
(light-diffuse 0 (vector 0 0 0)) (light-diffuse 0 (vector 0 0 0))
(light-diffuse l (vector 1 1 1)) (light-diffuse l (vector 1 1 1))
(light-position l (vector 10 50 -4)) (light-position l (vector 10 50 -4))
(clear-colour (vector 0.1 0.3 0.2)) (clear-colour (vector 0.1 0.3 0.2))
(fog (vector 0.2 0.5 0.3) 0.01 1 100) (fog (vector 0.2 0.5 0.3) 0.01 1 100)
(define s (make-object seed%)) (define s (make-object seed%))
(every-frame (send s update)) (define t 0)
(define (animate)
(send s update t)
(set! t (+ t 0.02)))
(every-frame (animate))

BIN
plant-eyes/textures/left.jpg
View file

Binary file not shown.
Side by side

Before

Width:  |  Height:  |  Size: 31 KiB

BIN
plant-eyes/textures/particle.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 36 KiB