FoAM/groworld
12
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

networking fixes

Browse source
This commit is contained in:
Dave Griffiths 2009-08-12 12:14:47 +01:00
parent 9e4e5ca671
commit 5d6ccb131e
6 changed files with 39 additions and 26 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
plant-eyes/client.ss
View file

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

2
plant-eyes/jabberer.ss
View file

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

11
plant-eyes/logic.ss
View file

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

3
plant-eyes/message.ss
View file

@ -15,7 +15,8 @@
name) name)
(define/public (get-data arg-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) (define/public (print)
(printf "msg: ~a ~a~n" name data)) (printf "msg: ~a ~a~n" name data))

3
plant-eyes/plant-eyes.scm
View file

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

31
plant-eyes/view.ss
View file

@ -4,7 +4,7 @@
; the fluxus code to make things look the way they do ; 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 audio-on #f)
(define (ornament-colour) (vector 0.5 1 0.4)) (define (ornament-colour) (vector 0.5 1 0.4))
@ -522,6 +522,7 @@
(parent p) (parent p)
(hint-unlit) (hint-unlit)
(list
(let ((t (with-state (let ((t (with-state
(texture (load-texture top)) (texture (load-texture top))
(translate (vector 0 0.5 0)) (translate (vector 0 0.5 0))
@ -531,7 +532,8 @@
(pdata-map! (pdata-map!
(lambda (t) (lambda (t)
(vmul t 10)) (vmul t 10))
"t")))) "t"))
) t)
(with-state (with-state
(texture (load-texture left)) (texture (load-texture left))
@ -557,14 +559,12 @@
(rotate (vector 0 90 0)) (rotate (vector 0 90 0))
(build-plane)) (build-plane))
(when lower (if lower
(with-state (with-state
(texture (load-texture bottom)) (texture (load-texture bottom))
(translate (vector 0 -0.5 0)) (translate (vector 0 -0.5 0))
(rotate (vector 90 0 0)) (rotate (vector 90 0 0))
(build-plane))) (build-plane)) 0)))))
p)))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@ -642,7 +642,8 @@
stones) stones)
(define/public (add-plant plant) (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))) (set! plants (cons (list (send plant get-id) plant) plants)))
(define/public (get-plant plant-id) (define/public (get-plant plant-id)
@ -763,12 +764,16 @@
(pick-up-pickup (pick-up-pickup
(send msg get-data 'pickup-id))) (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)) messages))