Merge branch 'master' of ssh://dave@fo.am/git/groworld
This commit is contained in:
commit
e1e51d083b
1 changed files with 78 additions and 0 deletions
78
plant-eyes/client.ss
Normal file
78
plant-eyes/client.ss
Normal 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)))
|
||||
|
Loading…
Reference in a new issue