groworld/plant-eyes/scripts/client.ss

;; 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)))