first pass serialisation and network messaging

plant-eyes/controller.ss

@@ -1,5 +1,5 @@
 #lang scheme/base
-(require scheme/class fluxus-016/drflux "logic.ss" "view.ss")
+(require scheme/class fluxus-016/fluxus "logic.ss" "view.ss")
 (provide (all-defined-out))
 
 ; reads input events and tells the logic side what to do

plant-eyes/jabberer.ss

@@ -1,11 +1,12 @@
 #lang scheme/base
-(require scheme/class fluxus-016/drflux openssl (prefix-in xmpp: "xmpp.ss"))
+(require scheme/class openssl (prefix-in xmpp: "xmpp.ss"))
 (provide (all-defined-out))
 
 ; a class which wraps the xmpp in a thread and allows messages to be picked up
 ; and sent by the game
 
 (define debug-netloop #f)
+(define debug-jab #f)
 
 (define jabberer%
     (class object%
@@ -41,7 +42,9 @@
             (set! incoming (cons (list (xmpp:message-from sz) (xmpp:message-body sz)) incoming)))
         
         (define/public (start)
-            (set! thr (thread run)))
+          (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)
             (kill-thread thr))

plant-eyes/list-utils.ss

@@ -1,6 +1,8 @@
 #lang scheme/base
 (provide (all-defined-out))
 
+; just some stuff which is probably defined in standard schemish somewhere
+
 (define (assoc-remove k l)
   (cond
     ((null? l) '())

plant-eyes/logic.ss

@@ -1,5 +1,5 @@
 #lang scheme
-(require scheme/class fluxus-016/drflux "message.ss" "list-utils.ss")
+(require scheme/class fluxus-016/fluxus "message.ss" "list-utils.ss")
 (provide (all-defined-out))
 
 (define branch-probability 6) ; as in one in branch-probability chance
@@ -458,6 +458,7 @@
       (set! plants (cons plant plants)))
     
     (define/public (add-plant plant)
+      (printf "new-plant added~n")
       (send-message 'new-plant (list
                                 (list 'plant-id (send plant get-id))
                                 (list 'pos (send plant get-pos))

plant-eyes/message.ss

@@ -4,8 +4,7 @@
 
 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 ; a message for sending betwixt logic and view side
-(define message%
+(define-serializable-class* message% object% ()
-  (class object%
     (init-field
      (name 'none) ; a symbol denoting the type of the message 
      (data '()))  ; should be an assoc list map of name to values, eg:
@@ -21,4 +20,4 @@
     (define/public (print)
       (printf "msg: ~a ~a~n" name data))
    
-    (super-new)))
+    (super-new))

plant-eyes/ornament-view.ss

@@ -1,41 +0,0 @@
-#lang scheme
-#lang scheme/base
-
-(require scheme/class fluxus-016/drflux "common.ss" "message.ss" "list-utils.ss")
-(provide (all-defined-out))
-
-(define ornament-view%
-  (class object%
-    (init-field
-     (pos (vector 0 0 0))
-     (property 'none)
-     (time 0))
-    
-    (field
-     (rot (vmul (rndvec) 360))
-     (root (with-state
-            (translate pos)
-            (rotate rot)
-            (scale 0.01)            
-            (cond 
-              ((eq? property 'wiggle) 
-;               (opacity 1)
-               (hint-depth-sort)
-               (colour (vector 0.5 0.0 0.0))
-               (load-primitive "meshes/wiggle.obj"))
-              ((eq? property 'leaf) 
-               (colour (vector 0.8 1 0.6))
-               (texture (load-texture "textures/leaf2.png"))
-               (load-primitive "meshes/leaf.obj"))
-              (else (error ""))))))
-    
-    (define/public (update t d)
-      (when (< time 1)
-        (with-primitive root
-                        (identity)
-                        (translate pos)
-                        (rotate rot)
-                        (scale (* 0.2 time)))
-        (set! time (+ time (* 0.1 d)))))
-    
-    (super-new)))

plant-eyes/pickup-view.ss

@@ -1,49 +0,0 @@
-#lang scheme/base
-(require scheme/class fluxus-016/drflux "common.ss" "message.ss" "list-utils.ss")
-(provide (all-defined-out))
-
-(define pickup-view%
-  (class object%
-    (init-field
-     (id -1)
-     (type 'none)
-     (pos (vector 0 0 0)))
-    
-    (field
-     (rot (vmul (rndvec) 360))
-     (root (with-state
-            (translate pos)
-            (rotate rot)
-            (colour (pickup-colour))
-            (scale 0.3)
-            (texture
-             (cond 
-              ((eq? type 'wiggle) (load-texture "textures/wiggle.png"))
-              ((eq? type 'leaf) (load-texture "textures/leaf.png"))
-              ((eq? type 'curly) (load-texture "textures/curl.png"))))
-            (load-primitive "meshes/pickup.obj")))
-     (from pos)
-     (destination (vector 0 0 0))
-     (speed 0.05)
-     (t -1))
-    
-    (define/public (pick-up)
-      (destroy root))
-    
-    (define/public (move-to s)
-      (set! t 0)
-      (set! from pos)
-      (set! destination s))
-    
-    (define/public (update t d)
-      (with-primitive root
-                      (rotate (vector (* d 10) 0 0)))
-      #;(when (and (>= t 0) (< t 1))
-        (set! pos (vadd pos (vmul (vsub destination from) speed)))
-        (with-primitive root
-                        (identity)
-                        (translate pos)
-                        (rotate rot))
-        (set! t (+ t speed))))
-    
-    (super-new)))

plant-eyes/plant-eyes.scm

@@ -1,6 +1,6 @@
-#lang scheme/base
+;#lang scheme/base
-(require fluxus-016/drflux)
+;(require fluxus-016/drflux)
-(require scheme/class "logic.ss" "view.ss" "controller.ss")
+(require scheme/class "logic.ss" "view.ss" "controller.ss" "client.ss")
 (require "jabberer.ss")
 
 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -26,6 +26,9 @@
 ;   at any point, and have them automatically collected up and dispatched to 
 ;   the view
 ;
+; * these messages are also converted to xmpp messages and sent out over the 
+;   network
+;
 ; * line segments are computed in the logic side, and can be represented any
 ;   way by the view - maybe the players plant will be geometry and everyone
 ;   elses will be ribbons (stoopid LOD)
@@ -33,6 +36,9 @@
 ; * 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)
@@ -40,20 +46,17 @@
 (define gl (make-object game-logic%))
 (define gv (make-object game-view%))
 (define c (make-object controller% gv))
+(define cl (make-object client% jid pass))
 
 (send c setup)
 (send gv setup)
 (send gl setup)
+(send cl setup)
 
-(define plant1 (make-object plant-logic% "dave@fo.am" (vector 0 0 0)))
+(define plant1 (make-object plant-logic% jid (vector 0 0 0)))
-(define plant2 (make-object plant-logic% "plant00001@fo.am" (vector 0 0 90)))
 
 (send c set-player-plant plant1)
-      
 (send gl add-plant plant1)
-(send gl add-plant plant2)
-
-(send plant2 add-twig (make-object twig-logic% (vector 0 0 0) 0 plant2 'root (vector 0 -1 0) start-twig-width 10 'ribbon))
 
 (define tick-time 0)
 
@@ -68,12 +71,14 @@
   (when (< tick-time (pe-time))
     (set! tick-time (+ (pe-time) logic-tick))
     (send plant1 grow (vmul (send c get-fwd) -1))
-    (send plant2 grow (vector 0 -1 0))
+    (let ((messages (send gl update)))
-    (send gv update (pe-time) (pe-delta) (send gl update)))
+       ; pass the messages to the network client 
+      (send gv update (pe-time) (pe-delta) (send cl update messages gl)))) ; and the game view
   
   (send gv update (pe-time) (pe-delta) '())
   (send c update)
-  (pt-update))
+  (pt-update)
+  (sleep 0.01))
 
 #;(for ((i (in-range 0 10000)))
      (animate))

plant-eyes/view.ss

@@ -1,5 +1,5 @@
 #lang scheme/base
-(require scheme/class fluxus-016/drflux "message.ss" "list-utils.ss")
+(require scheme/class fluxus-016/fluxus "message.ss" "list-utils.ss")
 (provide (all-defined-out))
 
 ; the fluxus code to make things look the way they do

plant-eyes/xmpp.ss

@@ -83,7 +83,7 @@
   ;;
   ;;;; ; ;
   
-  (define debug? #t)
+  (define debug? #f)
   
   (define debugf
     (case-lambda