steerable and navigatorable twigs

This commit is contained in:
Dave Griffiths 2009-07-09 12:52:56 +01:00
parent b4eef24816
commit f907549eb4
3 changed files with 195 additions and 389 deletions

View file

@ -1,8 +1,8 @@
#lang scheme/base
;#lang scheme/base
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; hex ornament/groworld game : fluxus version
(require fluxus-016/drflux)
;(require fluxus-016/drflux)
(require scheme/class)
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

View file

@ -1,5 +1,5 @@
#lang scheme
(require fluxus-016/drflux)
;#lang scheme
;(require fluxus-016/drflux)
; extrusion code
@ -26,31 +26,20 @@
(vmul v 0.5)))))
vd))
(define (extrude-segment index profile path width lv up)
(define (extrude-segment index profile path width lv up size)
(cond ((not (null? path))
(let ((v (path-vector (zero? index) path lv)))
(draw-profile index (transform-profile profile
(mmul
(maim v up)
(mrotate (vector 0 90 0))
(mscale (vector (car width) (car width) (car width)))))
(car path))
v))))
(define (extrude-segment-grow index profile path width lv up t)
(cond ((not (null? path))
(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))))
(mscale (vmul (vector (car width) (car width) (car width)) size))))
(car path))
v))))
(define (extrude index profile path width lv up)
(cond ((not (null? path))
(let ((v (extrude-segment index profile path width lv up)))
(let ((v (extrude-segment index profile path width lv up 1)))
(extrude (+ index (length profile)) profile (cdr path) (cdr width) v up)))))
(define (stitch-face index count profile-size in)
@ -76,11 +65,11 @@
in)))))
(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"))
(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)))
@ -100,83 +89,45 @@
(build-tex-coords (length profile) (length path) tex-vscale))
p))
(define (chop-front l n)
(cond ((null? l) l)
(else
(if (zero? n) (cons (car l) (chop-front (cdr l) n))
(chop-front (cdr l) (- n 1))))))
(define (partial-extrude t profile path width up grow)
(define (chop-front l n)
(cond ((null? l) l)
(else
(if (zero? n) (cons (car l) (chop-front (cdr l) n))
(chop-front (cdr l) (- n 1))))))
(define (partial-extrude p t v profile path width up)
(with-primitive p 0
(define (collapse-front)
(let ((start (* (floor t) (length profile))))
(for ((i (in-range (+ start (* (length profile) 1)) (pdata-size))))
(pdata-set! "p" i (pdata-ref "p" start)))))
(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)))
(define (scale-front)
(when (> t 1)
(let* ((start (* (floor t) (length profile)))
(from (list-ref path (- (inexact->exact (floor t)) 1)))
(to (list-ref path (+ (inexact->exact (floor t)) 0))))
(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)
(for ((i (in-range start (+ start (length profile)))))
(pdata-set! "p" i (vmix to from (- t (floor t))))))))
; 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 (* seg-len 2)) end)))
(pdata-set! "p" i (pdata-ref "p" (+ seg-len start)))))
(recalc-normals 0)
v)))
(define (partial-extrude-grow p t v profile path width up)
(with-primitive p 0
(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 (* seg-len 2)) end)))
(pdata-set! "p" i (pdata-ref "p" (+ seg-len start)))))
(recalc-normals 0)
v)))
(define (_ t v g)
(cond
((< t 1) (with-primitive p (recalc-normals 0)) v)
(else
(let ((start (* (floor t) (length profile))))
(_ (- t 1)
(extrude-segment start profile
(chop-front path (floor t))
(chop-front width (floor t)) v up
(if (< g 1)
(+ g (* (- t (floor t)) grow))
g))
(if (< g 1)
(+ g grow)
1))))))
(_ t (vector 0 0 0) 0)
(scale-front)
(collapse-front))
(define (build-circle-profile n r)
(define (_ n c l)
@ -189,45 +140,46 @@
(clear)
(clear-colour 0.5)
(define l (make-light 'point 'free))
(light-diffuse 0 (vector 0 0 0))
(light-diffuse l (vector 1 1 1))
(light-position l (vector 50 50 0))
(light-specular l (vector 1 1 1))
(define profile (build-circle-profile 12 0.5))
(define width (build-list 100
(lambda (n) (* 0.5 (+ 1 (sin (* 0.3 n)))))))
(lambda (n) (* n 0.01 (+ 1.5 (cos (* 0.5 n)))))))
(define path (build-list 100
(lambda (n) (vmul (vector (sin (* 0.05 n)) 0 (cos (* 0.05 n))) (+ 0.5 (* 0.2 n))))))
(lambda (n) (vmul (vector (sin (* 0.2 n)) 0 (cos (* 0.2 n))) (* 0.05 n)))))
(define p (with-state
; (hint-wire)
(colour (vector 0 0.5 0.5))
(wire-colour 0)
; (colour (vector 0.5 0.3 0.2))
(colour (vector 1 1 1))
(specular (vector 1 1 1))
(shinyness 20)
(build-partial-extrusion profile path 1)))
(hint-wire)
(texture (load-texture "textures/root.png"))
(build-partial-extrusion profile path 10)))
(with-state
#;(with-state
(wire-opacity 0.4)
(translate (vector 0 0 0))
(wire-colour (vector 0 0 1))
(wire-colour (vector 0 0 1))
(hint-none)
(hint-wire)
; (hint-normal)
; (hint-normal)
(backfacecull 1)
(point-width 5)
(build-extrusion profile path width 1 (vector 0 1 0)))
(define v (vector 0 0 0))
(define t 0)
(define (animate)
(set! v (partial-extrude-grow p (fmod (* 2 (flxtime)) (length path)) v profile path width (vector 0 1 0))))
(with-primitive p
(partial-extrude
(* (* 0.5 (+ 1 (sin (* 0.2 t)))) (length path))
profile path width (vector 0 1 0) 0.05)
(set! t (+ t 0.01))))
(every-frame (animate))
(end-framedump)
;(start-framedump "ext-" "jpg")

