logical growth works, added a view side with ribbon roots for preview

plant-eyes/plant-eyes-logic.scm

@@ -9,25 +9,38 @@
 ; notes:
 ;
 ; * keeping with a render/logic separation, although this is quite different to 
-;   the hexagon game. the main advantage is that the logic can be ticked at a 
+;   the hexagon game. the main advantages:
-;   lower frequency - or even different parts at different rates, whereas the 
+;     - just a divide and conquer strategy for staying sane 
-;   renderer side needs ticking every frame
+;     - able to debug the logic without the renderer, or vice versa
+;     - the logic can be ticked at a lower frequency - or even different 
+;       parts at different rates, whereas the renderer side needs ticking every 
+;       frame
 ;
-; * need to try to keep all the intensive every thing vs every thing checking 
+; * the view just knows about line segments for branches/roots, so these can be
+;   created in any way in the logic side - lsystem, etc - or different ways
+;
+; * need to try to keep all the intensive 'every thing vs every thing' checking 
 ;   in the logic side, where it can be done over many frames (i'm thinking the
 ;   lags involved with things like nutrients getting absorbed may not matter 
 ;   too much in this game)
 ;
 ; * using a message passing system to formalise the passing of information on 
 ;   the logic side. this makes it possible to have objects sending messages
-;   at any point, and have them collected up and dispached in the renderer side
+;   at any point, and have them automatically collected up and dispatched to 
+;   the renderer side
 ;
 ; * line segments are computed in the logic side, and can be represented any
 ;   way by the renderer - maybe the players plant will be geometry and everyone
 ;   elses will be ribbons (stoopid LOD)
 
-(define branch-probability 10) ; as in, one in 10
+(define debug-messages #f) ; prints out all the messages sent to the renderer
-(define branch-width-reduction 0.95)
+
+(define branch-probability 3) ; as in one in branch-probability chance
+(define branch-width-reduction 0.5)
+(define twig-jitter 0.5)
+(define branch-jitter 1)
+(define max-twig-points 10)
+(define start-twig-width 0.1)
 
 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 ; a message for sending betwixt logic and render side
@@ -39,6 +52,9 @@
                   ; '((name "archibold") (age 53))
                   ; shouldn't put logic objects in here - 'raw' data only
     
+    (define/public (get-name)
+      name)
+    
     (define/public (get-data arg-name)
       (cadr (assoc arg-name data)))
     
@@ -72,8 +88,8 @@
       (let ((m messages))    ; and call update on them too.
         (set! messages '())        
          (append
-          (flatten (inner (void) update)) ; the augmented method gets called here
+          m
-          m)))
+          (flatten (inner (void) update))))) ; the augmented method gets called here
     
     (super-new)))
 
