networking fixes
This commit is contained in:
parent
9e4e5ca671
commit
5d6ccb131e
6 changed files with 39 additions and 26 deletions
|
@ -18,8 +18,8 @@
|
|||
"plant0000001@fo.am"
|
||||
"plant0000002@fo.am"
|
||||
"plant0000003@fo.am"
|
||||
;"plant0000004@fo.am"
|
||||
;"plant0000005@fo.am"
|
||||
"plant0000004@fo.am"
|
||||
"plant0000005@fo.am"
|
||||
"dave@fo.am"
|
||||
))
|
||||
(plants-present '())
|
||||
|
@ -56,6 +56,7 @@
|
|||
; 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)
|
||||
|
@ -67,10 +68,12 @@
|
|||
; 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)))))))))
|
||||
|
||||
|
|
|
@ -17,7 +17,7 @@
|
|||
(incoming '())
|
||||
(outgoing '())
|
||||
(thr 0)
|
||||
(debug-jab #f))
|
||||
(debug-jab #t))
|
||||
|
||||
(define/public (get-incoming)
|
||||
incoming)
|
||||
|
|
|
@ -404,7 +404,7 @@
|
|||
(set! size (* size grow-amount))
|
||||
(send twig scale size)
|
||||
(set! leader-twig twig)
|
||||
(send-message 'grow-seed (list
|
||||
#;(send-message 'grow-seed (list
|
||||
(list 'plant-id id)
|
||||
(list 'amount grow-amount)))
|
||||
(send-message 'new-twig (send twig get-desc-list))
|
||||
|
@ -432,9 +432,12 @@
|
|||
|
||||
(define/public (serialise)
|
||||
(append (list (make-object message% 'new-plant (list
|
||||
(list 'plant-id id)
|
||||
(list 'pos pos)
|
||||
(list 'size size))))
|
||||
(list 'plant-id id)
|
||||
(list 'pos pos)
|
||||
(list 'size size)
|
||||
(list 'col col)
|
||||
(list 'tex tex))))
|
||||
|
||||
(append
|
||||
(map
|
||||
(lambda (twig)
|
||||
|
@ -502,7 +505,7 @@
|
|||
(list 'tex (send plant get-tex))))
|
||||
(set! player plant)
|
||||
(set! plants (cons plant plants)))
|
||||
|
||||
|
||||
(define/public (add-plant plant)
|
||||
(send-message 'new-plant (list
|
||||
(list 'plant-id (send plant get-id))
|
||||
|
@ -519,7 +522,7 @@
|
|||
(list 'type (send pickup get-type))
|
||||
(list 'pos (send pickup get-pos))))
|
||||
(set! pickups (cons pickup pickups)))
|
||||
|
||||
|
||||
(define/public (serialise)
|
||||
(send player serialise))
|
||||
|
||||
|
|
|
@ -15,7 +15,8 @@
|
|||
name)
|
||||
|
||||
(define/public (get-data arg-name)
|
||||
(cadr (assoc arg-name data)))
|
||||
(let ((a (assoc arg-name data)))
|
||||
(if a (cadr a) (error "message arg not found " arg-name))))
|
||||
|
||||
(define/public (print)
|
||||
(printf "msg: ~a ~a~n" name data))
|
||||
|
|
|
@ -62,7 +62,8 @@
|
|||
(set! mode 'game)))
|
||||
((eq? mode 'game)
|
||||
(send game update (flxtime) (delta))))
|
||||
#;(update-time))
|
||||
#;(update-time)
|
||||
(sleep 0.01))
|
||||
|
||||
(every-frame (animate))
|
||||
|
||||
|
|
|
@ -4,7 +4,7 @@
|
|||
|
||||
; the fluxus code to make things look the way they do
|
||||
|
||||
(define debug-messages #f) ; prints out all the messages sent to the renderer
|
||||
(define debug-messages #t) ; prints out all the messages sent to the renderer
|
||||
(define audio-on #f)
|
||||
|
||||
(define (ornament-colour) (vector 0.5 1 0.4))
|
||||
|
@ -522,6 +522,7 @@
|
|||
(parent p)
|
||||
(hint-unlit)
|
||||
|
||||
(list
|
||||
(let ((t (with-state
|
||||
(texture (load-texture top))
|
||||
(translate (vector 0 0.5 0))
|
||||
|
@ -531,7 +532,8 @@
|
|||
(pdata-map!
|
||||
(lambda (t)
|
||||
(vmul t 10))
|
||||
"t"))))
|
||||
"t"))
|
||||
) t)
|
||||
|
||||
(with-state
|
||||
(texture (load-texture left))
|
||||
|
@ -557,14 +559,12 @@
|
|||
(rotate (vector 0 90 0))
|
||||
(build-plane))
|
||||
|
||||
(when lower
|
||||
(if lower
|
||||
(with-state
|
||||
(texture (load-texture bottom))
|
||||
(translate (vector 0 -0.5 0))
|
||||
(rotate (vector 90 0 0))
|
||||
(build-plane)))
|
||||
|
||||
p)))
|
||||
(build-plane)) 0)))))
|
||||
|
||||
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
|
||||
|
@ -642,7 +642,8 @@
|
|||
stones)
|
||||
|
||||
(define/public (add-plant plant)
|
||||
(destroy-plant (send plant get-id)) ; just in case
|
||||
(printf "ADD-PLANT~n")
|
||||
;(destroy-plant (send plant get-id)) ; just in case
|
||||
(set! plants (cons (list (send plant get-id) plant) plants)))
|
||||
|
||||
(define/public (get-plant plant-id)
|
||||
|
@ -676,8 +677,8 @@
|
|||
(define/public (add-ornament plant-id twig-id point-index property)
|
||||
(send (get-plant plant-id) add-ornament twig-id point-index property))
|
||||
|
||||
(define/public (update t d messages)
|
||||
|
||||
(define/public (update t d messages)
|
||||
|
||||
(for-each
|
||||
(lambda (plant)
|
||||
(send (cadr plant) update t d))
|
||||
|
@ -763,12 +764,16 @@
|
|||
(pick-up-pickup
|
||||
(send msg get-data 'pickup-id)))
|
||||
|
||||
((eq? (send msg get-name) 'new-ornament)
|
||||
(add-ornament
|
||||
(send msg get-data 'plant-id)
|
||||
(send msg get-data 'twig-id)
|
||||
(send msg get-data 'point-index)
|
||||
(send msg get-data 'property)))
|
||||
((eq? (send msg get-name) 'pick-up-pickup)
|
||||
(pick-up-pickup
|
||||
(send msg get-data 'pickup-id)))
|
||||
|
||||
((eq? (send msg get-name) 'light-level)
|
||||
(for-each
|
||||
(lambda (p)
|
||||
(with-primitive p
|
||||
(colour (send msg get-data 'amount))))
|
||||
upper-env))
|
||||
|
||||
))
|
||||
messages))
|
||||
|
|
Loading…
Reference in a new issue