366 lines
10 KiB
Scheme
366 lines
10 KiB
Scheme
|
#lang scheme/base
|
||
|
|
(require scheme/class fluxus-016/fluxus "sound.ss")
|
||
|
|
(provide (all-defined-out))
|
||
|
|
|
||
|
|
(define (clamp v l u)
|
||
|
|
(if (< v l) l
|
||
|
|
(if (> v u) u v)))
|
||
|
|
|
||
|
|
(define (property->ornament property pos width dir col)
|
||
|
|
(make-object (cond
|
||
|
|
((eq? property 'horn) horn-ornament-view%)
|
||
|
|
((eq? property 'inflatoe) inflatoe-ornament-view%)
|
||
|
|
((eq? property 'leaf) leaf-ornament-view%)
|
||
|
|
((eq? property 'flower) flower-ornament-view%)
|
||
|
|
((eq? property 'fork) fork-ornament-view%)
|
||
|
|
(else (error "can't find ornament for property " property)))
|
||
|
|
pos width dir col))
|
||
|
|
|
||
|
|
(define ornament-view%
|
||
|
|
(class object%
|
||
|
|
(init-field
|
||
|
|
(pos (vector 0 0 0))
|
||
|
|
(sc 1)
|
||
|
|
(dir (vector 0 0 1))
|
||
|
|
(col (vector 1 1 1))
|
||
|
|
(time 0)
|
||
|
|
(ev-time 0)
|
||
|
|
(ev-dur 8)
|
||
|
|
(ev-col (vector 0 0 1))
|
||
|
|
(light 0))
|
||
|
|
|
||
|
|
(field
|
||
|
|
(const-scale 4)
|
||
|
|
(rot (vector 0 0 0))
|
||
|
|
(excitation-changed #f)
|
||
|
|
(root (build-root))
|
||
|
|
(particles (if (want-particles?)
|
||
|
|
(let ((p (with-state
|
||
|
|
(parent root)
|
||
|
|
(translate (vector 0 0 1))
|
||
|
|
(hint-depth-sort)
|
||
|
|
(hint-unlit)
|
||
|
|
(blend-mode 'src-alpha 'one)
|
||
|
|
(texture (load-texture "textures/particle.png"))
|
||
|
|
(build-particles 30))))
|
||
|
|
(with-primitive p
|
||
|
|
(pdata-add "vel" "v")
|
||
|
|
(pdata-map!
|
||
|
|
(lambda (vel)
|
||
|
|
(vmul (srndvec) 0.01))
|
||
|
|
"vel")
|
||
|
|
(pdata-map!
|
||
|
|
(lambda (s)
|
||
|
|
(vmul (vector 1 1 1) (* 0.25 (rndf))))
|
||
|
|
"s")
|
||
|
|
(pdata-map!
|
||
|
|
(lambda (c)
|
||
|
|
(vadd ev-col (vmul (rndvec) (* 0.2 (rndf)))))
|
||
|
|
"c"))
|
||
|
|
p)
|
||
|
|
0)))
|
||
|
|
|
||
|
|
(define/public (destroy-ornament)
|
||
|
|
(destroy root))
|
||
|
|
|
||
|
|
(define/pubment (want-particles?)
|
||
|
|
(inner #f want-particles?))
|
||
|
|
|
||
|
|
(define/pubment (above-ground-only?)
|
||
|
|
(inner #f above-ground-only?))
|
||
|
|
|
||
|
|
(define/pubment (below-ground-only?)
|
||
|
|
(inner #f below-ground-only?))
|
||
|
|
|
||
|
|
(define/pubment (centred?)
|
||
|
|
(inner #f centred?))
|
||
|
|
|
||
|
|
(define/pubment (want-morph?)
|
||
|
|
(inner #f want-morph?))
|
||
|
|
|
||
|
|
(define/pubment (build-root)
|
||
|
|
(inner (build-root) build-root))
|
||
|
|
|
||
|
|
(define/public (set-excitations! a b)
|
||
|
|
(set! excitation-changed #t)
|
||
|
|
(set! light a)
|
||
|
|
(set! ev-dur (if (zero? a) 9999 (/ 1 a)))
|
||
|
|
(set! ev-col (vmix (vector 0 0 1) (vector 1 0 0) b))
|
||
|
|
(set! ev-time (* ev-dur 4 (rndf))))
|
||
|
|
|
||
|
|
(define/pubment (update t d)
|
||
|
|
#;(inner (build-root) update)
|
||
|
|
|
||
|
|
(when (< time 1)
|
||
|
|
(with-primitive root
|
||
|
|
(identity)
|
||
|
|
(translate pos)
|
||
|
|
(concat (maim dir (vector 0 1 0)))
|
||
|
|
(rotate rot)
|
||
|
|
(scale (* const-scale sc 0.2 time))
|
||
|
|
(when (not (centred?))
|
||
|
|
(translate (vector 0 0 0.8))))
|
||
|
|
(set! time (+ time (* 0.05 d))))
|
||
|
|
|
||
|
|
(when (and (want-morph?) excitation-changed)
|
||
|
|
(printf "morphing~n")
|
||
|
|
(with-primitive root
|
||
|
|
(pdata-map!
|
||
|
|
(lambda (p p1 p2)
|
||
|
|
(vmix p1 p2 (clamp light 0 1)))
|
||
|
|
"p" "p1" "p2")))
|
||
|
|
|
||
|
|
(when (want-particles?)
|
||
|
|
(with-primitive particles
|
||
|
|
(pdata-op "+" "p" "vel")
|
||
|
|
(pdata-op "*" "c" 0.995))
|
||
|
|
|
||
|
|
(when (< ev-time 0)
|
||
|
|
(play-sound "snd/wateringcan.wav" pos (+ 0.1 (rndf)) 0.3)
|
||
|
|
|
||
|
|
#;(with-primitive root
|
||
|
|
(identity)
|
||
|
|
(translate pos)
|
||
|
|
(concat (maim dir (vector 0 1 0)))
|
||
|
|
(rotate rot)
|
||
|
|
(scale (* const-scale sc 0.2 ev-time)))
|
||
|
|
|
||
|
|
; todo inherit and call event happen or somesuch
|
||
|
|
(when (want-particles?)
|
||
|
|
(with-primitive particles
|
||
|
|
(pdata-index-map!
|
||
|
|
(lambda (i p)
|
||
|
|
(cond ((zero? (random 2)) p)
|
||
|
|
(else
|
||
|
|
(pdata-set! "c" i (vector (+ 0.5 (* 0.5 (rndf))) (+ 0.5 (* 0.5 (rndf))) 1))
|
||
|
|
(vector 0 0 0))))
|
||
|
|
"p")))
|
||
|
|
(set! ev-time ev-dur))
|
||
|
|
(set! ev-time (- ev-time d)))
|
||
|
|
|
||
|
|
(set! excitation-changed #f))
|
||
|
|
|
||
|
|
(super-new)))
|
||
|
|
|
||
|
|
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
|
|
|
||
|
|
(define leaf-ornament-view%
|
||
|
|
(class ornament-view%
|
||
|
|
(inherit-field rot)
|
||
|
|
(define/augment (centred?) #t)
|
||
|
|
(define/augment (above-ground-only?) #t)
|
||
|
|
(define/augment (build-root)
|
||
|
|
(colour (vector 0.8 1 0.6))
|
||
|
|
(texture (load-texture "textures/leaf.png"))
|
||
|
|
(set! rot (vector 0 0 0))
|
||
|
|
(load-primitive "meshes/leaf.obj"))
|
||
|
|
(super-new)))
|
||
|
|
|
||
|
|
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
|
|
|
||
|
|
(define horn-ornament-view%
|
||
|
|
(class ornament-view%
|
||
|
|
(inherit-field rot col)
|
||
|
|
(define/augment (want-particles?) #t)
|
||
|
|
(define/augment (build-root)
|
||
|
|
(shader "shaders/toon.vert.glsl" "shaders/toon.frag.glsl")
|
||
|
|
(colour col)
|
||
|
|
(set! rot (vector (* (rndf) 360) 0 0))
|
||
|
|
(load-primitive "meshes/horn.obj"))
|
||
|
|
(super-new)))
|
||
|
|
|
||
|
|
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
|
|
|
||
|
|
(define inflatoe-ornament-view%
|
||
|
|
(class ornament-view%
|
||
|
|
(inherit-field rot col)
|
||
|
|
(define/augment (want-morph?) #t)
|
||
|
|
(define/augment (build-root)
|
||
|
|
(shader "shaders/toon.vert.glsl" "shaders/textoon.frag.glsl")
|
||
|
|
(texture (load-texture "textures/wiggle.png"))
|
||
|
|
(colour col)
|
||
|
|
(set! rot (vector (* (rndf) 360) 0 0))
|
||
|
|
(let ((p (load-primitive "meshes/inflatoe-full.obj")))
|
||
|
|
(let ((dp (load-primitive "meshes/inflatoe-empty.obj")))
|
||
|
|
(with-primitive p
|
||
|
|
(pdata-copy "p" "p1")
|
||
|
|
(pdata-add "p2" "v")
|
||
|
|
(pdata-index-map!
|
||
|
|
(lambda (i p2)
|
||
|
|
(with-primitive dp
|
||
|
|
(pdata-ref "p" i)))
|
||
|
|
"p2"))
|
||
|
|
(destroy dp))
|
||
|
|
p))
|
||
|
|
(super-new)))
|
||
|
|
|
||
|
|
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
|
|
|
||
|
|
(define fork-ornament-view%
|
||
|
|
(class ornament-view%
|
||
|
|
(inherit-field rot col)
|
||
|
|
(define/augment (build-root)
|
||
|
|
(shader "shaders/toon.vert.glsl" "shaders/textoon.frag.glsl")
|
||
|
|
(colour col)
|
||
|
|
(set! rot (vector (* (rndf) 360) 0 0))
|
||
|
|
(load-primitive "meshes/fork.obj"))
|
||
|
|
(super-new)))
|
||
|
|
|
||
|
|
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
|
|
|
||
|
|
(define flower-ornament-view%
|
||
|
|
(class ornament-view%
|
||
|
|
(inherit-field rot col)
|
||
|
|
(define/augment (above-ground-only?) #t)
|
||
|
|
(define/augment (build-root)
|
||
|
|
(shader "shaders/toon.vert.glsl" "shaders/textoon.frag.glsl")
|
||
|
|
(colour col)
|
||
|
|
(set! rot (vector (* (rndf) 360) 0 0))
|
||
|
|
(load-primitive "meshes/flower.obj"))
|
||
|
|
(super-new)))
|
||
|
|
|
||
|
|
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||
|
|
|
||
|
|
|
||
|
|
#;(define leaf-ornament-view%
|
||
|
|
(class ornament-view%
|
||
|
|
(init-field
|
||
|
|
(pos (vector 0 0 0))
|
||
|
|
(sc 1)
|
||
|
|
(dir (vector 0 0 1))
|
||
|
|
(property 'none)
|
||
|
|
(col (vector 1 1 1))
|
||
|
|
(time 0)
|
||
|
|
(ev-time 0)
|
||
|
|
(ev-dur 8)
|
||
|
|
(ev-col (vector 0 0 1))
|
||
|
|
(light 0))
|
||
|
|
|
||
|
|
(field
|
||
|
|
(const-scale (if (eq? property 'leaf) 2 4))
|
||
|
|
(rot (vector 0 0 0))
|
||
|
|
(excitation-changed #f)
|
||
|
|
(root (with-state
|
||
|
|
(translate pos)
|
||
|
|
;(hint-frustum-cull)
|
||
|
|
(concat (maim dir (vector 0 1 0)))
|
||
|
|
(scale (* const-scale sc))
|
||
|
|
;(hint-origin)
|
||
|
|
;(shader "shaders/textoon.vert.glsl" "shaders/textoon.frag.glsl")
|
||
|
|
(cond
|
||
|
|
((eq? property 'wiggle)
|
||
|
|
; (opacity 1)
|
||
|
|
(hint-depth-sort)
|
||
|
|
(colour (vector 0.5 0.0 0.0))
|
||
|
|
(load-primitive "meshes/wiggle.obj"))
|
||
|
|
((eq? property 'leaf)
|
||
|
|
(colour (vector 0.8 1 0.6))
|
||
|
|
(texture (load-texture "textures/leaf.png"))
|
||
|
|
(set! rot (vector 0 0 0))
|
||
|
|
(load-primitive "meshes/leaf.obj"))
|
||
|
|
((eq? property 'horn)
|
||
|
|
(backfacecull 0)
|
||
|
|
(shader "shaders/toon.vert.glsl" "shaders/toon.frag.glsl")
|
||
|
|
(colour col)
|
||
|
|
(set! rot (vector (* (rndf) 360) 0 0))
|
||
|
|
(load-primitive "meshes/horn.obj"))
|
||
|
|
((eq? property 'inflatoe)
|
||
|
|
(backfacecull 0)
|
||
|
|
(shader "shaders/toon.vert.glsl" "shaders/textoon.frag.glsl")
|
||
|
|
(texture (load-texture "textures/wiggle.png"))
|
||
|
|
(colour col)
|
||
|
|
(set! rot (vector (* (rndf) 360) 0 0))
|
||
|
|
(let ((p (load-primitive "meshes/inflatoe-full.obj")))
|
||
|
|
(let ((dp (load-primitive "meshes/inflatoe-empty.obj")))
|
||
|
|
(with-primitive p
|
||
|
|
(pdata-copy "p" "p1")
|
||
|
|
(pdata-add "p2" "v")
|
||
|
|
(pdata-index-map!
|
||
|
|
(lambda (i p2)
|
||
|
|
(with-primitive dp
|
||
|
|
(pdata-ref "p" i)))
|
||
|
|
"p2"))
|
||
|
|
(destroy dp))
|
||
|
|
p))
|
||
|
|
(else (error "unrecognised pickup property")))))
|
||
|
|
(particles (if (eq? property 'horn)
|
||
|
|
(let ((p (with-state
|
||
|
|
(parent root)
|
||
|
|
(translate (vector 0 0 2))
|
||
|
|
(hint-depth-sort)
|
||
|
|
(hint-unlit)
|
||
|
|
(blend-mode 'src-alpha 'one)
|
||
|
|
(texture (load-texture "textures/particle.png"))
|
||
|
|
(build-particles 30))))
|
||
|
|
(with-primitive p
|
||
|
|
(pdata-add "vel" "v")
|
||
|
|
(pdata-map!
|
||
|
|
(lambda (vel)
|
||
|
|
(vmul (srndvec) 0.01))
|
||
|
|
"vel")
|
||
|
|
(pdata-map!
|
||
|
|
(lambda (s)
|
||
|
|
(vmul (vector 1 1 1) (* 0.25 (rndf))))
|
||
|
|
"s")
|
||
|
|
(pdata-map!
|
||
|
|
(lambda (c)
|
||
|
|
(vadd ev-col (vmul (rndvec) (* 0.2 (rndf)))))
|
||
|
|
"c"))
|
||
|
|
p)
|
||
|
|
0)))
|
||
|
|
|
||
|
|
(define/public (set-excitations! a b)
|
||
|
|
(set! excitation-changed #t)
|
||
|
|
(set! light a)
|
||
|
|
(set! ev-dur (if (zero? a) 9999 (/ 1 a)))
|
||
|
|
(set! ev-col (vmix (vector 0 0 1) (vector 1 0 0) b))
|
||
|
|
(set! ev-time (* ev-dur 4 (rndf))))
|
||
|
|
|
||
|
|
(define/public (update t d)
|
||
|
|
(when (< time 1)
|
||
|
|
(with-primitive root
|
||
|
|
(identity)
|
||
|
|
(translate pos)
|
||
|
|
(concat (maim dir (vector 0 1 0)))
|
||
|
|
(rotate rot)
|
||
|
|
(scale (* const-scale sc 0.2 time)))
|
||
|
|
(set! time (+ time (* 0.05 d))))
|
||
|
|
|
||
|
|
(when (and (eq? property 'inflatoe) excitation-changed)
|
||
|
|
(with-primitive root
|
||
|
|
(pdata-map!
|
||
|
|
(lambda (p p1 p2)
|
||
|
|
(vmix p1 p2 (clamp light 0 1)))
|
||
|
|
"p" "p1" "p2")))
|
||
|
|
|
||
|
|
(when (eq? property 'horn)
|
||
|
|
(with-primitive particles
|
||
|
|
(pdata-op "+" "p" "vel")
|
||
|
|
(pdata-op "*" "c" 0.995))
|
||
|
|
|
||
|
|
(when (< ev-time 0)
|
||
|
|
(play-sound "snd/wateringcan.wav" pos (+ 0.1 (rndf)) 0.3)
|
||
|
|
|
||
|
|
#;(with-primitive root
|
||
|
|
(identity)
|
||
|
|
(translate pos)
|
||
|
|
(concat (maim dir (vector 0 1 0)))
|
||
|
|
(rotate rot)
|
||
|
|
(scale (* const-scale sc 0.2 ev-time)))
|
||
|
|
|
||
|
|
; todo inherit and call event happen or somesuch
|
||
|
|
(with-primitive particles
|
||
|
|
(pdata-index-map!
|
||
|
|
(lambda (i p)
|
||
|
|
(cond ((zero? (random 2)) p)
|
||
|
|
(else
|
||
|
|
(pdata-set! "c" i (vector (+ 0.5 (* 0.5 (rndf))) (+ 0.5 (* 0.5 (rndf))) 1))
|
||
|
|
(vector 0 0 0))))
|
||
|
|
"p"))
|
||
|
|
(set! ev-time ev-dur))
|
||
|
|
(set! ev-time (- ev-time d)))
|
||
|
|
|
||
|
|
(set! excitation-changed #f))
|
||
|
|
|
||
|
|
(super-new)))
|