added ambient particles and started work on the logic stuff

plant-eyes/README

@@ -0,0 +1,2 @@
+i've split off the logic code while I work on it - it will eventually replace
+plant-eyes.scm

plant-eyes/plant-eyes-logic.scm

@@ -0,0 +1,253 @@
+#lang scheme/base
+(require fluxus-016/drflux)
+(require scheme/class)
+
+;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+; p l a n t   e y e s   
+;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+; notes:
+; keeping with a view/model client/server render/logic separation, although
+; not sure if it's the right approach yet
+
+; logic side gets ticked at a low frequency
+; render side gets ticked at framerate
+
+;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+; 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 
+     (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
+    
+    (define/public (get-data arg-name)
+      (cadr (assoc arg-name data)))
+    
+    (super-new)))
+
+;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+; the base class logic object - all logic side objects can 
+; send messages to the render side at any time by calling add-message
+; this takes care of the propagation of information. (not just oo fetish, I hope)
+(define game-logic-object%
+  (class object%
+    (field
+     (messages '())
+     (children '()))
+    
+    (define/public (send-message msg)
+      (set! messages (cons msg messages)))
+        
+    (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
+          m)))
+    
+    (super-new)))
+
+;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+; a twig, which can contain other twigs things.
+; (roots and shoots are both twigs)
+(define twig-logic%
+  (class game-logic-object%
+    (init-field
+     (id #f)               ; our id (for matching up with the renderer geometry)
+     (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
+    
+    (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
+
+    (inherit send-message)
+    
+    (define/public (get-type)
+      type)
+    
+    (define/public (get-dir)
+      dir)
+    
+    (define/public (get-point point-index)
+      (list-ref points point-index))
+    
+    (define/public (add-twig point-index twig)
+      (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 (make-object message% 'new-ornament 
+                     (list 
+                      (send plant get-id)
+                      id
+                      point-index)))
+      (set! ornaments (cons (list point-index ornament) ornaments)))
+    
+    (define/public (get-ornament point-index)
+      (cadr (assq point-index ornaments)))
+    
+    ; adds the ornament if it's close, and checks sub-twigs
+    ; returns true if it's succeded
+    (define/public (check/add-ornament pickup) 
+      ; check each point in our twig
+      (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))))
+                             (add-ornament (send pickup create-ornament plant))
+                             #t)
+                            (else #f)))
+                    #f
+                    points)))
+        ; now check each sub-twig
+        (if (not found)
+          (foldl
+           (lambda (twig found) 
+             (if (not found) 
+                 (send twig check/add-ornament)
+                 #f))
+           #f
+           twigs)
+          found)))
+      
+    (define/augment (update)
+      (append
+       (map
+        (lambda (ornament)
+          (send ornament update))
+        ornaments)
+       (map
+        (lambda (twig)
+          (send twig update))
+        twigs)))
+        
+    (super-new)))
+
+;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+; abilities live on twigs, and can do things. 
+; this is the base class for all abilities.
+(define ornament-logic%
+  (class game-logic-object%
+    (init-field
+     (plant #f)        ; the plant we belong to
+     (twig #f)         ; the twig we are on
+     (point-index -1)) ; the index to the point on our twig
+  
+    (field
+     (pos (send twig get-point point-index))) ; figure out the position here
+    
+    (define/public (get-pos)
+      pos)
+    
+    (super-new)))
+
+;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+; pickups map to abilities, and live out in space
+; this is the base class for all pickups.
+(define pickup-logic%
+  (class game-logic-object%
+    (field
+     (type 'none)
+     (pos (vector 0 0 0)))
+    
+    (define/public (get-pos)
+      pos)
+    
+    ; converts pickup->ormament
+    ; override this 
+    (define/public (create-ornament plant) 
+      (make-object ornament-logic% plant)) ; todo twig/point-index???
+    
+    (super-new)))
+
+;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+(define plant-logic%
+  (class game-logic-object%
+    (init-field
+     (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
+    
+    (define/public (check/add-ornament pickup) 
+      (foldl
+       (lambda (twig found)
+         (if (not found)
+             (send twig check/add-ornament pickup)
+             #f))
+       #f
+       twigs))
+    
+    (define/public (destroy-twig twig)
+      0)
+
+    ; a util to keep a fixed size list of twigs, calling destroy twig when needed.
+    (define (cons-twig thing in count out)
+      (cond 
+        ((null? in) 
+         (cons thing out))
+        ((zero? count)
+         (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)
+      (set! twigs (cons-twig twig twigs max-twigs '())))
+   
+    (define/augment (update)
+       (map
+        (lambda (twig)
+          (send twig update))
+        twigs))
+    
+    (super-new)))
+
+;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+     
+(define game-logic%
+  (class game-logic-object%
+    (field
+     (plants '())
+     (pickups '()))
+   
+    (define/public (add-plant plant)
+      (set! plants (cons plant plants)))
+
+    (define/public (add-pickups pickup)
+      (set! pickups (cons pickup pickups)))
+
+    ; todo - distribute the checking of stuff like
+    ; this to a random selection of pickups/plants
+    ; to distribute the cpu load
+    (define/augment (update)
+      (for-each
+       (lambda (pickup)
+         (for-each 
+          (lambda (plant)
+            (send plant check/add-ormament pickup))
+          plants))
+       pickups)      
+       (map
+        (lambda (plant)
+          (send plant update))
+        plants))
+    
+    (super-new)))
+
+    
+;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  
+  

plant-eyes/plant-eyes.scm

@@ -1,49 +1,54 @@
+#lang scheme/base
+(require fluxus-016/drflux)
 (require scheme/class)
   
-(clear)
 
-(define (build-ring n sr er)
+  ;=====================================================================
+  
+  (clear)
+  
+  (define (build-ring n sr er)
     (let ((p (build-polygons (+ (* n 2) 2) 'triangle-strip)))
-        (with-primitive p
+      (with-primitive p
-            (pdata-index-map!
+                      (pdata-index-map!
-                (lambda (i p)
+                       (lambda (i p)
-                    (let ((a (* (/ (quotient i 2) n) (* 2 3.141)))
+                         (let ((a (* (/ (quotient i 2) n) (* 2 3.141)))
-                            (s (* (if (odd? i) sr er) 5))) 
+                               (s (* (if (odd? i) sr er) 5))) 
-                        (vector (* (cos a) s) (* (sin a) s) (if (odd? i) 0 5 ))))
+                           (vector (* (cos a) s) (* (sin a) s) (if (odd? i) 0 5 ))))
-                "p")
+                       "p")
                       
-            (recalc-normals 1))
+                      (recalc-normals 1))
-        p))
+      p))
   
-(define camera (build-locator))
+  (define camera (build-locator))
   
-(define twig%
+  (define twig%
     (class object%
-        (init-field
+      (init-field
-            (size 100)
+       (size 100)
-            (radius 1)
+       (radius 1)
-            (speed 0.2))
+       (speed 0.2))
-        (field
+      (field
-            (root (build-locator))
+       (root (build-locator))
-            (child-twigs '())
+       (child-twigs '())
-            (age 0)
+       (age 0)
-            (tx (mident))  
+       (tx (mident))  
-            (next-ring-time 0))
+       (next-ring-time 0))
       
-        (define/public (build pos dir)
+      (define/public (build pos dir)
-            (with-primitive root
+        (with-primitive root
-                (translate pos)
+                        (translate pos)
-                (cond (dir  
+                        (cond (dir  
-                        (concat (maim dir (vector 0 0 1)))       
+                               (concat (maim dir (vector 0 0 1)))       
-                        (rotate (vector 0 -90 0)))
+                               (rotate (vector 0 -90 0)))
-                    (else (rotate (vmul (crndvec) 20))))))
+                              (else (rotate (vmul (crndvec) 20))))))
       
-        (define/public (update t)
+      (define/public (update t)
         
-            (for-each 
+        (for-each 
-                (lambda (child)
+         (lambda (child)
-                    (send child update t))
+           (send child update t))
-                child-twigs)
+         child-twigs)
         
             (when (and (< age size) (< next-ring-time t))
                 (set! next-ring-time (+ t speed))
@@ -123,7 +128,21 @@
     (class object%
         (field 
             (twigs '())
-            (pickups (build-list 10 (lambda (_) 
+            (nutrients (let ((p (with-state
+                            (hint-depth-sort)
+                            (texture (load-texture "textures/particle.png"))
+                            (build-particles 5000))))
+                        (with-primitive p
+                            (pdata-map! 
+                                (lambda (p)
+                                    (vmul (vadd (crndvec) (vector 0 -1 0)) 90))
+                                "p")
+                            (pdata-map! 
+                                (lambda (s)
+                                    (vector 1 1 1))
+                                "s"))
+                        p))
+            (pickups (build-list 1 (lambda (_) 
                         (make-object pickup% (vmul (vsub (crndvec) (vector 0 1 0)) 50)))))
             (indicator (let ((p (with-state    
                                 (hint-depth-sort)