steerable and navigatorable twigs

hex-ornament/hex-ornament.scm

@@ -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)
 
 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

plant-eyes/extrude.scm

@@ -1,5 +1,5 @@
-#lang scheme
+;#lang scheme
-(require fluxus-016/drflux)
+;(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)))))
+                            (mscale (vmul (vector (car width) (car width) (car width)) size))))
-                    (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)))
+            (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!
+    (pdata-index-map!
-   (lambda (i t)
+        (lambda (i t)
-     (vector (* vscale (/ (quotient i profile-size) path-size))
+            (vector (* vscale (/ (quotient i profile-size) path-size))
-             (/ (modulo i profile-size) profile-size) 0))
+                (/ (modulo i profile-size) profile-size) 0))
-   "t"))
+        "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)
+(define (partial-extrude t profile path width up grow)
-    (cond ((null? l) l)
+    (define (chop-front l n)
-        (else
+        (cond ((null? l) l)
-            (if (zero? n) (cons (car l) (chop-front (cdr l) n))
+            (else
-                (chop-front (cdr l) (- n 1))))))
+                (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)
+    (define (collapse-front)
-    (with-primitive p 0
+        (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))
+    (define (scale-front)
-               (t (- t T))
+        (when (> t 1)
-               (seg-len (length profile))
+            (let* ((start (* (floor t) (length profile)))
-               (start (* T seg-len))
+                    (from (list-ref path (- (inexact->exact (floor t)) 1)))
-               (end (* (length path) seg-len))
+                    (to (list-ref path (+ (inexact->exact (floor t)) 0))))
-               (v (extrude-segment start profile 
-                                   (chop-front path T)
-                                   (chop-front width T) v up)))
                 
-          (when (< T (- (length path) 1))
+                (for ((i (in-range start (+ start (length profile)))))
-            ; extrude the next segment
+                    (pdata-set! "p" i (vmix to from (- t (floor t))))))))
-            (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
+    (define (_ t v g)
-              (for ((i (in-range (+ start seg-len) 
+        (cond 
-                                 (+ start (* 2 seg-len)))))                   
+            ((< t 1) (with-primitive p (recalc-normals 0)) v)
-
+            (else
-                   (pdata-set! "p" i (vmix (pdata-ref "p" i)
+                (let ((start (* (floor t) (length profile))))
-                                      (pdata-ref "p" (- i seg-len))
+                    (_ (- t 1)
-                                           
+                        (extrude-segment start profile
-                                           t)))
+                            (chop-front path (floor t))
-                                      
+                            (chop-front width (floor t)) v up 
-
+                            (if (< g 1)
-                                          
+                                (+ g (* (- t (floor t)) grow))
-                ; collapse the yet un-extruded part into the last vert
+                                g))
-                (for ((i (in-range (+ start (* seg-len 2)) end)))
+                        (if (< g 1)
-                    (pdata-set! "p" i (pdata-ref "p" (+ seg-len start)))))
+                            (+ g grow)
-            
+                            1))))))
-            (recalc-normals 0)
+    (_ t (vector 0 0 0) 0)
-            v)))
+    (scale-front)
-
+    (collapse-front))
-(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)
@@ -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) 
+        (wire-colour 0)
-        (colour (vector 0 0.5 0.5))   
+;        (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")

plant-eyes/plant-eyes.scm

@@ -1,5 +1,5 @@
-;#lang scheme/base
+#lang scheme/base
-;(require fluxus-016/drflux)
+(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 max-twig-points 20)
-(define start-twig-width 0.2)
+(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)
+    (define/public (grow dir)      
-      (let ((curly (list-contains 'curly properties)))
         (for-each
          (lambda (twig)
-           (send twig grow curly))
+           (send twig grow dir))
-         twigs)))
+         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
+       (set! widths (build-list num-points (lambda (n) (let ((t (/ n num-points)))
-                                                           (* radius (- 1 (/ 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) 
+          (with-primitive root
-                                          v profile path widths (vector 1 0 0))))
+            (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)
+    (define/public (add-plant plant)
-      (get-plant player-plant-id))
+      (set! plants (cons (list (send plant get-id) plant) plants)))
-    
-    (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 (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) 
+      (when (key-pressed-this-frame "q")
-                           (mmul 
+        (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 plant1 grow (vmul (send c get-fwd) -1))
-    (send plant2 grow)
+    (send plant2 grow (vector 0 -1 0))
     (send gv update (pe-time) (pe-delta) (send gl update)))
 
   (send gv update (pe-time) (pe-delta) '())