View file

@ -1,5 +1,5 @@
;#lang scheme/base
;(require fluxus-016/drflux)
#lang scheme/base
(require fluxus-016/drflux)
(require scheme/class)
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@ -35,16 +35,17 @@
(define debug-messages #f) ; prints out all the messages sent to the renderer
(define logic-tick 1) ; time between logic updates
(define branch-probability 2) ; as in one in branch-probability chance
(define branch-probability 6) ; as in one in branch-probability chance
(define branch-width-reduction 0.5)
(define twig-jitter 0.1)
(define branch-jitter 0.5)
(define max-twig-points 10)
(define start-twig-width 0.2)
(define max-twig-points 20)
(define start-twig-dist 0.3)
(define start-twig-width 0.3)
(define default-max-twigs 10)
(define default-scale-factor 1.05)
(define default-grow-speed 1)
(define root-camera-time (* default-max-twigs logic-tick))
(define root-camera-time (* max-twig-points logic-tick))
(define num-pickups 10)
(define pickup-dist-radius 20)
(define pickup-size 1)
@ -139,7 +140,7 @@
(width 0) ; the width of this root
(num-points max-twig-points) ; number of points in this twig
(render-type 'extruded) ; the way to tell the view to render this twig
(dist 1)) ; distance between points
(dist start-twig-dist)) ; distance between points
(field
(points '()) ; the 3d points for this twig
@ -181,18 +182,25 @@
(define/public (get-length)
(length points))
(define/public (get-end-pos)
(if (not (null? points))
(list-ref points (- (get-length) 1))
#f))
(define/public (scale a)
(set! width (* width a))
(set! dist (* dist a)))
(define/public (grow curly)
(define/public (grow ndir)
(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 1) (vector 0 0 0))
(vadd last-point (vmul dir dist)))))
(cond (curly
(set! dir (vmix dir ndir 0.5))
#;(cond (curly
(set! dir (vtransform dir (mrotate curl)))
(when (not branch)
(set! curl (vmul curl 1.2))
@ -219,7 +227,7 @@
dist))))
(for-each
(lambda (twig)
(send (cadr twig) grow curly))
(send (cadr twig) grow ndir))
twigs))
(define/public (add-twig point-index twig)
@ -369,7 +377,7 @@
(twigs '()) ; a assoc list map of ages to twigs
(properties '()) ; a list of symbols - properties come from pickups
(ornaments '()) ; map of ids to ornaments on the plant
(size 1) ; the age of this plant
(size 5) ; the age of this plant
(max-twigs default-max-twigs) ; the maximum twigs allowed at any time - oldest removed first
(next-twig-id 0)
(next-ornament-id 0)
@ -383,12 +391,11 @@
(define/public (get-pos)
pos)
(define/public (grow)
(let ((curly (list-contains 'curly properties)))
(define/public (grow dir)
(for-each
(lambda (twig)
(send twig grow curly))
twigs)))
(send twig grow dir))
twigs))
(define/public (add-property name)
(set! properties (cons name properties)))
@ -457,6 +464,17 @@
(send (choose twigs) get-random-twig)
#f))
(define/public (get-twig-from-dir dir)
(let ((dir (vnormalise dir)))
(cadr (foldl
(lambda (twig l)
(let ((d (vdot (vnormalise (send twig get-dir)) dir)))
(if (> d (car l))
(list d twig)
l)))
(list -99 #f)
twigs))))
(define/augment (update)
; grow a new ornament?
@ -711,193 +729,6 @@
(super-new)))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; extrusion code
(define (draw-profile index profile offset)
(cond ((not (null? profile))
(pdata-set! "p" index (vadd (car profile) offset))
(draw-profile (+ index 1) (cdr profile) offset))))
(define (transform-profile profile m)
(cond
((null? profile) '())
(else
(cons (vtransform (car profile) m)
(transform-profile (cdr profile) m)))))
; figures out the vector for rotation of the profile
(define (path-vector first-segment path lv)
(let* ((v (if (null? (cdr path)) ; last segment?
lv ; use the last vector used
(vsub (cadr path) (car path)))) ; use the next point
(vd (if first-segment v ; first segment?
(vadd (vmul lv 0.5) ; blend with the last vector
(vmul v 0.5)))))
vd))
(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 up)
(mrotate (vector 0 90 0))
(mscale (vector (car width) (car width) (car width)))))
(car path))
v))))
(define (extrude-segment-grow index profile path width lv up t)
(cond ((not (null? path))
(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 width lv up)
(cond ((not (null? path))
(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
((eq? 1 count)
(append in (list (+ (- index profile-size) 1) index (+ index profile-size)
(+ (- index profile-size) 1 profile-size))))
(else
(append
(list (+ index 1) index
(+ index profile-size) (+ index profile-size 1))
(stitch-face (+ index 1) (- count 1) profile-size in)))))
(define (stitch-indices index profile-size path-size in)
(cond
((eq? 1 path-size) in)
(else
(append
(stitch-face index profile-size profile-size '())
(stitch-indices (+ index profile-size)
profile-size
(- path-size 1)
in)))))
(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) '()))
(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 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) '()))
(build-tex-coords (length profile) (length path) tex-vscale))
p))
(define (chop-front l n)
(cond ((null? l) l)
(else
(if (zero? n) (cons (car l) (chop-front (cdr l) n))
(chop-front (cdr l) (- n 1))))))
(define (partial-extrude p t v profile path width up)
(with-primitive p 0
(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 (* seg-len 2)) end)))
(pdata-set! "p" i (pdata-ref "p" (+ seg-len start)))))
(recalc-normals 0)
v)))
(define (partial-extrude-grow p t v profile path width up)
(with-primitive p 0
(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 (* seg-len 2)) end)))
(pdata-set! "p" i (pdata-ref "p" (+ seg-len start)))))
(recalc-normals 0)
v)))
(define (build-circle-profile n r)
(define (_ n c l)
(cond ((zero? c) l)
(else
(let ((a (* (/ c n) (* 2 3.141))))
(_ n (- c 1)
(cons (vmul (vector (sin a) (cos a) 0) r) l))))))
(_ n n '()))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(define ribbon-twig-view%
@ -962,7 +793,6 @@
(profile '())
(path '())
(root 0)
(v (vector 0 0 0))
(grow-speed default-grow-speed)
(anim-t 0)
(widths '()))
@ -970,10 +800,16 @@
(define/override (build)
(set! profile (build-circle-profile 7 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! widths (build-list num-points (lambda (n) (let ((t (/ n num-points)))
(if (eq? n (- num-points 1)) 0
(* radius
(if (zero? t) 1
(+ (* t 0.5)
(* (- (/ 1 t) 1) 0.1)))))))))
(set! root (let ((p (with-state
(backfacecull 1)
(backfacecull 0)
;(hint-none)
;(hint-wire)
(translate pos)
(texture (load-texture "textures/skin.png"))
(opacity 0.6)
@ -995,16 +831,16 @@
(else (cons (car l) (list-set (cdr l) (- c 1) s)))))
(define/augment (grow point)
(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! anim-t 0)
(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-grow root (+ (- index 1) anim-t)
v profile path widths (vector 1 0 0))))
(with-primitive root
(partial-extrude (+ (- index 1) anim-t)
profile path widths (vector 1 0 0) 0.05)))
(set! anim-t (+ anim-t (* d grow-speed))))
(define/public (get-end-pos)
@ -1043,7 +879,10 @@
id)
(define/public (get-twig twig-id)
(cadr (assq twig-id twigs)))
(let ((l (assq twig-id twigs)))
(if l
(cadr (assq twig-id twigs))
#f)))
(define/public (add-branch-twig twig)
; attach to seed
@ -1144,18 +983,14 @@
(define game-view%
(class object%
(init-field
(controller #f))
(field
(plants '()) ; map of ids -> plants
(pickups '()) ; map of ids -> pickups
(player-plant-id #f)
(current-twig-id #f)
(camera-dist 1)
(env-root (with-state (scale 20) (build-locator)))
(root-camera-t 0)
(upper-env (with-state
#;(upper-env (with-state
(parent env-root)
(hint-depth-sort)
(colour 2)
@ -1163,7 +998,7 @@
(build-env-box "textures/top.png" "textures/bottom-trans.png"
"textures/left.png" "textures/right.png"
"textures/front.png" "textures/back.png")))
(lower-env (with-state
#;(lower-env (with-state
(parent env-root)
(hint-depth-sort)
(translate (vector 0 -0.22001 0))
@ -1196,20 +1031,13 @@
(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))
(define/public (add-plant plant player)
(set! plants (cons (list (send plant get-id) plant) plants))
(when player (set! player-plant-id (send plant get-id))))
(define/public (add-plant plant)
(set! plants (cons (list (send plant get-id) plant) plants)))
(define/public (get-plant plant-id)
(cadr (assq plant-id plants)))
(define/public (add-branch-twig plant-id twig)
(when (eq? plant-id player-plant-id)
(set! current-twig-id (send twig get-id))
(set! root-camera-t 0))
(send (get-plant plant-id) add-branch-twig twig))
(define/public (destroy-branch-twig plant-id twig-id)
@ -1219,9 +1047,6 @@
(send (get-plant plant-id) add-twig parent-twig-id point-index twig))
(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)))
(send (get-plant plant-id) grow-seed amount))
(define/public (get-pickup pickup-id)
@ -1249,21 +1074,6 @@
(send (cadr pickup) update t d))
pickups)
(if current-twig-id
(let ((twig (send (get-player) get-twig current-twig-id)))
(send controller set-pos (vadd (send twig get-end-pos)
(vmul (send twig get-dir) (* camera-dist -2))
(vcross (send twig get-dir) (vector 0 1 0)))))
(send controller set-pos (vector 0 0 0)))
(when (> root-camera-t root-camera-time)
;(set-camera-position (vector 0 0 (- camera-dist)))
(set! current-twig-id #f))
(set! root-camera-t (+ root-camera-t d))
(when debug-messages
(for-each
(lambda (msg)
@ -1272,15 +1082,15 @@
(for-each
(lambda (msg)
(cond
((eq? (send msg get-name) 'player-plant)
((eq? (send msg get-name) 'player-plant) ; not really any difference now
(add-plant (make-object plant-view%
(send msg get-data 'plant-id)
(send msg get-data 'pos)) #t))
(send msg get-data 'pos))))
((eq? (send msg get-name) 'new-plant)
(add-plant (make-object plant-view%
(send msg get-data 'plant-id)
(send msg get-data 'pos)) #f))
(send msg get-data 'pos))))
((eq? (send msg get-name) 'grow-seed)
(grow-seed (send msg get-data 'plant-id)
@ -1367,14 +1177,24 @@
(define controller%
(class object%
(init-field
(game-view #f))
(field
(fwd (vector 0 0 1))
(up (vector 0 1 0))
(pos (vector 0 0 0))
(mtx (mident))
(cam (build-locator))
(current-twig #f)
(current-twig-growing #f)
(current-point 0)
(tilt 0)
(yaw 0))
(yaw 0)
(player-plant #f))
(define/public (set-player-plant s)
(set! player-plant s))
(define/public (get-cam-obj)
cam)
@ -1395,6 +1215,13 @@
(set-camera-transform (mtranslate (vector 0 0 -1))))
(define/public (update)
(when (key-pressed-this-frame " ")
(set! current-twig (make-object twig-logic% 0 player-plant 'root
(vmul fwd -1)
start-twig-width max-twig-points 'extruded))
(send player-plant add-twig current-twig)
(set! current-twig-growing #t))
(when (or (key-pressed "a") (key-special-pressed 100)) (set! yaw (+ yaw 1)))
(when (or (key-pressed "d") (key-special-pressed 102)) (set! yaw (- yaw 1)))
(when (or (key-pressed "w") (key-special-pressed 101)) (set! tilt (+ tilt 1)))
@ -1404,10 +1231,47 @@
(when (> tilt 88) (set! tilt 88))
(when (< tilt -88) (set! tilt -88))
(set! fwd (vtransform (vector 0 0 1)
(mmul
(when (key-pressed-this-frame "q")
(cond ((not current-twig)
(set! current-twig (send player-plant get-twig-from-dir (vmul fwd 1)))
(set! current-point 2))
(else
(when (< current-point (- (send current-twig get-num-points) 1))
(set! current-point (+ current-point 1))))))
(when (key-pressed-this-frame "z")
(cond (current-twig
(set! current-point (- current-point 1))
(when (< current-point 2)
(set! current-twig #f)
(set! pos (vector 0 0 0))
(set-camera-transform (mtranslate (vector 0 0 -1)))))))
; if we are on a twig not growing
(cond ((and current-twig (not current-twig-growing))
(set! pos (send current-twig get-point current-point))
(when (> current-point 0)
(set! fwd (vnormalise (vsub (send current-twig get-point (- current-point 1))
pos)))))
(else
(when current-twig-growing
(set-camera-transform (mtranslate (vector 0 0 0)))
(let ((twig-view (send (send game-view get-plant (send player-plant get-id))
get-twig (send current-twig get-id))))
(when twig-view
(set! pos (vsub (send twig-view get-end-pos)
(vmul (send current-twig get-dir) 5)))))
(when (eq? (send current-twig get-num-points)
(send current-twig get-length))
(set! current-twig-growing #f)
(set! current-twig #f)))
; get camera fwd vector from key-presses
(set! fwd (vtransform (vector 0 0 1)
(mmul
(mrotate (vector 0 yaw 0))
(mrotate (vector tilt 0 0)))))
(mrotate (vector tilt 0 0)))))))
(let* ((side (vnormalise (vcross up fwd)))
(up (vnormalise (vcross fwd side))))
@ -1424,9 +1288,9 @@
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(clear)
(define c (make-object controller%))
(define gl (make-object game-logic%))
(define gv (make-object game-view% c))
(define gv (make-object game-view%))
(define c (make-object controller% gv))
(send c setup)
(send gv setup)
@ -1435,14 +1299,14 @@
(define plant1 (make-object plant-logic% "dave@fo.am" (vector 0 0 0)))
(define plant2 (make-object plant-logic% "plant00001@fo.am" (vector 0 0 9)))
(send gl add-player plant1)
(send c set-player-plant plant1)
(send gl add-plant plant1)
(send gl add-plant plant2)
(send plant2 add-twig (make-object twig-logic% 0 plant2 'root (vector 0 -1 0) start-twig-width 10 'ribbon))
(define tick-time 0)
(define debounce #t)
(define debounce-time 0)
(define pt 0)
(define pd 0.02)
@ -1451,21 +1315,11 @@
(define (pt-update) (set! pt (+ pt pd)))
(define (animate)
(when (and debounce (key-pressed " "))
(send plant1 add-twig (make-object twig-logic% 0 plant1 'root
(vmul (send c get-fwd) -1)
start-twig-width max-twig-points 'extruded))
(set! tick-time 0)
(set! debounce #f)
(set! debounce-time (+ (pe-time) 0.2)))
(when (> (pe-time) debounce-time)
(set! debounce #t))
(when (< tick-time (pe-time))
(set! tick-time (+ (pe-time) logic-tick))
(send plant1 grow)
(send plant2 grow)
(send plant1 grow (vmul (send c get-fwd) -1))
(send plant2 grow (vector 0 -1 0))
(send gv update (pe-time) (pe-delta) (send gl update)))
(send gv update (pe-time) (pe-delta) '())