v5
This commit is contained in:
Dave Griffiths
parent
b68cf01bf9
commit
8715b791c5
2 changed files with 255 additions and 184 deletions
|
|
@ -1,3 +1,7 @@
|
|||
#lang scheme
|
||||
(require fluxus-016/drflux)
|
||||
|
||||
; extrusion code
|
||||
|
||||
(define (draw-profile index profile offset)
|
||||
(cond ((not (null? profile))
|
||||
|
|
@ -22,59 +26,32 @@
|
|||
(vmul v 0.5)))))
|
||||
vd))
|
||||
|
||||
(define (extrude-segment index profile path lv)
|
||||
(define (extrude-segment index profile path width lv up)
|
||||
(cond ((not (null? path))
|
||||
(let ((v (path-vector (zero? index) path lv)))
|
||||
(draw-profile index (transform-profile profile
|
||||
(mmul
|
||||
(maim v (vector 0 1 0))
|
||||
(mrotate (vector 0 90 0))))
|
||||
(maim v up)
|
||||
(mrotate (vector 0 90 0))
|
||||
(mscale (vector (car width) (car width) (car width)))))
|
||||
(car path))
|
||||
v))))
|
||||
|
||||
(define (mmix a b 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)
|
||||
(define (extrude-segment-grow index profile path width lv up t)
|
||||
(cond ((not (null? path))
|
||||
; figure out the vector for rotation of the profile
|
||||
(let ((v (path-vector (zero? index) path v)))
|
||||
(cond ((null? (cdr path))
|
||||
(draw-profile index (transform-profile profile
|
||||
(mmul
|
||||
(maim v (vector 0 1 0))
|
||||
(mrotate (vector 0 90 0))))
|
||||
(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)))))
|
||||
(let ((v (path-vector (zero? index) path lv)))
|
||||
(draw-profile index (transform-profile profile
|
||||
(mmul
|
||||
(maim v up)
|
||||
(mrotate (vector 0 90 0))
|
||||
(mscale (vmul (vector (car width) (car width) (car width)) t))))
|
||||
(car path))
|
||||
v))))
|
||||
|
||||
|
||||
(define (extrude index profile path lv)
|
||||
(define (extrude index profile path width lv up)
|
||||
(cond ((not (null? path))
|
||||
(let ((v (extrude-segment index profile path lv)))
|
||||
(extrude (+ index (length profile)) profile (cdr path) v)))))
|
||||
(let ((v (extrude-segment index profile path width lv up)))
|
||||
(extrude (+ index (length profile)) profile (cdr path) (cdr width) v up)))))
|
||||
|
||||
(define (stitch-face index count profile-size in)
|
||||
(cond
|
||||
|
|
@ -98,20 +75,29 @@
|
|||
(- path-size 1)
|
||||
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)))
|
||||
(with-primitive p
|
||||
(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))
|
||||
p))
|
||||
|
||||
; 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)))
|
||||
(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))
|
||||
|
||||
(define (chop-front l n)
|
||||
|
|
@ -120,43 +106,74 @@
|
|||
(if (zero? n) (cons (car l) (chop-front (cdr l) n))
|
||||
(chop-front (cdr l) (- n 1))))))
|
||||
|
||||
; returns the last vector
|
||||
(define (partial-extrude p t v profile path)
|
||||
(define (partial-extrude p t v profile path width up)
|
||||
(with-primitive p 0
|
||||
|
||||
(let* ((start (* (floor t) (length profile)))
|
||||
(end (* (length path) (length profile)))
|
||||
(v (extrude-segment start profile
|
||||
(chop-front path (floor t)) v)))
|
||||
|
||||
(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)))))
|
||||
|
||||
(let* ((T (floor t))
|
||||
(t (- t T))
|
||||
(seg-len (length profile))
|
||||
(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)))
|
||||
|
||||
|
||||
|
||||
; collapse the yet un-extruded part into the last vert
|
||||
(for ((i (in-range (+ start (* (length profile) 2)) end)))
|
||||
(pdata-set! "p" i (pdata-get "p" (+ (length profile) start)))))
|
||||
(for ((i (in-range (+ start (* seg-len 2)) end)))
|
||||
(pdata-set! "p" i (pdata-ref "p" (+ seg-len start)))))
|
||||
|
||||
(recalc-normals 0)
|
||||
v)))
|
||||
|
||||
#;(define (partial-extrude p t v profile path)
|
||||
(define (partial-extrude-grow p t v profile path width up)
|
||||
(with-primitive p 0
|
||||
|
||||
(let* ((start (* (floor t) (length profile)))
|
||||
(end (* (length path) (length profile)))
|
||||
(v (extrude-segment-blend start profile
|
||||
(chop-front path (floor t)) v (- (floor t) 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)))))
|
||||
|
||||
|
||||
(let* ((T (floor t))
|
||||
(t (- t T))
|
||||
(seg-len (length profile))
|
||||
(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)))
|
||||
|
||||
|
||||
|
||||
; collapse the yet un-extruded part into the last vert
|
||||
(for ((i (in-range (+ start (* (length profile) 1)) end)))
|
||||
(pdata-set! "p" i (pdata-get "p" start))))
|
||||
(for ((i (in-range (+ start (* seg-len 2)) end)))
|
||||
(pdata-set! "p" i (pdata-ref "p" (+ seg-len start)))))
|
||||
|
||||
(recalc-normals 0)
|
||||
v)))
|
||||
|
|
@ -171,6 +188,7 @@
|
|||
(_ n n '()))
|
||||
|
||||
(clear)
|
||||
(clear-colour 0.5)
|
||||
|
||||
(define l (make-light 'point 'free))
|
||||
(light-diffuse 0 (vector 0 0 0))
|
||||
|
|
@ -180,26 +198,18 @@
|
|||
|
||||
(define profile (build-circle-profile 12 0.5))
|
||||
|
||||
(define path (build-list 50
|
||||
(lambda (n) (vmul (vector (sin (* 0.5 n)) 0 (cos (* 0.5 n))) (+ 0.5 (* 0.2 n))))))
|
||||
(define width (build-list 100
|
||||
(lambda (n) (* 0.5 (+ 1 (sin (* 0.3 n)))))))
|
||||
|
||||
#;(define path (build-list 10
|
||||
(lambda (n) (vector (* 10 (rndf)) 0 (* 3 n)))))
|
||||
(define path (build-list 100
|
||||
(lambda (n) (vmul (vector (sin (* 0.05 n)) 0 (cos (* 0.05 n))) (+ 0.5 (* 0.2 n))))))
|
||||
|
||||
(define p (with-state
|
||||
; (hint-wire)
|
||||
(colour (vector 0 0.5 0.5))
|
||||
(specular (vector 1 1 1))
|
||||
(shinyness 20)
|
||||
(build-partial-extrusion profile path)))
|
||||
|
||||
(define v (vector 0 0 0))
|
||||
|
||||
(define (animate)
|
||||
(set! v (partial-extrude p (fmod (* 2 (time)) (length path)) v profile path)))
|
||||
|
||||
(every-frame (animate))
|
||||
|
||||
(build-partial-extrusion profile path 1)))
|
||||
|
||||
(with-state
|
||||
(wire-opacity 0.4)
|
||||
|
|
@ -210,4 +220,14 @@
|
|||
; (hint-normal)
|
||||
(backfacecull 1)
|
||||
(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))
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -37,8 +37,8 @@
|
|||
|
||||
(define branch-probability 2) ; as in one in branch-probability chance
|
||||
(define branch-width-reduction 0.5)
|
||||
(define twig-jitter 0.5)
|
||||
(define branch-jitter 1)
|
||||
(define twig-jitter 0.1)
|
||||
(define branch-jitter 0.5)
|
||||
(define max-twig-points 10)
|
||||
(define start-twig-width 0.1)
|
||||
(define default-max-twigs 10)
|
||||
|
|
@ -50,21 +50,28 @@
|
|||
(define pickup-size 1)
|
||||
(define max-ornaments 2) ; per twig
|
||||
(define ornament-grow-probability 4)
|
||||
(define curl-amount 40)
|
||||
|
||||
(define (ornament-colour) (vector 0.5 1 0.4))
|
||||
(define (pickup-colour) (vector 1 1 1))
|
||||
|
||||
(define (assoc-remove k l)
|
||||
(cond
|
||||
((null? l) '())
|
||||
((eq? (car (car l)) k)
|
||||
(assoc-remove k (cdr l)))
|
||||
(else
|
||||
(cons (car l) (assoc-remove k (cdr l))))))
|
||||
|
||||
(define (choose l)
|
||||
(list-ref l (random (length l))))
|
||||
(define (assoc-remove k l)
|
||||
(cond
|
||||
((null? l) '())
|
||||
((eq? (car (car l)) k)
|
||||
(assoc-remove k (cdr l)))
|
||||
(else
|
||||
(cons (car l) (assoc-remove k (cdr l))))))
|
||||
|
||||
(define (choose 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
|
||||
(define message%
|
||||
|
|
@ -136,7 +143,8 @@
|
|||
(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
|
||||
(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)
|
||||
|
||||
|
|
@ -174,19 +182,29 @@
|
|||
(set! width (* width a))
|
||||
(set! dist (* dist a)))
|
||||
|
||||
(define/public (grow)
|
||||
(define/public (grow curly)
|
||||
(when (< (length points) num-points)
|
||||
(let ((new-point (if (zero? (length points))
|
||||
; first point should be at edge of the seed if we are a branch
|
||||
(if branch (vmul dir dist) (vector 0 0 0))
|
||||
(vadd last-point (vmul dir dist) (vmul (srndvec) (* dist twig-jitter))))))
|
||||
(if branch (vmul dir 1) (vector 0 0 0))
|
||||
(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! points (append points (list new-point)))
|
||||
(send-message 'twig-grow (list
|
||||
(list 'plant-id (send plant get-id))
|
||||
(list 'twig-id id)
|
||||
(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)
|
||||
(make-object twig-logic% (send plant get-next-twig-id)
|
||||
plant
|
||||
|
|
@ -198,7 +216,7 @@
|
|||
dist))))
|
||||
(for-each
|
||||
(lambda (twig)
|
||||
(send (cadr twig) grow))
|
||||
(send (cadr twig) grow curly))
|
||||
twigs))
|
||||
|
||||
(define/public (add-twig point-index twig)
|
||||
|
|
@ -363,10 +381,11 @@
|
|||
pos)
|
||||
|
||||
(define/public (grow)
|
||||
(for-each
|
||||
(lambda (twig)
|
||||
(send twig grow))
|
||||
twigs))
|
||||
(let ((curly (list-contains 'curly properties)))
|
||||
(for-each
|
||||
(lambda (twig)
|
||||
(send twig grow curly))
|
||||
twigs)))
|
||||
|
||||
(define/public (add-property name)
|
||||
(set! properties (cons name properties)))
|
||||
|
|
@ -445,7 +464,8 @@
|
|||
((property (choose properties))
|
||||
(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
|
||||
((or
|
||||
(eq? property 'leaf)
|
||||
|
|
@ -456,7 +476,8 @@
|
|||
this
|
||||
twig
|
||||
point-index))
|
||||
(else (error "unkown property ~a~n" property))))))))
|
||||
(else
|
||||
(error "property not understood " property)))))))))
|
||||
(map
|
||||
(lambda (twig)
|
||||
(send twig update))
|
||||
|
|
@ -476,7 +497,7 @@
|
|||
|
||||
(define/public (setup)
|
||||
(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)))))
|
||||
|
||||
(define/public (add-player plant)
|
||||
|
|
@ -550,7 +571,8 @@
|
|||
((eq? property 'leaf)
|
||||
(colour (vector 0.8 1 0.6))
|
||||
(texture (load-texture "textures/leaf2.png"))
|
||||
(load-primitive "meshes/leaf.obj"))))))
|
||||
(load-primitive "meshes/leaf.obj"))
|
||||
(else (error ""))))))
|
||||
|
||||
(define/public (update t d)
|
||||
(when (< time 1)
|
||||
|
|
@ -580,9 +602,10 @@
|
|||
(colour (pickup-colour))
|
||||
(scale 0.3)
|
||||
(texture
|
||||
(cond
|
||||
(cond
|
||||
((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")))
|
||||
(from pos)
|
||||
(destination (vector 0 0 0))
|
||||
|
|
@ -684,8 +707,7 @@
|
|||
(super-new)))
|
||||
|
||||
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
|
||||
; extrusion code
|
||||
; extrusion code
|
||||
|
||||
(define (draw-profile index profile offset)
|
||||
(cond ((not (null? profile))
|
||||
|
|
@ -710,41 +732,32 @@
|
|||
(vmul v 0.5)))))
|
||||
vd))
|
||||
|
||||
(define (extrude-segment index profile path lv)
|
||||
(define (extrude-segment index profile path width lv up)
|
||||
(cond ((not (null? path))
|
||||
(let ((v (path-vector (zero? index) path lv)))
|
||||
(draw-profile index (transform-profile profile
|
||||
(mmul
|
||||
(maim v (vector 1 0 0))
|
||||
(mrotate (vector 0 90 0))))
|
||||
(maim v up)
|
||||
(mrotate (vector 0 90 0))
|
||||
(mscale (vector (car width) (car width) (car width)))))
|
||||
(car path))
|
||||
v))))
|
||||
|
||||
|
||||
(define (extrude-segment-blend index profile path lv t)
|
||||
(define (extrude-segment-grow index profile path width lv up t)
|
||||
(cond ((not (null? path))
|
||||
; figure out the vector for rotation of the profile
|
||||
(let ((v (path-vector (zero? index) path lv)))
|
||||
(cond ((null? (cdr path))
|
||||
(draw-profile index (transform-profile profile
|
||||
(mmul
|
||||
(maim v (vector 1 0 0))
|
||||
(mrotate (vector 0 90 0))))
|
||||
(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)))))
|
||||
(let ((v (path-vector (zero? index) path lv)))
|
||||
(draw-profile index (transform-profile profile
|
||||
(mmul
|
||||
(maim v up)
|
||||
(mrotate (vector 0 90 0))
|
||||
(mscale (vmul (vector (car width) (car width) (car width)) t))))
|
||||
(car path))
|
||||
v))))
|
||||
|
||||
|
||||
(define (extrude index profile path lv)
|
||||
(define (extrude index profile path width lv up)
|
||||
(cond ((not (null? path))
|
||||
(let ((v (extrude-segment index profile path lv)))
|
||||
(extrude (+ index (length profile)) profile (cdr path) v)))))
|
||||
(let ((v (extrude-segment index profile path width lv up)))
|
||||
(extrude (+ index (length profile)) profile (cdr path) (cdr width) v up)))))
|
||||
|
||||
(define (stitch-face index count profile-size in)
|
||||
(cond
|
||||
|
|
@ -775,12 +788,12 @@
|
|||
(/ (modulo i profile-size) profile-size) 0))
|
||||
"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)))
|
||||
(with-primitive p
|
||||
(poly-set-index (stitch-indices 0 (length profile) (length path) '()))
|
||||
(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))
|
||||
p))
|
||||
|
||||
|
|
@ -799,43 +812,74 @@
|
|||
(if (zero? n) (cons (car l) (chop-front (cdr l) n))
|
||||
(chop-front (cdr l) (- n 1))))))
|
||||
|
||||
; returns the last vector
|
||||
(define (partial-extrude p t v profile path)
|
||||
(define (partial-extrude p t v profile path width up)
|
||||
(with-primitive p 0
|
||||
|
||||
(let* ((start (* (floor t) (length profile)))
|
||||
(end (* (length path) (length profile)))
|
||||
(v (extrude-segment start profile
|
||||
(chop-front path (floor t)) v)))
|
||||
|
||||
(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)))))
|
||||
|
||||
(let* ((T (floor t))
|
||||
(t (- t T))
|
||||
(seg-len (length profile))
|
||||
(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)))
|
||||
|
||||
|
||||
|
||||
; collapse the yet un-extruded part into the last vert
|
||||
(for ((i (in-range (+ start (* (length profile) 2)) end)))
|
||||
(pdata-set! "p" i (pdata-ref "p" (+ (length profile) start)))))
|
||||
(for ((i (in-range (+ start (* seg-len 2)) end)))
|
||||
(pdata-set! "p" i (pdata-ref "p" (+ seg-len start)))))
|
||||
|
||||
(recalc-normals 0)
|
||||
v)))
|
||||
|
||||
#;(define (partial-extrude p t v profile path)
|
||||
(define (partial-extrude-grow p t v profile path width up)
|
||||
(with-primitive p 0
|
||||
|
||||
(let* ((start (* (floor t) (length profile)))
|
||||
(end (* (length path) (length profile)))
|
||||
(v (extrude-segment-blend start profile
|
||||
(chop-front path (floor t)) v (- (floor t) 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)))))
|
||||
|
||||
|
||||
(let* ((T (floor t))
|
||||
(t (- t T))
|
||||
(seg-len (length profile))
|
||||
(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)))
|
||||
|
||||
|
||||
|
||||
; collapse the yet un-extruded part into the last vert
|
||||
(for ((i (in-range (+ start (* (length profile) 1)) end)))
|
||||
(pdata-set! "p" i (pdata-get "p" start))))
|
||||
(for ((i (in-range (+ start (* seg-len 2)) end)))
|
||||
(pdata-set! "p" i (pdata-ref "p" (+ seg-len start)))))
|
||||
|
||||
(recalc-normals 0)
|
||||
v)))
|
||||
|
|
@ -915,16 +959,22 @@
|
|||
(root 0)
|
||||
(v (vector 0 0 0))
|
||||
(grow-speed default-grow-speed)
|
||||
(anim-t 0))
|
||||
(anim-t 0)
|
||||
(widths '()))
|
||||
|
||||
(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! 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
|
||||
(backfacecull 0)
|
||||
(backfacecull 1)
|
||||
(translate pos)
|
||||
(colour (vector 0.8 1 0.6))
|
||||
(texture (load-texture "textures/root.png"))
|
||||
(texture (load-texture "textures/skin.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))))
|
||||
p)))
|
||||
|
||||
|
|
@ -943,12 +993,13 @@
|
|||
(when (zero? index) (set! path (list-set path index point)))
|
||||
(set! path (list-set path (+ index 1) point))
|
||||
(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)))
|
||||
|
||||
(define/augment (update t d)
|
||||
(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))))
|
||||
|
||||
(define/public (get-end-pos)
|
||||
|
|
@ -1137,9 +1188,10 @@
|
|||
(light-diffuse l (vector 1 1 1))
|
||||
(light-position l (vector 10 50 -4)))
|
||||
|
||||
(clear-colour (vector 0.1 0.3 0.2))
|
||||
|
||||
(fog (vector 0.2 0.5 0.3) 0.02 1 100))
|
||||
(clear-colour (vector 0.5 0.3 0.2))
|
||||
|
||||
(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)
|
||||
(get-plant player-plant-id))
|
||||
|
|
@ -1166,8 +1218,7 @@
|
|||
(define/public (grow-seed plant-id amount)
|
||||
(when (eq? plant-id player-plant-id)
|
||||
(set! camera-dist (* camera-dist amount))
|
||||
(with-primitive env-root (scale amount))
|
||||
#;(fog (vector 0.2 0.5 0.3) (* 0.01 (* amount amount amount)) 1 100))
|
||||
(with-primitive env-root (scale amount)))
|
||||
(send (get-plant plant-id) grow-seed amount))
|
||||
|
||||
(define/public (get-pickup pickup-id)
|
||||
|
|
|
|||
Loading…
Reference in a new issue