more networking, join game stuff works with preset jid. also fixed the camera and root points coordinate system bugs shown up by having plants with different positions

plant-eyes/controller.ss

@@ -20,9 +20,12 @@
      (current-point 0)
      (tilt 0)
      (yaw 0)
-     (player-plant #f))   
+     (player-plant #f)
+     (player-pos (vector 0 0 0)))   
     
     (define/public (set-player-plant s)
+      (set! pos (send s get-pos))
+      (set! player-pos (send s get-pos))
       (set! player-plant s))
     
     (define/public (get-cam-obj)
@@ -60,8 +63,8 @@
       
       (when (or (key-pressed "a") (key-special-pressed 100)) (set! yaw (+ yaw 2)))
       (when (or (key-pressed "d") (key-special-pressed 102)) (set! yaw (- yaw 2)))
-      (when (or (key-pressed "w") (key-special-pressed 101)) (set! tilt (+ tilt 2)))
+      (when (or (key-pressed "w") (key-special-pressed 101)) (set! tilt (- tilt 2)))
-      (when (or (key-pressed "s") (key-special-pressed 103)) (set! tilt (- tilt 2)))      
+      (when (or (key-pressed "s") (key-special-pressed 103)) (set! tilt (+ tilt 2)))      
       
       ; clamp tilt to prevent gimbal lock
       (when (> tilt 88) (set! tilt 88))
@@ -81,7 +84,7 @@
                  (set! current-point (- current-point 1))
                  (when (< current-point 2)
                    (set! current-twig #f)
-                 (set! pos (vector 0 0 0))
+                   (set! pos player-pos)
                    #;(set-camera-transform (mtranslate (vector 0 0 -1))))))))                   
       
       ; get camera fwd vector from key-presses                   
@@ -93,7 +96,7 @@
       
       ; if we are on a twig not growing
       (cond ((and current-twig (not current-twig-growing))
-             (set! pos (send current-twig get-point current-point))
+             (set! pos (vadd player-pos (send current-twig get-point current-point)))
              #;(when (> current-point 0)
                  (set! fwd (vmix fwd (vnormalise (vsub (send current-twig get-point 
                                                              (- current-point 1))
@@ -104,8 +107,8 @@
                (let ((twig-view (send (send game-view get-plant (send player-plant get-id))
                                       get-twig (send current-twig get-id))))
                  (when twig-view
-                   (set! pos (vsub (send twig-view get-end-pos) 
+                   (set! pos (vadd player-pos (vsub (send twig-view get-end-pos) 
-                                   (vmul (send current-twig get-dir) 1)))))
+                                   (vmul (send current-twig get-dir) 1))))))
                (when (eq? (send current-twig get-num-points) 
                           (send current-twig get-length))
                  (set! current-twig-growing #f)

plant-eyes/jabberer.ss

@@ -53,12 +53,8 @@
                 (let loop () 
                     (when debug-netloop (printf ".~n"))
                     (when (not (null? outgoing))                             
-                        (for-each                                
+                      (xmpp:send (xmpp:message (car (car outgoing)) (cadr (car outgoing))))        
-                            (lambda (msg)                                
+                      (set! outgoing (cdr outgoing)))
-                                (when debug-jab (printf "tx ----> ~a ~a~n" (car msg) (cadr msg)))
-                                (xmpp:send (xmpp:message (car msg) (cadr msg))))
-                            outgoing)
-                        (set! outgoing '()))
                     (sleep 0.5)
                     (loop))))
         (super-new)))

plant-eyes/list-utils.ss

@@ -35,3 +35,10 @@
     ((null? l) "")
     (else
      (string-append (car l) t (list-string-concat (cdr l) t)))))
+
+; returns a list of items in a but not in b
+(define (list-remainder a b)
+  (cond 
+    ((null? a) '())
+    ((not (list-contains (car a) b)) (cons (car a) (list-remainder (cdr a) b)))
+    (else (list-remainder (cdr a) b))))

plant-eyes/logic.ss

@@ -75,9 +75,6 @@
     
     (inherit send-message)
     
-    (define/public (set-pos s)
-      (set! last-point s))
-    
     (define/public (get-id)
       id)
     
@@ -371,7 +368,6 @@
       (set! size (* size grow-amount))
       (send twig scale size)  
       (send twig set-branch! #t)
-      (send twig set-pos pos)
 
       (send-message 'grow-seed (list 
                                 (list 'plant-id id)
@@ -442,7 +438,8 @@
   (class game-logic-object%
     (field
      (plants '())
-     (pickups '()))
+     (pickups '())
+     (player #f))
    
     (inherit send-message)
     
@@ -452,13 +449,15 @@
                                      (vmul (srndvec) pickup-dist-radius)))))
     
     (define/public (add-player plant)
+      (printf "new player plant added~n")
       (send-message 'player-plant (list
                                 (list 'plant-id (send plant get-id))
-                                (list 'pos (send plant get-pos))))
+                                (list 'pos (send plant get-pos))
+                                (list 'size (send plant get-size))))
+      (set! player plant)
       (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))
@@ -473,6 +472,13 @@
                                        (list 'pos (send pickup get-pos))))
       (set! pickups (cons pickup pickups)))
     
+    (define/public (get-player-plant-desc)          
+      (list (make-object message% 'new-plant (list
+                                              (list 'plant-id (send player get-id))
+                                              (list 'pos (send player get-pos))
+                                              (list 'size (send player get-size))))))
+
+    
     
     ; todo - distribute the checking of stuff like
     ; this to a random selection of pickups/plants

plant-eyes/plant-eyes.scm

@@ -1,10 +1,10 @@
 #lang scheme/base
 (require fluxus-016/drflux)
-(require scheme/class "logic.ss" "view.ss" "controller.ss" "client.ss")
+(require scheme/class "logic.ss" "view.ss" "controller.ss" "client.ss" "jabberer.ss")
-(require "jabberer.ss")
 
 (define jid "plant0000001@fo.am")
 (define pass "plant0000001")
+(define pos (vector 50 0 0))
 
 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 ; p l a n t   e y e s   
@@ -53,27 +53,26 @@
 (send gl setup)
 (send cl setup)
 
-(define plant1 (make-object plant-logic% jid (vector 0 0 0)))
-
-(send c set-player-plant plant1)
-(send gl add-plant plant1)
-
 (define tick-time 0)
-
 (define pt 0)
 (define pd 0.02)
 (define (pe-time) pt)
 (define (pe-delta) pd)
 (define (pt-update) (set! pt (+ pt pd)))
 
-(define (animate)
+(define player (make-object plant-logic% jid pos))
+(send c set-player-plant player)
+(send gl add-player player)
 
+(define (animate)  
   (when (< tick-time (pe-time))    
-    (set! tick-time (+ (pe-time) logic-tick))
+    (send player grow (vmul (send c get-fwd) -1))
-    (send plant1 grow (vmul (send c get-fwd) -1))
+    
     (let ((messages (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 cl update messages gl))) ; and the game view
+    
+    (set! tick-time (+ (pe-time) logic-tick)))
   
   (send gv update (pe-time) (pe-delta) '())
   (send c update)