first pass network working - for twig growth, duplicates the view changes ok

plant-eyes/jabberer.ss

@@ -6,7 +6,6 @@
 ; and sent by the game
 
 (define debug-netloop #f)
-(define debug-jab #f)
 
 (define jabberer%
     (class object%
@@ -35,15 +34,14 @@
                 msg))
         
         (define/public (send-msg to msg)
-            (set! outgoing (cons (list to msg) outgoing)))
+          (set! outgoing (append outgoing (list (list to msg))))
+          #;(printf "~a~n" outgoing))
         
         (define (message-handler sz)
             (when debug-jab (printf "rx <---- ~a ~a~n" (xmpp:message-from sz) (xmpp:message-body sz)))
             (set! incoming (cons (list (xmpp:message-from sz) (xmpp:message-body sz)) incoming)))
         
         (define/public (start)
-          (xmpp:add-to-roster jid "plant0000003@fo.am" "plant0000003" "plants@fo.am")
-          (xmpp:add-to-roster jid "plant0000001@fo.am" "plant0000001" "plants@fo.am")
           (set! thr (thread run)))
         
         (define/public (stop)

plant-eyes/list-utils.ss

@@ -20,3 +20,18 @@
     ((eq? (car l) k) #t)
     (else (list-contains k (cdr l)))))
 
+(define (string-split s c)
+  (define (_ sl tl cl)
+    (cond 
+      ((null? sl) (if (null? cl) tl (append tl (list (list->string cl)))))
+      ((eq? (car sl) c)
+       (_ (cdr sl) (append tl (list (list->string cl))) '()))
+      (else
+       (_ (cdr sl) tl (append cl (list (car sl)))))))
+  (_ (string->list s) '() '()))
+
+(define (list-string-concat l t)
+  (cond
+    ((null? l) "")
+    (else
+     (string-append (car l) t (list-string-concat (cdr l) t)))))

plant-eyes/message.ss

@@ -1,23 +1,69 @@
 #lang scheme/base
-(require scheme/class)
+(require scheme/class "list-utils.ss")
 (provide (all-defined-out))
 
 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 ; a message for sending betwixt logic and view side
 (define-serializable-class* message% object% ()
-    (init-field
+  (init-field
-     (name '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:
+   (data '()))  ; should be an assoc list map of name to values, eg:
-                  ; '((name "archibold") (age 53))
+  ; '((name "archibold") (age 53))
-                  ; shouldn't put logic objects in here - 'raw' data only
+  ; shouldn't put logic objects in here - 'raw' data only
   
-    (define/public (get-name)
+  (define/public (get-name)
-      name)  
+    name)  
   
-    (define/public (get-data arg-name)
+  (define/public (get-data arg-name)
-      (cadr (assoc arg-name data)))
+    (cadr (assoc arg-name data)))
   
-    (define/public (print)
+  (define/public (print)
-      (printf "msg: ~a ~a~n" name data))
+    (printf "msg: ~a ~a~n" name data))
+  
+  (define/public (to-string)
+    (string-append (symbol->string name) " " (nvpairs->string data "")))
+  
+  (define/public (from-string str)
+    (let ((tokens (string-split str #\ )))
+      (set! name (string->symbol (car tokens)))
+      (set! data (string->nvpairs (list-string-concat (cdr tokens) " ") '()))))
+  
+  (define (value->string a)
+    (cond
+      ((number? a) (string-append "n:" (number->string a)))
+      ((string? a) (string-append "s:" a))
+      ((vector? a) (string-append "v:" (number->string (vector-ref a 0)) ","
+                                  (number->string (vector-ref a 1)) ","
+                                  (number->string (vector-ref a 2))))
+      ((symbol? a) (string-append "y:" (symbol->string a)))
+      (else (error "unsupported arg type for " a))))
+  
+  (define (nvpairs->string l s)
+    (cond 
+      ((null? l) s)
+      (else
+       (nvpairs->string (cdr l) (string-append s (symbol->string (caar l)) "="
+                                               (value->string (cadr (car l))) " ")))))
+  
+  (define (string->value a)
+    (cond
+      ((string=? (car a) "n") (string->number (cadr a)))
+      ((string=? (car a) "s") (cadr a))
+      ((string=? (car a) "v") 
+       (let ((v (string-split (cadr a) #\,)))
+         (vector (string->number (list-ref v 0))
+                 (string->number (list-ref v 1))
+                 (string->number (list-ref v 2)))))
+      ((string=? (car a) "y") (string->symbol (cadr a)))
+      (else (error "unsupported value type for " a))))
+  
+  (define (string->nvpairs s l)
+    (map
+     (lambda (pair)
+       (let ((nv (string-split pair #\=)))
+         (list (string->symbol (car nv))
+               (string->value (string-split (cadr nv) #\:)))))
+     (string-split s #\ ))) 
+  
+  (super-new))
 
-    (super-new))

plant-eyes/plant-eyes.scm

@@ -1,8 +1,11 @@
-;#lang scheme/base
+#lang scheme/base
-;(require fluxus-016/drflux)
+(require fluxus-016/drflux)
 (require scheme/class "logic.ss" "view.ss" "controller.ss" "client.ss")
 (require "jabberer.ss")
 
+(define jid "plant0000001@fo.am")
+(define pass "plant0000001")
+
 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 ; p l a n t   e y e s   
 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -36,9 +39,6 @@
 ; * in the same way, the line segments can be created in any way by the logic 
 ;   side - eg. lsystem, or different methods per plant (or per twig even)
 
-(define jid "plant0000002@fo.am")
-(define pass "plant0000002")
-
 (define logic-tick 0.5) ; time between logic updates
 
 (clear)
@@ -80,7 +80,8 @@
   (pt-update)
   (sleep 0.01))
 
-#;(for ((i (in-range 0 10000)))
+#;(for ((i (in-range 0 100000)))
+    ; (sleep 0.4)
      (animate))
 
 (every-frame (animate))

plant-eyes/view.ss

@@ -317,6 +317,7 @@
                (opacity 0.6)
                (colour (vector 0.8 1 0.6))
                (hint-depth-sort)
+               (printf "size=~a~n" size)
                (scale (* 0.12 size))
                             (when wire-mode 
                               (hint-none)
@@ -508,7 +509,9 @@
       (set! plants (cons (list (send plant get-id) plant) plants)))
     
     (define/public (get-plant plant-id)
-      (cadr (assq plant-id plants)))
+      (let ((p (assoc plant-id plants)))
+        (when (not p) (error "plant id does not exist " plant-id))
+        (cadr p)))
     
     (define/public (add-branch-twig plant-id twig)
       (send (get-plant plant-id) add-branch-twig twig))
@@ -562,9 +565,11 @@
                          (send msg get-data 'size))))
                       
            ((eq? (send msg get-name) 'new-plant)
+            (printf "adding new plant to view ~a~n" (send msg get-data 'plant-id))
             (add-plant (make-object plant-view% 
                          (send msg get-data 'plant-id) 
-                         (send msg get-data 'pos))))    
+                         (send msg get-data 'pos)
+                         (send msg get-data 'size))))    
            
            ((eq? (send msg get-name) 'grow-seed)
             (grow-seed (send msg get-data 'plant-id)