From 5d6ccb131e40f73aa2d2f5e08be444630de639eb Mon Sep 17 00:00:00 2001 From: Dave Griffiths Date: Wed, 12 Aug 2009 12:14:47 +0100 Subject: [PATCH] networking fixes --- plant-eyes/client.ss | 7 +++++-- plant-eyes/jabberer.ss | 2 +- plant-eyes/logic.ss | 15 +++++++++------ plant-eyes/message.ss | 3 ++- plant-eyes/plant-eyes.scm | 3 ++- plant-eyes/view.ss | 35 ++++++++++++++++++++--------------- 6 files changed, 39 insertions(+), 26 deletions(-) diff --git a/plant-eyes/client.ss b/plant-eyes/client.ss index e30b462..2fe6e7b 100644 --- a/plant-eyes/client.ss +++ b/plant-eyes/client.ss @@ -18,8 +18,8 @@ "plant0000001@fo.am" "plant0000002@fo.am" "plant0000003@fo.am" - ;"plant0000004@fo.am" - ;"plant0000005@fo.am" + "plant0000004@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))))))))) diff --git a/plant-eyes/jabberer.ss b/plant-eyes/jabberer.ss index 719adf6..eb228ce 100644 --- a/plant-eyes/jabberer.ss +++ b/plant-eyes/jabberer.ss @@ -17,7 +17,7 @@ (incoming '()) (outgoing '()) (thr 0) - (debug-jab #f)) + (debug-jab #t)) (define/public (get-incoming) incoming) diff --git a/plant-eyes/logic.ss b/plant-eyes/logic.ss index 300625c..473f79f 100644 --- a/plant-eyes/logic.ss +++ b/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)) @@ -432,9 +432,12 @@ (define/public (serialise) (append (list (make-object message% 'new-plant (list - (list 'plant-id id) - (list 'pos pos) - (list 'size size)))) + (list 'plant-id id) + (list 'pos pos) + (list 'size size) + (list 'col col) + (list 'tex tex)))) + (append (map (lambda (twig) @@ -502,7 +505,7 @@ (list 'tex (send plant get-tex)))) (set! player plant) (set! plants (cons plant plants))) - + (define/public (add-plant plant) (send-message 'new-plant (list (list 'plant-id (send plant get-id)) @@ -519,7 +522,7 @@ (list 'type (send pickup get-type)) (list 'pos (send pickup get-pos)))) (set! pickups (cons pickup pickups))) - + (define/public (serialise) (send player serialise)) diff --git a/plant-eyes/message.ss b/plant-eyes/message.ss index 3d27586..a3cf23f 100644 --- a/plant-eyes/message.ss +++ b/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)) diff --git a/plant-eyes/plant-eyes.scm b/plant-eyes/plant-eyes.scm index b99addb..9953bf5 100644 --- a/plant-eyes/plant-eyes.scm +++ b/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)) diff --git a/plant-eyes/view.ss b/plant-eyes/view.ss index 03adfc1..0324a93 100644 --- a/plant-eyes/view.ss +++ b/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))) - - p))) + (build-plane)) 0))))) ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -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) @@ -676,8 +677,8 @@ (define/public (add-ornament plant-id twig-id point-index property) (send (get-plant plant-id) add-ornament twig-id point-index property)) - (define/public (update t d messages) - + (define/public (update t d messages) + (for-each (lambda (plant) (send (cadr plant) update t d)) @@ -763,12 +764,16 @@ (pick-up-pickup (send msg get-data 'pickup-id))) - ((eq? (send msg get-name) 'new-ornament) - (add-ornament - (send msg get-data 'plant-id) - (send msg get-data 'twig-id) - (send msg get-data 'point-index) - (send msg get-data 'property))) + ((eq? (send msg get-name) 'pick-up-pickup) + (pick-up-pickup + (send msg get-data 'pickup-id))) + + ((eq? (send msg get-name) 'light-level) + (for-each + (lambda (p) + (with-primitive p + (colour (send msg get-data 'amount)))) + upper-env)) )) messages))