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

v5

Browse source
This commit is contained in:
Dave Griffiths 2009-06-30 17:55:49 +01:00
parent b68cf01bf9
commit 8715b791c5
2 changed files with 255 additions and 184 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

186
plant-eyes/extrude.scm
View file

@ -1,3 +1,7 @@
#lang scheme
(require fluxus-016/drflux)
; extrusion code
(define (draw-profile index profile offset) (define (draw-profile index profile offset)
(cond ((not (null? profile)) (cond ((not (null? profile))
@ -22,59 +26,32 @@
(vmul v 0.5))))) (vmul v 0.5)))))
vd)) vd))
(define (extrude-segment index profile path lv) (define (extrude-segment index profile path width lv up)
(cond ((not (null? path)) (cond ((not (null? path))
(let ((v (path-vector (zero? index) path lv))) (let ((v (path-vector (zero? index) path lv)))
(draw-profile index (transform-profile profile (draw-profile index (transform-profile profile
(mmul (mmul
(maim v (vector 0 1 0)) (maim v up)
(mrotate (vector 0 90 0)))) (mrotate (vector 0 90 0))
(mscale (vector (car width) (car width) (car width)))))
(car path)) (car path))
v)))) v))))
(define (mmix a b t) (define (extrude-segment-grow index profile path width lv up t)
(vector
(+ (* (vector-ref a 0) (- 1 t)) (* (vector-ref b 0) t))
(+ (* (vector-ref a 1) (- 1 t)) (* (vector-ref b 1) t))
(+ (* (vector-ref a 2) (- 1 t)) (* (vector-ref b 2) t))
(+ (* (vector-ref a 3) (- 1 t)) (* (vector-ref b 3) t))
(+ (* (vector-ref a 4) (- 1 t)) (* (vector-ref b 4) t))
(+ (* (vector-ref a 5) (- 1 t)) (* (vector-ref b 5) t))
(+ (* (vector-ref a 6) (- 1 t)) (* (vector-ref b 6) t))
(+ (* (vector-ref a 7) (- 1 t)) (* (vector-ref b 7) t))
(+ (* (vector-ref a 8) (- 1 t)) (* (vector-ref b 8) t))
(+ (* (vector-ref a 9) (- 1 t)) (* (vector-ref b 9) t))
(+ (* (vector-ref a 10) (- 1 t)) (* (vector-ref b 10) t))
(+ (* (vector-ref a 11) (- 1 t)) (* (vector-ref b 11) t))
(+ (* (vector-ref a 12) (- 1 t)) (* (vector-ref b 12) t))
(+ (* (vector-ref a 13) (- 1 t)) (* (vector-ref b 13) t))
(+ (* (vector-ref a 14) (- 1 t)) (* (vector-ref b 14) t))
(+ (* (vector-ref a 15) (- 1 t)) (* (vector-ref b 15) t))))
(define (extrude-segment-blend index profile path lv t)
(cond ((not (null? path)) (cond ((not (null? path))
; figure out the vector for rotation of the profile (let ((v (path-vector (zero? index) path lv)))
(let ((v (path-vector (zero? index) path v))) (draw-profile index (transform-profile profile
(cond ((null? (cdr path)) (mmul
(draw-profile index (transform-profile profile (maim v up)
(mmul (mrotate (vector 0 90 0))
(maim v (vector 0 1 0)) (mscale (vmul (vector (car width) (car width) (car width)) t))))
(mrotate (vector 0 90 0)))) (car path))
(car path)))
(else
(let ((v2 (path-vector (zero? index) (cdr path) v)))
(draw-profile index (transform-profile profile
(mmul
(maim (vmix (vnormalise v) (vnormalise v2) t) (vector 0 1 0))
(mrotate (vector 0 90 0))))
(vmix (car path) (vadd (car path) v2) t)))))
v)))) v))))
(define (extrude index profile path width lv up)
(define (extrude index profile path lv)
(cond ((not (null? path)) (cond ((not (null? path))
(let ((v (extrude-segment index profile path lv))) (let ((v (extrude-segment index profile path width lv up)))
(extrude (+ index (length profile)) profile (cdr path) v))))) (extrude (+ index (length profile)) profile (cdr path) (cdr width) v up)))))
(define (stitch-face index count profile-size in) (define (stitch-face index count profile-size in)
(cond (cond
@ -98,20 +75,29 @@
(- path-size 1) (- path-size 1)
in))))) in)))))
(define (build-extrusion profile path) (define (build-tex-coords profile-size path-size vscale)
(pdata-index-map!
(lambda (i t)
(vector (* vscale (/ (quotient i profile-size) path-size))
(/ (modulo i profile-size) profile-size) 0))
"t"))
(define (build-extrusion profile path width tex-vscale up)
(let ((p (build-polygons (* (length profile) (length path)) 'quad-list))) (let ((p (build-polygons (* (length profile) (length path)) 'quad-list)))
(with-primitive p (with-primitive p
(poly-set-index (stitch-indices 0 (length profile) (length path) '())) (poly-set-index (stitch-indices 0 (length profile) (length path) '()))
(extrude 0 profile path (vector 0 0 0)) (build-tex-coords (length profile) (length path) tex-vscale)
(extrude 0 profile path width (vector 0 0 0) up)
(recalc-normals 0)) (recalc-normals 0))
p)) p))
; partial extrusions are for animating ; partial extrusions are for animating
(define (build-partial-extrusion profile path) (define (build-partial-extrusion profile path tex-vscale)
(let ((p (build-polygons (* (length profile) (length path)) 'quad-list))) (let ((p (build-polygons (* (length profile) (length path)) 'quad-list)))
(with-primitive p (with-primitive p
(poly-set-index (stitch-indices 0 (length profile) (length path) '()))) (poly-set-index (stitch-indices 0 (length profile) (length path) '()))
(build-tex-coords (length profile) (length path) tex-vscale))
p)) p))
(define (chop-front l n) (define (chop-front l n)
@ -120,43 +106,74 @@
(if (zero? n) (cons (car l) (chop-front (cdr l) n)) (if (zero? n) (cons (car l) (chop-front (cdr l) n))
(chop-front (cdr l) (- n 1)))))) (chop-front (cdr l) (- n 1))))))
; returns the last vector (define (partial-extrude p t v profile path width up)
(define (partial-extrude p t v profile path)
(with-primitive p 0 (with-primitive p 0
(let* ((start (* (floor t) (length profile))) (let* ((T (floor t))
(end (* (length path) (length profile))) (t (- t T))
(v (extrude-segment start profile (seg-len (length profile))
(chop-front path (floor t)) v))) (start (* T seg-len))
(end (* (length path) seg-len))
(v (extrude-segment start profile
(chop-front path T)
(chop-front width T) v up)))
(when (< T (- (length path) 1))
; extrude the next segment
(extrude-segment (+ start seg-len) profile
(chop-front path (+ T 1))
(chop-front width (+ T 1)) v up)
; and now blend it back by using both segments to t
(for ((i (in-range (+ start seg-len)
(+ start (* 2 seg-len)))))
(pdata-set! "p" i (vmix (pdata-ref "p" i)
(pdata-ref "p" (- i seg-len))
t)))
(when (< t (- (length path) 1))
(for ((i (in-range (+ start (length profile)) (+ start (* 2 (length profile))))))
(pdata-set! "p" i (vsub (pdata-ref "p" (- i (length profile)))
(vmul v (- (floor t) t)))))
; collapse the yet un-extruded part into the last vert ; collapse the yet un-extruded part into the last vert
(for ((i (in-range (+ start (* (length profile) 2)) end))) (for ((i (in-range (+ start (* seg-len 2)) end)))
(pdata-set! "p" i (pdata-get "p" (+ (length profile) start))))) (pdata-set! "p" i (pdata-ref "p" (+ seg-len start)))))
(recalc-normals 0) (recalc-normals 0)
v))) v)))
#;(define (partial-extrude p t v profile path) (define (partial-extrude-grow p t v profile path width up)
(with-primitive p 0 (with-primitive p 0
(let* ((start (* (floor t) (length profile))) (let* ((T (floor t))
(end (* (length path) (length profile))) (t (- t T))
(v (extrude-segment-blend start profile (seg-len (length profile))
(chop-front path (floor t)) v (- (floor t) t)))) (start (* T seg-len))
(end (* (length path) seg-len))
(v (extrude-segment-grow start profile
(chop-front path T)
(chop-front width T) v up t)))
(when (< T (- (length path) 1))
; extrude the next segment
(extrude-segment-grow (+ start seg-len) profile
(chop-front path (+ T 1))
(chop-front width (+ T 1)) v up 0)
; and now blend it back by using both segments to t
(for ((i (in-range (+ start seg-len)
(+ start (* 2 seg-len)))))
(pdata-set! "p" i (vmix (pdata-ref "p" i)
(pdata-ref "p" (- i seg-len))
t)))
(when (< t (- (length path) 1))
#;(for ((i (in-range (+ start (length profile)) (+ start (* 2 (length profile))))))
(pdata-set! "p" i (vsub (pdata-ref "p" (- i (length profile)))
(vmul v (- (floor t) t)))))
; collapse the yet un-extruded part into the last vert ; collapse the yet un-extruded part into the last vert
(for ((i (in-range (+ start (* (length profile) 1)) end))) (for ((i (in-range (+ start (* seg-len 2)) end)))
(pdata-set! "p" i (pdata-get "p" start)))) (pdata-set! "p" i (pdata-ref "p" (+ seg-len start)))))
(recalc-normals 0) (recalc-normals 0)
v))) v)))
@ -171,6 +188,7 @@
(_ n n '())) (_ n n '()))
(clear) (clear)
(clear-colour 0.5)
(define l (make-light 'point 'free)) (define l (make-light 'point 'free))
(light-diffuse 0 (vector 0 0 0)) (light-diffuse 0 (vector 0 0 0))
@ -180,26 +198,18 @@
(define profile (build-circle-profile 12 0.5)) (define profile (build-circle-profile 12 0.5))
(define path (build-list 50 (define width (build-list 100
(lambda (n) (vmul (vector (sin (* 0.5 n)) 0 (cos (* 0.5 n))) (+ 0.5 (* 0.2 n)))))) (lambda (n) (* 0.5 (+ 1 (sin (* 0.3 n)))))))
#;(define path (build-list 10 (define path (build-list 100
(lambda (n) (vector (* 10 (rndf)) 0 (* 3 n))))) (lambda (n) (vmul (vector (sin (* 0.05 n)) 0 (cos (* 0.05 n))) (+ 0.5 (* 0.2 n))))))
(define p (with-state (define p (with-state
; (hint-wire) ; (hint-wire)
(colour (vector 0 0.5 0.5)) (colour (vector 0 0.5 0.5))
(specular (vector 1 1 1)) (specular (vector 1 1 1))
(shinyness 20) (shinyness 20)
(build-partial-extrusion profile path))) (build-partial-extrusion profile path 1)))
(define v (vector 0 0 0))
(define (animate)
(set! v (partial-extrude p (fmod (* 2 (time)) (length path)) v profile path)))
(every-frame (animate))
(with-state (with-state
(wire-opacity 0.4) (wire-opacity 0.4)
@ -210,4 +220,14 @@
; (hint-normal) ; (hint-normal)
(backfacecull 1) (backfacecull 1)
(point-width 5) (point-width 5)
(build-extrusion profile path)) (build-extrusion profile path width 1 (vector 0 1 0)))
(define v (vector 0 0 0))
(define (animate)
(set! v (partial-extrude-grow p (fmod (* 2 (flxtime)) (length path)) v profile path width (vector 0 1 0))))
(every-frame (animate))

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

