;; p l a n t e y e s [ copyright (c) 2009 foam vzw : gpl v3 ] #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" "plant0000004@fo.am" "plant0000005@fo.am" "dave@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 (heir-send to l) (for-each (lambda (msg) (cond ((not (list? msg)) (send-msg (list to) msg)) (else (heir-send to msg)))) l)) (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 (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))))))))) (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)))