networking fixes

plant-eyes/client.ss

@@ -18,8 +18,8 @@
        "plant0000001@fo.am" 
        "plant0000002@fo.am" 
        "plant0000003@fo.am"
-       ;"plant0000004@fo.am"
+       "plant0000004@fo.am"
-       ;"plant0000005@fo.am"
+       "plant0000005@fo.am"
        "dave@fo.am"
        ))
      (plants-present '())
@@ -56,6 +56,7 @@
                ; build a message from the xmpp message
                (let ((msg (make-object message%)))
                  (send msg from-string body)
+				 
                  (let ((name (send msg get-name)))
                    ; filter out the messages we need to respond to 
                    ; (and don't need sending to the rest of the game)
@@ -67,10 +68,12 @@
                       ; send out our plant description messages
                       (heir-send from (send game-logic serialise))
                       (fetch-messages l game-logic))
+					  
                      ((eq? name 'i-am-here)
                       (set! plants-present (cons (send msg get-data 'plant-id) plants-present))
                       (printf "received i-am-here ~a~n" plants-present)
                       (fetch-messages l game-logic)) ; todo: send plant to view
+					  
                      (else
                       (fetch-messages (cons msg l) game-logic)))))))))
     

plant-eyes/jabberer.ss

@@ -17,7 +17,7 @@
             (incoming '())
             (outgoing '())
             (thr 0)
-            (debug-jab #f))
+            (debug-jab #t))
         
         (define/public (get-incoming)
             incoming)

plant-eyes/logic.ss

@@ -404,7 +404,7 @@
       (set! size (* size grow-amount))
       (send twig scale size)  
       (set! leader-twig twig)
-      (send-message 'grow-seed (list 
+      #;(send-message 'grow-seed (list 
                                 (list 'plant-id id)
                                 (list 'amount grow-amount)))
       (send-message 'new-twig (send twig get-desc-list))      
@@ -434,7 +434,10 @@
       (append (list (make-object message% 'new-plant (list
 	                                  (list 'plant-id id)
                                 (list 'pos pos)
-                                              (list 'size size))))
+                                (list 'size size)
+                                (list 'col col)
+                                (list 'tex tex))))
+
               (append
                (map
                 (lambda (twig)

plant-eyes/message.ss

@@ -15,7 +15,8 @@
     name)  
   
   (define/public (get-data arg-name)
-    (cadr (assoc arg-name data)))
+    (let ((a (assoc arg-name data)))
+	  (if a (cadr a) (error "message arg not found " arg-name))))
   
   (define/public (print)
     (printf "msg: ~a ~a~n" name data))

plant-eyes/plant-eyes.scm

@@ -62,7 +62,8 @@
        (set! mode 'game)))
     ((eq? mode 'game) 
      (send game update (flxtime) (delta))))
-  #;(update-time))
+  #;(update-time)
+    (sleep 0.01))
     
 (every-frame (animate))
 

plant-eyes/view.ss

@@ -4,7 +4,7 @@
 
 ; the fluxus code to make things look the way they do
 
-(define debug-messages #f) ; prints out all the messages sent to the renderer
+(define debug-messages #t) ; prints out all the messages sent to the renderer
 (define audio-on #f)
 
 (define (ornament-colour) (vector 0.5 1 0.4))
@@ -522,6 +522,7 @@
      (parent p)
   (hint-unlit)  
   
+  (list
   (let ((t (with-state
         (texture (load-texture top))
         (translate (vector 0 0.5 0))
@@ -531,7 +532,8 @@
                       (pdata-map!
                        (lambda (t)
                          (vmul t 10))
-                       "t"))))
+                       "t"))
+					   ) t)
     
     (with-state
         (texture (load-texture left))
@@ -557,14 +559,12 @@
         (rotate (vector 0 90 0))
         (build-plane))
     
-    (when lower
+    (if lower
       (with-state
         (texture (load-texture bottom))
         (translate (vector 0 -0.5 0))
         (rotate (vector 90 0 0))        
-        (build-plane)))
+        (build-plane)) 0)))))
-                         
-    p)))
 
 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
@@ -642,7 +642,8 @@
       stones)
 	
     (define/public (add-plant plant)
-      (destroy-plant (send plant get-id)) ; just in case
+      (printf "ADD-PLANT~n")
+      ;(destroy-plant (send plant get-id)) ; just in case
       (set! plants (cons (list (send plant get-id) plant) plants)))
     
     (define/public (get-plant plant-id)
@@ -763,12 +764,16 @@
             (pick-up-pickup 
              (send msg get-data 'pickup-id)))
 
-           ((eq? (send msg get-name) 'new-ornament)
+           ((eq? (send msg get-name) 'pick-up-pickup)
-            (add-ornament 
+            (pick-up-pickup 
-             (send msg get-data 'plant-id)
+             (send msg get-data 'pickup-id)))
-             (send msg get-data 'twig-id)
+
-             (send msg get-data 'point-index)
+           ((eq? (send msg get-name) 'light-level)
-             (send msg get-data 'property)))            
+             (for-each 
+			  	(lambda (p)
+				  (with-primitive p
+				  	(colour (send msg get-data 'amount))))
+					upper-env))
                       
            ))
        messages))