FoAM/groworld
12
0
Fork 0
Code Issues Pull requests Packages Projects Releases 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"
"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)))))))))

2
plant-eyes/jabberer.ss
View file

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

15
plant-eyes/logic.ss
View file

@ -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))

3
plant-eyes/message.ss
View file

@ -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))

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

@ -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))

35
plant-eyes/view.ss
View file

@ -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))