more plant eyes logic foo

plant-eyes/plant-eyes-logic.scm

@@ -7,18 +7,34 @@
 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
 ; notes:
-; keeping with a view/model client/server render/logic separation, although
+;
-; not sure if it's the right approach yet
+; * 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 
+;   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 
+;   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
+;
+; * 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)
 
-; logic side gets ticked at a low frequency
+(define branch-probability 10) ; as in, one in 10
-; render side gets ticked at framerate
+(define branch-width-reduction 0.95)
 
 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 ; a message for sending betwixt logic and render side
 (define message%
   (class object%
     (init-field
-     (type 'none) ; a symbol denoting the type of the message 
+     (name 'none) ; a symbol denoting the type of the message 
      (data '()))  ; should be an assoc list map of name to values, eg:
                   ; '((name "archibold") (age 53))
                   ; shouldn't put logic objects in here - 'raw' data only
@@ -26,6 +42,9 @@
     (define/public (get-data arg-name)
       (cadr (assoc arg-name data)))
     
+    (define/public (print)
+      (printf "msg: ~a ~a~n" name data))
+    
     (super-new)))
 
 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -38,14 +57,22 @@
      (messages '())
      (children '()))
     
-    (define/public (send-message msg)
+    (define/public (send-message name data)
-      (set! messages (cons msg messages)))
+      (set! messages (cons (make-object message% name data) messages)))
         
+    ; convert a list of lists in to just a single list - needed to convert
+    ; the update lists into one big list of messages
+    (define (flatten l)
+      (cond
+        ((null? l) '())
+        ((list? (car l)) (append (flatten (car l)) (flatten (cdr l))))
+        (else (cons (car l) (flatten (cdr l))))))
+
     (define/pubment (update) ; need to augement this if we have child logic objects, 
       (let ((m messages))    ; and call update on them too.
         (set! messages '())        
          (append
-          (inner ('()) update) ; the augmented method gets called here
+          (flatten (inner (void) update)) ; the augmented method gets called here
           m)))
     
     (super-new)))
@@ -69,6 +96,12 @@
 
     (inherit send-message)
     
+    (define/public (get-id)
+      id)
+    
+    (define/public (set-id! s)
+      (set! id s))
+    
     (define/public (get-type)
       type)
     
@@ -78,7 +111,28 @@
     (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
+        (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))
+        (add-twig (- (length twigs) 1) 
+                  (make-object twig-logic% (send plant get-next-twig-id) plant type dir 
+                    ; todo dir+rnd
+                    (* width branch-width-reduction))))
+      (for-each
+       (lambda (twig)
+         (send (cadr twig) grow))
+       twigs))
+    
     (define/public (add-twig point-index twig)
+      (send-message 'new-twig (list 
+                               (list 'plant-id (send plant get-id))
+                               (list 'twig-id id)
+                               (list 'point-index point-index)))
       (set! twigs (cons (list point-index twig) twigs)))
     
     (define/public (get-twig point-index)
@@ -86,11 +140,11 @@
     
     (define/public (add-ornament point-index ornament)
       ; tell the renderer something has occurred
-      (send-message (make-object message% 'new-ornament 
+      (send-message 'new-ornament 
                      (list 
                       (send plant get-id)
                       id
-                      point-index)))
+                      point-index))
       (set! ornaments (cons (list point-index ornament) ornaments)))
     
     (define/public (get-ornament point-index)
@@ -128,7 +182,7 @@
         ornaments)
        (map
         (lambda (twig)
-          (send twig update))
+          (send (cadr twig) update))
         twigs)))
         
     (super-new)))
@@ -175,12 +229,31 @@
 (define plant-logic%
   (class game-logic-object%
     (init-field
+     (id #f)
      (pos (vector 0 0 0)))
     
     (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
+     (max-twigs 10) ; the maximum twigs allowed at any time - oldest removed first
+     (next-twig-id 0))
+    
+    (inherit send-message)
+    
+    (define/public (get-id)
+      id)
+
+    (define/public (grow)
+      (for-each
+       (lambda (twig)
+         (send twig grow))
+       twigs))
+    
+    ; we need to maintain our list of twig ids here, for this plant
+    (define/public (get-next-twig-id)
+      (let ((id next-twig-id))
+        (set! next-twig-id (+ next-twig-id 1))
+        next-twig-id))
     
     (define/public (check/add-ornament pickup) 
       (foldl
@@ -203,8 +276,12 @@
          (destroy-twig (car in))
          (cons thing out))
         (else (cons-twig thing (cdr in) (- count 1) (append out (list (car in)))))))
-      
+    
     (define/public (add-twig twig)
+      (send twig set-id! (get-next-twig-id))
+      (send-message 'new-root-twig (list 
+                               (list 'plant-id id)
+                               (list 'twig-id (send twig get-id))))
       (set! twigs (cons-twig twig twigs max-twigs '())))
    
     (define/augment (update)
@@ -216,14 +293,17 @@
     (super-new)))
 
 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-     
+
 (define game-logic%
   (class game-logic-object%
     (field
      (plants '())
      (pickups '()))
    
+    (inherit send-message)
+    
     (define/public (add-plant plant)
+      (send-message 'new-plant '("hello"))
       (set! plants (cons plant plants)))
 
     (define/public (add-pickups pickup)
@@ -247,7 +327,25 @@
     
     (super-new)))
 
-    
+(define (run)
+  (let ((l (send game update)))
+    (for-each
+     (lambda (m)
+       (send m print))
+     l)))
+
 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   
-  
+(define game (make-object game-logic%))
+
+(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)))
+
+(send game add-plant plant1)
+(send game add-plant plant2)
+(run)
+(send plant1 add-twig (make-object twig-logic% 0 plant1 (vector 0 1 0) 1))
+(run)
+(for ((i (in-range 0 50)))
+     (send plant1 grow)
+     (run))