twig recycling and scaling works

plant-eyes/plant-eyes.scm

@@ -1,5 +1,5 @@
-;#lang scheme/base
-;(require fluxus-016/drflux)
+#lang scheme/base
+(require fluxus-016/drflux)
 (require scheme/class)
 
 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -40,6 +40,7 @@
 (define branch-jitter 1)
 (define max-twig-points 40)
 (define start-twig-width 0.1)
+(define default-max-twigs 5)
 
 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 ; a message for sending betwixt logic and render side
@@ -110,7 +111,8 @@
      (points '())     ; the 3d points for this twig
      (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)))     
+     (last-point (vector 0 0 0))
+     (dist 1))             ; distance between points     
     
     (inherit send-message)
     
@@ -138,11 +140,16 @@
     (define/public (get-point point-index)
       (list-ref points point-index))
     
+    (define/public (scale a)
+      (set! width (* width a))
+      (set! dist (* dist a))
+      (printf "~a~n" dist))
+    
     (define/public (grow)
       (when (< (length points) num-points)
         (let ((new-point (if (zero? (length points))
                              (vector 0 0 0) ; first point should be at the origin
-                             (vadd last-point dir (vmul (srndvec) twig-jitter)))))
+                             (vadd last-point (vmul dir dist) (vmul (srndvec) twig-jitter)))))
           (set! last-point new-point)
           (set! points (append points (list new-point)))
           (send-message 'twig-grow (list 
@@ -276,9 +283,10 @@
     
     (field
      (twigs '())     ; a assoc list map of ages to twigs
-     (age 0)         ; the age of this plant
-     (max-twigs 10) ; the maximum twigs allowed at any time - oldest removed first
-     (next-twig-id 0))
+     (size 1)         ; the age of this plant
+     (max-twigs default-max-twigs) ; the maximum twigs allowed at any time - oldest removed first
+     (next-twig-id 0)
+     (grow-amount 1.1))
     
     (inherit send-message)
     
@@ -327,6 +335,12 @@
     
     (define/public (add-twig twig)
       (send twig set-id! (get-next-twig-id))
+      (set! size (* size grow-amount))
+      (send twig scale size)     
+
+      (send-message 'grow-seed (list 
+                                (list 'pland-id id)
+                                (list 'amount grow-amount)))
       (send-message 'new-branch-twig (list 
                                (list 'plant-id id)
                                (list 'twig-id (send twig get-id))
@@ -336,6 +350,7 @@
                                (list 'num-points (send twig get-num-points))             
                                (list 'render-type (send twig get-render-type))
                                ))
+      
       (set! twigs (cons-twig twig twigs max-twigs '())))
    
     (define/augment (update)
@@ -573,8 +588,14 @@
       (define/public (set-pos! s)
         (set! pos s))
       
+      (define/public (get-child-twig-ids)
+        child-twig-ids)
+      
       (define/public (get-root)
         (error "need to overide this"))
+      
+      (define/public (destroy-twig)
+        (destroy (get-root)))
 
       (define/public (set-parent-twig-id s)
         (set! parent-twig-id s))
@@ -741,6 +762,22 @@
         (send twig build)
         (set! twigs (cons (list (send twig get-id) twig) twigs)))
 
+      (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/public (destroy-branch-twig twig-id)
+        (for-each
+         (lambda (twig-id)
+           (destroy-branch-twig twig-id))
+         (send (get-twig twig-id) get-child-twig-ids))
+        (send (get-twig twig-id) destroy-twig)
+        (set! twigs (assoc-remove twig-id twigs)))
+      
       (define/public (add-twig parent-twig-id point-index twig)     
         (let ((ptwig (get-twig parent-twig-id)))
           ; attach to parent twig       
@@ -877,6 +914,9 @@
         (set! current-twig-id (send twig get-id)))
       (send (get-plant plant-id) add-branch-twig twig))
     
+    (define/public (destroy-branch-twig plant-id twig-id)
+      (send (get-plant plant-id) destroy-branch-twig twig-id))
+    
     (define/public (add-twig plant-id parent-twig-id point-index twig)
       (send (get-plant plant-id) add-twig parent-twig-id point-index twig))
     
@@ -910,7 +950,10 @@
            ((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)) #f))    
+           
+           ((eq? (send msg get-name) 'destroy-branch-twig)
+            (destroy-branch-twig (send msg get-data 'plant-id) (send msg get-data 'twig-id)))
            
            ((eq? (send msg get-name) 'new-branch-twig)
             (add-branch-twig (send msg get-data 'plant-id) 
@@ -999,17 +1042,17 @@
                         (vtransform-rot (vector 0 0 -1) (minverse (get-camera-transform))) 
                         start-twig-width 20 'extruded))
     (set! debounce #f)
-    (set! debounce-time (+ (time) 0.2)))
+    (set! debounce-time (+ (flxtime) 0.2)))
             
-  (when (> (time) debounce-time)
+  (when (> (flxtime) debounce-time)
     (set! debounce #t)) 
     
-  (when (< tick-time (time))
-    (set! tick-time (+ (time) tick))
+  (when (< tick-time (flxtime))
+    (set! tick-time (+ (flxtime) tick))
     (send plant1 grow)
     (send plant2 grow)
-    (send gv update (time) (delta) (send gl update)))
+    (send gv update (flxtime) (delta) (send gl update)))
 
-  (send gv update (time) (delta) '()))
+  (send gv update (flxtime) (delta) '()))
 
 (every-frame (animate))