87 lines
3.2 KiB
Scheme
87 lines
3.2 KiB
Scheme
#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)))
|
|
|