@ -37,8 +37,8 @@
(define branch-probability 2) ; as in one in branch-probability chance (define branch-probability 2) ; as in one in branch-probability chance
(define branch-width-reduction 0.5) (define branch-width-reduction 0.5)
(define twig-jitter 0.5) (define twig-jitter 0.1)
(define branch-jitter 1) (define branch-jitter 0.5)
(define max-twig-points 10) (define max-twig-points 10)
(define start-twig-width 0.1) (define start-twig-width 0.1)
(define default-max-twigs 10) (define default-max-twigs 10)
@ -50,20 +50,27 @@
(define pickup-size 1) (define pickup-size 1)
(define max-ornaments 2) ; per twig (define max-ornaments 2) ; per twig
(define ornament-grow-probability 4) (define ornament-grow-probability 4)
(define curl-amount 40)
(define (ornament-colour) (vector 0.5 1 0.4)) (define (ornament-colour) (vector 0.5 1 0.4))
(define (pickup-colour) (vector 1 1 1)) (define (pickup-colour) (vector 1 1 1))
(define (assoc-remove k l) (define (assoc-remove k l)
(cond (cond
((null? l) '()) ((null? l) '())
((eq? (car (car l)) k) ((eq? (car (car l)) k)
(assoc-remove k (cdr l))) (assoc-remove k (cdr l)))
(else (else
(cons (car l) (assoc-remove k (cdr l)))))) (cons (car l) (assoc-remove k (cdr l))))))
(define (choose l) (define (choose l)
(list-ref l (random (length l)))) (list-ref l (random (length l))))
(define (list-contains k l)
(cond
((null? l) #f)
((eq? (car l) k) #t)
(else (list-contains k (cdr l)))))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; a message for sending betwixt logic and render side ; a message for sending betwixt logic and render side
@ -136,7 +143,8 @@
(twigs '()) ; children are stored with the point number they are connected to. (twigs '()) ; children are stored with the point number they are connected to.
(ornaments '()) ; the things attached to this twig, an assoc list with point index (ornaments '()) ; the things attached to this twig, an assoc list with point index
(last-point (vector 0 0 0)) ; distance between points (last-point (vector 0 0 0)) ; distance between points
(branch #f)) ; are we a main branch twig? (branch #f) ; are we a main branch twig?
(curl (vmul (crndvec) curl-amount))) ; the angles to turn each point, if curly
(inherit send-message) (inherit send-message)
@ -174,19 +182,29 @@
(set! width (* width a)) (set! width (* width a))
(set! dist (* dist a))) (set! dist (* dist a)))
(define/public (grow) (define/public (grow curly)
(when (< (length points) num-points) (when (< (length points) num-points)
(let ((new-point (if (zero? (length points)) (let ((new-point (if (zero? (length points))
; first point should be at edge of the seed if we are a branch ; first point should be at edge of the seed if we are a branch
(if branch (vmul dir dist) (vector 0 0 0)) (if branch (vmul dir 1) (vector 0 0 0))
(vadd last-point (vmul dir dist) (vmul (srndvec) (* dist twig-jitter)))))) (vadd last-point (vmul dir dist)))))
(cond (curly
(set! dir (vtransform dir (mrotate curl)))
(when (not branch)
(set! curl (vmul curl 1.2))
(set! dist (* dist 0.9))))
(else
(set! dir (vadd dir (vmul (srndvec) twig-jitter)))))
(set! last-point new-point) (set! last-point new-point)
(set! points (append points (list new-point))) (set! points (append points (list new-point)))
(send-message 'twig-grow (list (send-message 'twig-grow (list
(list 'plant-id (send plant get-id)) (list 'plant-id (send plant get-id))
(list 'twig-id id) (list 'twig-id id)
(list 'point new-point)))) (list 'point new-point))))
(when (and (> (length points) 1) (> num-points 1) (zero? (random branch-probability))) (when (and (> (length points) 1) (> num-points 1)
(zero? (random branch-probability)))
(add-twig (- (length points) 1) (add-twig (- (length points) 1)
(make-object twig-logic% (send plant get-next-twig-id) (make-object twig-logic% (send plant get-next-twig-id)
plant plant
@ -198,7 +216,7 @@
dist)))) dist))))
(for-each (for-each
(lambda (twig) (lambda (twig)
(send (cadr twig) grow)) (send (cadr twig) grow curly))
twigs)) twigs))
(define/public (add-twig point-index twig) (define/public (add-twig point-index twig)
@ -363,10 +381,11 @@
pos) pos)
(define/public (grow) (define/public (grow)
(for-each (let ((curly (list-contains 'curly properties)))
(lambda (twig) (for-each
(send twig grow)) (lambda (twig)
twigs)) (send twig grow curly))
twigs)))
(define/public (add-property name) (define/public (add-property name)
(set! properties (cons name properties))) (set! properties (cons name properties)))
@ -445,7 +464,8 @@
((property (choose properties)) ((property (choose properties))
(point-index (random (send twig get-length)))) (point-index (random (send twig get-length))))
(send twig add-ornament point-index (when (not (eq? property 'curly))
(send twig add-ornament point-index
(cond (cond
((or ((or
(eq? property 'leaf) (eq? property 'leaf)
@ -456,7 +476,8 @@
this this
twig twig
point-index)) point-index))
(else (error "unkown property ~a~n" property)))))))) (else
(error "property not understood " property)))))))))
(map (map
(lambda (twig) (lambda (twig)
(send twig update)) (send twig update))
@ -476,7 +497,7 @@
(define/public (setup) (define/public (setup)
(for ((i (in-range 0 num-pickups))) (for ((i (in-range 0 num-pickups)))
(add-pickup (make-object pickup-logic% i (choose (list 'leaf 'wiggle)) (add-pickup (make-object pickup-logic% i (choose (list 'leaf 'curly 'wiggle))
(vmul (srndvec) pickup-dist-radius))))) (vmul (srndvec) pickup-dist-radius)))))
(define/public (add-player plant) (define/public (add-player plant)
@ -550,7 +571,8 @@
((eq? property 'leaf) ((eq? property 'leaf)
(colour (vector 0.8 1 0.6)) (colour (vector 0.8 1 0.6))
(texture (load-texture "textures/leaf2.png")) (texture (load-texture "textures/leaf2.png"))
(load-primitive "meshes/leaf.obj")))))) (load-primitive "meshes/leaf.obj"))
(else (error ""))))))
(define/public (update t d) (define/public (update t d)
(when (< time 1) (when (< time 1)
@ -580,9 +602,10 @@
(colour (pickup-colour)) (colour (pickup-colour))
(scale 0.3) (scale 0.3)
(texture (texture
(cond (cond
((eq? type 'wiggle) (load-texture "textures/wiggle.png")) ((eq? type 'wiggle) (load-texture "textures/wiggle.png"))
((eq? type 'leaf) (load-texture "textures/leaf.png")))) ((eq? type 'leaf) (load-texture "textures/leaf.png"))
((eq? type 'curly) (load-texture "textures/curl.png"))))
(load-primitive "meshes/pickup.obj"))) (load-primitive "meshes/pickup.obj")))
(from pos) (from pos)
(destination (vector 0 0 0)) (destination (vector 0 0 0))
@ -684,8 +707,7 @@
(super-new))) (super-new)))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; extrusion code
; extrusion code
(define (draw-profile index profile offset) (define (draw-profile index profile offset)
(cond ((not (null? profile)) (cond ((not (null? profile))
@ -710,41 +732,32 @@
(vmul v 0.5))))) (vmul v 0.5)))))
vd)) vd))
(define (extrude-segment index profile path lv) (define (extrude-segment index profile path width lv up)
(cond ((not (null? path)) (cond ((not (null? path))
(let ((v (path-vector (zero? index) path lv))) (let ((v (path-vector (zero? index) path lv)))
(draw-profile index (transform-profile profile (draw-profile index (transform-profile profile
(mmul (mmul
(maim v (vector 1 0 0)) (maim v up)
(mrotate (vector 0 90 0)))) (mrotate (vector 0 90 0))
(mscale (vector (car width) (car width) (car width)))))
(car path)) (car path))
v)))) v))))
(define (extrude-segment-grow index profile path width lv up t)
(define (extrude-segment-blend index profile path lv t)
(cond ((not (null? path)) (cond ((not (null? path))
; figure out the vector for rotation of the profile
(let ((v (path-vector (zero? index) path lv))) (let ((v (path-vector (zero? index) path lv)))
(cond ((null? (cdr path)) (draw-profile index (transform-profile profile
(draw-profile index (transform-profile profile (mmul
(mmul (maim v up)
(maim v (vector 1 0 0)) (mrotate (vector 0 90 0))
(mrotate (vector 0 90 0)))) (mscale (vmul (vector (car width) (car width) (car width)) t))))
(car path))) (car path))
(else
(let ((v2 (path-vector (zero? index) (cdr path) v)))
(draw-profile index (transform-profile profile
(mmul
(maim (vmix (vnormalise v) (vnormalise v2) t) (vector 1 0 0))
(mrotate (vector 0 90 0))))
(vmix (car path) (vadd (car path) v2) t)))))
v)))) v))))
(define (extrude index profile path width lv up)
(define (extrude index profile path lv)
(cond ((not (null? path)) (cond ((not (null? path))
(let ((v (extrude-segment index profile path lv))) (let ((v (extrude-segment index profile path width lv up)))
(extrude (+ index (length profile)) profile (cdr path) v))))) (extrude (+ index (length profile)) profile (cdr path) (cdr width) v up)))))
(define (stitch-face index count profile-size in) (define (stitch-face index count profile-size in)
(cond (cond
@ -775,12 +788,12 @@
(/ (modulo i profile-size) profile-size) 0)) (/ (modulo i profile-size) profile-size) 0))
"t")) "t"))
(define (build-extrusion profile path tex-vscale) (define (build-extrusion profile path width tex-vscale up)
(let ((p (build-polygons (* (length profile) (length path)) 'quad-list))) (let ((p (build-polygons (* (length profile) (length path)) 'quad-list)))
(with-primitive p (with-primitive p
(poly-set-index (stitch-indices 0 (length profile) (length path) '())) (poly-set-index (stitch-indices 0 (length profile) (length path) '()))
(build-tex-coords (length profile) (length path) tex-vscale) (build-tex-coords (length profile) (length path) tex-vscale)
(extrude 0 profile path (vector 0 0 0)) (extrude 0 profile path width (vector 0 0 0) up)
(recalc-normals 0)) (recalc-normals 0))
p)) p))
@ -799,43 +812,74 @@
(if (zero? n) (cons (car l) (chop-front (cdr l) n)) (if (zero? n) (cons (car l) (chop-front (cdr l) n))
(chop-front (cdr l) (- n 1)))))) (chop-front (cdr l) (- n 1))))))
; returns the last vector (define (partial-extrude p t v profile path width up)
(define (partial-extrude p t v profile path)
(with-primitive p 0 (with-primitive p 0
(let* ((start (* (floor t) (length profile))) (let* ((T (floor t))
(end (* (length path) (length profile))) (t (- t T))
(v (extrude-segment start profile (seg-len (length profile))
(chop-front path (floor t)) v))) (start (* T seg-len))
(end (* (length path) seg-len))
(v (extrude-segment start profile
(chop-front path T)
(chop-front width T) v up)))
(when (< T (- (length path) 1))
; extrude the next segment
(extrude-segment (+ start seg-len) profile
(chop-front path (+ T 1))
(chop-front width (+ T 1)) v up)
; and now blend it back by using both segments to t
(for ((i (in-range (+ start seg-len)
(+ start (* 2 seg-len)))))
(pdata-set! "p" i (vmix (pdata-ref "p" i)
(pdata-ref "p" (- i seg-len))
t)))
(when (< t (- (length path) 1))
(for ((i (in-range (+ start (length profile)) (+ start (* 2 (length profile))))))
(pdata-set! "p" i (vsub (pdata-ref "p" (- i (length profile)))
(vmul v (- (floor t) t)))))
; collapse the yet un-extruded part into the last vert ; collapse the yet un-extruded part into the last vert
(for ((i (in-range (+ start (* (length profile) 2)) end))) (for ((i (in-range (+ start (* seg-len 2)) end)))
(pdata-set! "p" i (pdata-ref "p" (+ (length profile) start))))) (pdata-set! "p" i (pdata-ref "p" (+ seg-len start)))))
(recalc-normals 0) (recalc-normals 0)
v))) v)))
#;(define (partial-extrude p t v profile path) (define (partial-extrude-grow p t v profile path width up)
(with-primitive p 0 (with-primitive p 0
(let* ((start (* (floor t) (length profile))) (let* ((T (floor t))
(end (* (length path) (length profile))) (t (- t T))
(v (extrude-segment-blend start profile (seg-len (length profile))
(chop-front path (floor t)) v (- (floor t) t)))) (start (* T seg-len))
(end (* (length path) seg-len))
(v (extrude-segment-grow start profile
(chop-front path T)
(chop-front width T) v up t)))
(when (< T (- (length path) 1))
; extrude the next segment
(extrude-segment-grow (+ start seg-len) profile
(chop-front path (+ T 1))
(chop-front width (+ T 1)) v up 0)
; and now blend it back by using both segments to t
(for ((i (in-range (+ start seg-len)
(+ start (* 2 seg-len)))))
(pdata-set! "p" i (vmix (pdata-ref "p" i)
(pdata-ref "p" (- i seg-len))
t)))
(when (< t (- (length path) 1))
#;(for ((i (in-range (+ start (length profile)) (+ start (* 2 (length profile))))))
(pdata-set! "p" i (vsub (pdata-ref "p" (- i (length profile)))
(vmul v (- (floor t) t)))))
; collapse the yet un-extruded part into the last vert ; collapse the yet un-extruded part into the last vert
(for ((i (in-range (+ start (* (length profile) 1)) end))) (for ((i (in-range (+ start (* seg-len 2)) end)))
(pdata-set! "p" i (pdata-get "p" start)))) (pdata-set! "p" i (pdata-ref "p" (+ seg-len start)))))
(recalc-normals 0) (recalc-normals 0)
v))) v)))
@ -915,16 +959,22 @@
(root 0) (root 0)
(v (vector 0 0 0)) (v (vector 0 0 0))
(grow-speed default-grow-speed) (grow-speed default-grow-speed)
(anim-t 0)) (anim-t 0)
(widths '()))
(define/override (build) (define/override (build)
(set! profile (build-circle-profile 5 radius)) (set! profile (build-circle-profile 5 1))
(set! path (build-list num-points (lambda (n) (vector 0 0 0)))) (set! path (build-list num-points (lambda (n) (vector 0 0 0))))
(set! widths (build-list num-points (lambda (n) (if (eq? n (- num-points 1)) 0
(* radius (- 1 (/ n num-points)))))))
(set! root (let ((p (with-state (set! root (let ((p (with-state
(backfacecull 0) (backfacecull 1)
(translate pos) (translate pos)
(colour (vector 0.8 1 0.6)) (texture (load-texture "textures/skin.png"))
(texture (load-texture "textures/root.png")) (opacity 0.6)
(colour (vmul (vector 0.8 1 0.6) 2))
#;(colour (vector 1 1 1))
#;(texture (load-texture "textures/root.png"))
(build-partial-extrusion profile path 6)))) (build-partial-extrusion profile path 6))))
p))) p)))
@ -943,12 +993,13 @@
(when (zero? index) (set! path (list-set path index point))) (when (zero? index) (set! path (list-set path index point)))
(set! path (list-set path (+ index 1) point)) (set! path (list-set path (+ index 1) point))
(set! anim-t 0) (set! anim-t 0)
(set! v (partial-extrude root index v profile path)) (set! v (partial-extrude-grow root index v profile path widths (vector 1 0 0)))
(set! index (+ index 1))) (set! index (+ index 1)))
(define/augment (update t d) (define/augment (update t d)
(when (< anim-t 1) (when (< anim-t 1)
(set! v (partial-extrude root (+ (- index 1) anim-t) v profile path))) (set! v (partial-extrude-grow root (+ (- index 1) anim-t)
v profile path widths (vector 1 0 0))))
(set! anim-t (+ anim-t (* d grow-speed)))) (set! anim-t (+ anim-t (* d grow-speed))))
(define/public (get-end-pos) (define/public (get-end-pos)
@ -1137,9 +1188,10 @@
(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.5 0.3 0.2))
(fog (vector 0.2 0.5 0.3) 0.02 1 100)) (fog (vector 0.5 0.3 0.2) 0.02 1 100)
#;(fog (vector 0.2 0.5 0.3) 0.02 1 100))
(define/public (get-player) (define/public (get-player)
(get-plant player-plant-id)) (get-plant player-plant-id))
@ -1166,8 +1218,7 @@
(define/public (grow-seed plant-id amount) (define/public (grow-seed plant-id amount)
(when (eq? plant-id player-plant-id) (when (eq? plant-id player-plant-id)
(set! camera-dist (* camera-dist amount)) (set! camera-dist (* camera-dist amount))
(with-primitive env-root (scale amount)) (with-primitive env-root (scale amount)))
#;(fog (vector 0.2 0.5 0.3) (* 0.01 (* amount amount amount)) 1 100))
(send (get-plant plant-id) grow-seed amount)) (send (get-plant plant-id) grow-seed amount))
(define/public (get-pickup pickup-id) (define/public (get-pickup pickup-id)