oops, forgot to add client.ss

This commit is contained in:
Dave Griffiths 2009-07-23 13:06:59 +01:00
parent 74280d9200
commit 6c5fc421b2
2 changed files with 80 additions and 2 deletions

78
plant-eyes/client.ss Normal file
View file

@ -0,0 +1,78 @@
#lang scheme
(require scheme/class "jabberer.ss" "message.ss" "list-utils.ss")
(provide (all-defined-out))
; the client listens to all the messages from the logic side
; and decides which ones to send out to the network
; it also listens to the network and pokes the logic with updates
(define client%
(class object%
(init-field
(jid "none@nowhere")
(pass "xxxx"))
(field
(all-plants
(list
"plant0000001@fo.am"
"plant0000002@fo.am"
"plant0000003@fo.am"
))
(plants-present '())
(msg-filter (list 'new-pickup 'pick-up-pickup)) ; messages we don't want to send across the network
(jab (make-object jabberer% jid pass)))
(define/public (setup)
(send jab start)
(send-msg all-plants (make-object message% 'hello-world (list (list 'plant-id jid)))))
(define/public (send-msg recipients msg)
(for-each
(lambda (plant)
(when (not (string=? plant jid)) ; dont send to ourselves!
(send jab send-msg plant (send msg to-string))))
recipients))
(define (fetch-messages l game-logic)
(cond ((not (send jab msg-waiting?)) l)
(else
(let* ((msg (send jab get-msg))
(from (car msg))
(body (cadr msg)))
; 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)
(cond
((eq? name 'hello-world)
(printf "received hello-world from ~a~n" (send msg get-data 'plant-id))
(set! plants-present (cons (send msg get-data 'plant-id) plants-present))
(send-msg (list from) (make-object message% 'i-am-here (list (list 'plant-id jid))))
; send out our plant description messages
(for-each
(lambda (msg)
(printf "sending plant info to ~a ~n" from)
(send-msg (list from) msg))
(send game-logic get-player-plant-desc))
(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)))))))))
(define/public (update messages game-logic)
(for-each
(lambda (msg)
(when (not (list-contains (send msg get-name) msg-filter))
(send-msg all-plants msg))) ; todo - need to send to plants-present only
messages)
(fetch-messages messages game-logic)) ; add get messages from the network on
(super-new)))

View file

@ -1,5 +1,5 @@
#lang scheme/base ;#lang scheme/base
(require fluxus-016/drflux) ;(require fluxus-016/drflux)
(require scheme/class "logic.ss" "view.ss" "controller.ss" "client.ss" "jabberer.ss") (require scheme/class "logic.ss" "view.ss" "controller.ss" "client.ss" "jabberer.ss")
(define jid "plant0000001@fo.am") (define jid "plant0000001@fo.am")