oops, forgot to add client.ss
This commit is contained in:
parent
74280d9200
commit
6c5fc421b2
2 changed files with 80 additions and 2 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)))
|
||||||
|
|
|
@ -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")
|
||||||
|
|
Loading…
Reference in a new issue