@@ -87,12 +103,14 @@
      (plant #f)            ; the plant we belong to
      (type 'root)          ; or 'shoot
      (dir (vector 0 1 0))  ; the general direction we are pointing in
-     (width 1))            ; the width of this root
+     (width 0)            ; the width of this root
+     (num-points max-twig-points)) ; number of points in this twig
     
     (field
      (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
+     (ornaments '())  ; the things attached to this twig, an assoc list with point index
+     (last-point (vector 0 0 0)))     
     
     (inherit send-message)
     
@@ -108,21 +126,34 @@
     (define/public (get-dir)
       dir)
     
+    (define/public (get-width)
+      width)
+    
+    (define/public (get-num-points)
+      num-points)
+    
     (define/public (get-point point-index)
       (list-ref points point-index))
     
     (define/public (grow)
-      (let ((new-point (vector 0 0 0))) ; todo: grow along dir
+      (when (< (length points) num-points)
-        (set! points (append points (list new-point))) ; 
+        (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)))))
+          (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 (zero? (random branch-probability))
+        (when (and (> num-points 1) (zero? (random branch-probability)))
-        (add-twig (- (length twigs) 1) 
+          (add-twig (- (length points) 1) 
-                  (make-object twig-logic% (send plant get-next-twig-id) plant type dir 
+                    (make-object twig-logic% (send plant get-next-twig-id) 
-                    ; todo dir+rnd
+                      plant 
-                    (* width branch-width-reduction))))
+                      type 
+                      (vadd dir (vmul (srndvec) branch-jitter))
+                      (* width branch-width-reduction)
+                      (quotient num-points 2)))))
       (for-each
        (lambda (twig)
          (send (cadr twig) grow))
@@ -131,15 +162,20 @@
     (define/public (add-twig point-index twig)
       (send-message 'new-twig (list 
                                (list 'plant-id (send plant get-id))
-                               (list 'twig-id id)
+                               (list 'parent-twig-id id)
-                               (list 'point-index point-index)))
+                               (list 'point-index point-index)
+                               (list 'twig-id (send twig get-id))
+                               (list 'type (send twig get-type))
+                               (list 'dir (send twig get-dir))
+                               (list 'width (send twig get-width))
+                               (list 'num-points (send twig get-num-points))
+                               ))
       (set! twigs (cons (list point-index twig) twigs)))
     
     (define/public (get-twig point-index)
       (cadr (assq point-index twigs)))
     
     (define/public (add-ornament point-index ornament)
-      ; tell the renderer something has occurred
       (send-message 'new-ornament 
                      (list 
                       (send plant get-id)
@@ -157,7 +193,8 @@
       (let ((found (foldl
                     (lambda (point found)
                       ; if we havent found anything yet and it's intersecting
-                      (cond ((and (not found) (< (vdist point (send pickup get-pos)) (+ width (send pickup get-size))))
+                      (cond ((and (not found) (< (vdist point (send pickup get-pos)) 
+                                                 (+ width (send pickup get-size))))
                              (add-ornament (send pickup create-ornament plant))
                              #t)
                             (else #f)))
@@ -243,6 +280,9 @@
     (define/public (get-id)
       id)
 
+    (define/public (get-pos)
+      pos)
+
     (define/public (grow)
       (for-each
        (lambda (twig)
@@ -265,7 +305,10 @@
        twigs))
     
     (define/public (destroy-twig twig)
-      0)
+      (send-message 'destroy-branch-twig (list
+                                   (list 'plant-id id)
+                                   (list 'twig-id (send twig get-id))
+                                   )))
 
     ; a util to keep a fixed size list of twigs, calling destroy twig when needed.
     (define (cons-twig thing in count out)
@@ -279,9 +322,13 @@
     
     (define/public (add-twig twig)
       (send twig set-id! (get-next-twig-id))
-      (send-message 'new-root-twig (list 
+      (send-message 'new-branch-twig (list 
                                (list 'plant-id id)
-                               (list 'twig-id (send twig get-id))))
+                               (list 'twig-id (send twig get-id))
+                               (list 'type (send twig get-type))
+                               (list 'dir (send twig get-dir))
+                               (list 'width (send twig get-width))
+                               (list 'num-points (send twig get-num-points))))
       (set! twigs (cons-twig twig twigs max-twigs '())))
    
     (define/augment (update)
@@ -294,6 +341,8 @@
 
 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
+
+
 (define game-logic%
   (class game-logic-object%
     (field
@@ -303,7 +352,9 @@
     (inherit send-message)
     
     (define/public (add-plant plant)
-      (send-message 'new-plant '("hello"))
+      (send-message 'new-plant (list
+                                (list 'plant-id (send plant get-id))
+                                (list 'pos (send plant get-pos))))
       (set! plants (cons plant plants)))
 
     (define/public (add-pickups pickup)
@@ -327,25 +378,227 @@
     
     (super-new)))
 
-(define (run)
+;==============================================================================
-  (let ((l (send game update)))
+;==============================================================================
-    (for-each
+
-     (lambda (m)
+(define twig-view%
-       (send m print))
+    (class object%
-     l)))
+      (init-field
+       (id 0)
+       (pos (vector 0 0 0))
+       (type 'none)
+       (dir (vector 0 1 0))
+       (radius 1)
+       (num-points 0)) 
+      
+      (field
+       (root (let ((p (with-state
+                       (translate pos)
+                       (hint-unlit)
+                       ;(concat (maim dir (vector 0 0 1)))
+                       (build-ribbon num-points))))
+               (with-primitive p
+                               (pdata-map! 
+                                (lambda (w)
+                                  0)
+                                "w")
+                               (pdata-set! "w" 0 radius))
+               p))
+       (index 0)
+       (parent-twig-id -1)
+       (child-twig-ids '()))
+      
+      (define/public (get-id)
+        id)
+      
+      (define/public (get-root)
+        root)
+
+      (define/public (set-parent-twig-id s)
+        (set! parent-twig-id s))
+      
+      (define/public (get-point point-index)
+        (with-primitive root
+                        (pdata-ref "p" point-index)))
+      
+      (define/public (add-child-twig-id twig-id)
+        (set! child-twig-ids (cons twig-id child-twig-ids)))
+      
+      (define/public (grow point)
+        (with-primitive root
+                        (pdata-index-map! ; set all the remaining points to the end
+                         (lambda (i p)    ; in order to hide them
+                           (if (< i index)
+                               p
+                               point))
+                         "p")
+                        (pdata-index-map! ; do a similar thing with the width
+                         (lambda (i w)    
+                           (if (< i (+ index 1))
+                               w
+                               radius))
+                         "w"))
+        (set! index (+ index 1)))
+        
+      (super-new)))
 
 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
-(define game (make-object game-logic%))
+(define plant-view%
+    (class object%
+      
+      (init-field
+       (id "none")
+       (pos (vector 0 0 0)))
+       
+       (field 
+        (twigs '()) ; a assoc list map between ids and twigs stored flat here,       
+                    ; for fast access, but prims heirachically in the scenegraph
+        (root (with-state 
+               (translate pos)
+               (build-locator)))
+        (seed (with-state
+               (parent root)
+               (texture (load-texture "textures/skin.png"))
+               (backfacecull 0)
+               (opacity 0.6)
+               (colour (vector 0.8 1 0.6))
+               (hint-depth-sort)
+               (hint-unlit)
+               (load-primitive "meshes/seed.obj"))))
+        
+      (define/public (get-id)
+        id)
+      
+      (define/public (get-twig twig-id)
+        (cadr (assq twig-id twigs)))
+
+      (define/public (add-branch-twig twig)     
+        ; attach to seed
+        (with-primitive (send twig get-root)
+                        (parent root))
+        (set! twigs (cons (list (send twig get-id) twig) twigs)))
+
+      (define/public (add-twig parent-twig-id point-index twig)     
+        (let ((ptwig (get-twig parent-twig-id)))
+          ; attach to parent twig       
+          (with-primitive (send twig get-root)
+                          (parent (send ptwig get-root))
+                          (translate (send ptwig get-point point-index)))
+          
+          ; tell the twigs about this relationship (might turn out to be overkill)
+          (send ptwig add-child-twig-id (send twig get-id))
+          (send twig set-parent-twig-id parent-twig-id)
+          
+          (set! twigs (cons (list (send twig get-id) twig) twigs))))      
+      
+      (define/public (grow-twig twig-id point)
+        (send (get-twig twig-id) grow point))      
+      
+      (define/public (update t)
+        
+        (with-primitive root
+                        (scale (+ 1 (* 0.001 (sin (* 2 t))))))                       
+            
+        (for-each 
+         (lambda (twig)
+           (send twig update t))
+         twigs))
+        
+      (super-new)))
+
+;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+(define game-view%
+  (class object%
+    (field
+     (plants '())) ; map of ids -> plants
+    
+    (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)
+      (send (get-plant plant-id) add-branch-twig twig))
+    
+    (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))
+    
+    (define/public (update messages)      
+      (when debug-messages
+        (for-each
+         (lambda (msg)
+           (send msg print))
+         messages))      
+      (for-each
+       (lambda (msg)
+         (cond
+           
+           ((eq? (send msg get-name) 'new-plant)
+            (add-plant (make-object plant-view% 
+                         (send msg get-data 'plant-id) 
+                         (send msg get-data 'pos))))
+           
+           ((eq? (send msg get-name) 'new-branch-twig)
+            (add-branch-twig (send msg get-data 'plant-id) 
+                             (make-object twig-view%                               
+                               (send msg get-data 'twig-id)
+                               (vector 0 0 0)
+                               (send msg get-data 'type)                               
+                               (send msg get-data 'dir)
+                               (send msg get-data 'width)
+                               (send msg get-data 'num-points))))
+           
+           ((eq? (send msg get-name) 'new-twig)
+            (add-twig (send msg get-data 'plant-id)
+                      (send msg get-data 'parent-twig-id)
+                      (send msg get-data 'point-index)
+                      (make-object twig-view%                               
+                        (send msg get-data 'twig-id)
+                        (vector 0 0 0) ; will be filled in by add-twig
+                        (send msg get-data 'type)                               
+                        (send msg get-data 'dir)
+                        (send msg get-data 'width)
+                        (send msg get-data 'num-points))))
+           
+           ((eq? (send msg get-name) 'twig-grow)
+            (send (get-plant (send msg get-data 'plant-id)) grow-twig
+                  (send msg get-data 'twig-id)
+                  (send msg get-data 'point)))
+           
+           ))
+       messages))
+
+    (super-new)))
+
+;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+    
+(clear)
+(define gl (make-object game-logic%))
+(define gv (make-object game-view%))
  
 (define plant1 (make-object plant-logic% "dave@fo.am" (vector 0 0 0)))
-(define plant2 (make-object plant-logic% "plant00001@fo.am" (vector 0 1 0)))
+(define plant2 (make-object plant-logic% "plant00001@fo.am" (vector 6 0 0)))
 
-(send game add-plant plant1)
+(send gl add-plant plant1)
-(send game add-plant plant2)
+(send gl add-plant plant2)
-(run)
+
-(send plant1 add-twig (make-object twig-logic% 0 plant1 (vector 0 1 0) 1))
+(send plant2 add-twig (make-object twig-logic% 0 plant2 'root (vector 0 -1 0) start-twig-width))
-(run)
+
-(for ((i (in-range 0 50)))
+(define t 0)
-     (send plant1 grow)
+(define tick-time 0)
-     (run))
+(define tick 0.5)
+
+(define (animate)
+  (when (< tick-time t)
+    (set! tick-time (+ t tick))
+    (send plant2 grow)
+    (send gv update (send gl update)))
+  (set! t (+ t 0.02)))
+
+#;(for ((i (in-range 0 100)))
+     (animate))
+
+(every-frame (animate))

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)