FoAM/groworld
12
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

started dealing with plant serialisation for network play

Browse source
This commit is contained in:
Dave Griffiths 2009-07-27 09:26:41 +01:00
parent 78255b9b86
commit d1330587ae
4 changed files with 88 additions and 94 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
plant-eyes/client.ss
View file

@ -37,6 +37,15 @@
(send jab send-msg plant (send msg to-string)))) (send jab send-msg plant (send msg to-string))))
recipients)) recipients))
(define (heir-send from l)
(for-each
(lambda (msg)
(cond ((not (list? msg))
(send-msg (list from) msg))
(else
(heir-send msg))))
l))
(define (fetch-messages l game-logic) (define (fetch-messages l game-logic)
(cond ((not (send jab msg-waiting?)) l) (cond ((not (send jab msg-waiting?)) l)
(else (else
@ -56,11 +65,7 @@
(set! plants-present (cons (send msg get-data 'plant-id) plants-present)) (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-msg (list from) (make-object message% 'i-am-here (list (list 'plant-id jid))))
; send out our plant description messages ; send out our plant description messages
(for-each (heir-send from (send game-logic serialise))
(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)) (fetch-messages l game-logic))
((eq? name 'i-am-here) ((eq? name 'i-am-here)
(set! plants-present (cons (send msg get-data 'plant-id) plants-present)) (set! plants-present (cons (send msg get-data 'plant-id) plants-present))

88
plant-eyes/logic.ss
View file

@ -62,14 +62,15 @@
(width 0) ; the width of this root (width 0) ; the width of this root
(num-points max-twig-points) ; number of points in this twig (num-points max-twig-points) ; number of points in this twig
(render-type 'extruded) ; the way to tell the view to render this twig (render-type 'extruded) ; the way to tell the view to render this twig
(dist start-twig-dist)) ; distance between points (dist start-twig-dist) ; distance between points
(parent-twig-id -1)
(parent-twig-point-index -1))
(field (field
(points '()) ; the 3d points for this twig (points '()) ; the 3d points for this twig
(widths '()) (widths '())
(twigs '()) ; children are stored with the point number they are connected to. (twigs '()) ; children are stored with the point number they are connected to.
(ornaments '()) ; the things attached to this twig, an assoc list with point index (ornaments '()) ; the things attached to this twig, an assoc list with point index
(branch #f) ; are we a main branch twig?
(w 0) ; the width of this segment (w 0) ; the width of this segment
(curl (vmul (crndvec) curl-amount))) ; the angles to turn each point, if curly (curl (vmul (crndvec) curl-amount))) ; the angles to turn each point, if curly
@ -96,9 +97,6 @@
(define/public (get-render-type) (define/public (get-render-type)
render-type) render-type)
(define/public (set-branch! s)
(set! branch s))
(define/public (get-point point-index) (define/public (get-point point-index)
(list-ref points point-index)) (list-ref points point-index))
@ -118,7 +116,7 @@
(when (< (length points) num-points) (when (< (length points) num-points)
(let ((new-point (if (zero? (length points)) (let ((new-point (if (zero? (length points))
; first point should be at edge of the seed if we are a branch ; first point should be at edge of the seed if we are a branch
(if branch (vadd last-point (vmul dir dist)) (if (eq? parent-twig-id -1) (vadd last-point (vmul dir dist))
last-point) last-point)
(vadd last-point (vmul dir dist))))) (vadd last-point (vmul dir dist)))))
@ -141,6 +139,18 @@
(send (cadr twig) grow ndir)) (send (cadr twig) grow ndir))
twigs)) twigs))
(define/public (get-desc-list)
(list
(list 'plant-id (send plant get-id))
(list 'parent-twig-id parent-twig-id)
(list 'point-index parent-twig-point-index)
(list 'twig-id id)
(list 'type type)
(list 'dir dir)
(list 'width width)
(list 'num-points num-points)
(list 'render-type render-type)))
(define/public (add-twig point-index dir) (define/public (add-twig point-index dir)
(let ((twig (make-object twig-logic% (let ((twig (make-object twig-logic%
(get-point point-index) (get-point point-index)
@ -151,22 +161,32 @@
(list-ref widths point-index) (list-ref widths point-index)
(quotient num-points 2) (quotient num-points 2)
render-type render-type
dist))) dist
id
point-index
)))
(send-message 'new-twig (list (send-message 'new-twig (send twig get-desc-list))
(list 'plant-id (send plant get-id))
(list 'parent-twig-id id)
(list 'point-index point-index)
(list 'twig-id (send twig get-id))
(list 'type (send twig get-type))
(list 'dir (send twig get-dir))
(list 'width (send twig get-width))
(list 'num-points (send twig get-num-points))
(list 'render-type (send twig get-render-type))
))
(set! twigs (cons (list point-index twig) twigs)) (set! twigs (cons (list point-index twig) twigs))
twig)) twig))
(define/public (serialise)
(append
(list (make-object message% 'new-twig (get-desc-list)))
(append (map
(lambda (point width)
(make-object message% 'twig-grow (list
(list 'plant-id (send plant get-id))
(list 'twig-id id)
(list 'point point)
(list 'width width))))
points widths))
(append
(map
(lambda (twig)
(send (cadr twig) serialise))
twigs))))
(define/public (get-twig point-index) (define/public (get-twig point-index)
(cadr (assq point-index twigs))) (cadr (assq point-index twigs)))
@ -375,21 +395,10 @@
(send twig set-id! (get-next-twig-id)) (send twig set-id! (get-next-twig-id))
(set! size (* size grow-amount)) (set! size (* size grow-amount))
(send twig scale size) (send twig scale size)
(send twig set-branch! #t)
(send-message 'grow-seed (list (send-message 'grow-seed (list
(list 'plant-id id) (list 'plant-id id)
(list 'amount grow-amount))) (list 'amount grow-amount)))
(send-message 'new-branch-twig (list (send-message 'new-twig (send twig get-desc-list))
(list 'plant-id id)
(list 'twig-id (send twig get-id))
(list 'type (send twig get-type))
(list 'dir (send twig get-dir))
(list 'width (send twig get-width))
(list 'num-points (send twig get-num-points))
(list 'render-type (send twig get-render-type))
))
(set! twigs (cons-twig twig twigs max-twigs '()))) (set! twigs (cons-twig twig twigs max-twigs '())))
@ -409,6 +418,16 @@
(list -99 #f) (list -99 #f)
twigs)))) twigs))))
(define/public (serialise)
(append (list (make-object message% 'new-plant (list
(list 'plant-id id)
(list 'pos pos)
(list 'size size))))
(append
(map
(lambda (twig)
(send twig serialise))
twigs))))
(define/augment (update) (define/augment (update)
; grow a new ornament? ; grow a new ornament?
@ -484,13 +503,8 @@
(list 'pos (send pickup get-pos)))) (list 'pos (send pickup get-pos))))
(set! pickups (cons pickup pickups))) (set! pickups (cons pickup pickups)))
(define/public (get-player-plant-desc) (define/public (serialise)
(list (make-object message% 'new-plant (list (send player serialise))
(list 'plant-id (send player get-id))
(list 'pos (send player get-pos))
(list 'size (send player get-size))))))
; todo - distribute the checking of stuff like ; todo - distribute the checking of stuff like
; this to a random selection of pickups/plants ; this to a random selection of pickups/plants

67
plant-eyes/view.ss
View file

@ -376,15 +376,6 @@
(cadr (assq twig-id twigs)) (cadr (assq twig-id twigs))
#f))) #f)))
(define/public (add-branch-twig twig)
; attach to seed
(with-primitive (send twig get-root)
(parent root))
(send twig set-col! col)
(send twig set-tex! tex)
(send twig build)
(set! twigs (cons (list (send twig get-id) twig) twigs)))
(define/public (destroy-branch-twig twig-id) (define/public (destroy-branch-twig twig-id)
(for-each (for-each
(lambda (twig-id) (lambda (twig-id)
@ -393,19 +384,27 @@
(send (get-twig twig-id) destroy-twig) (send (get-twig twig-id) destroy-twig)
(set! twigs (assoc-remove twig-id twigs))) (set! twigs (assoc-remove twig-id twigs)))
(define/public (destroy-plant)
(destroy root)
(for-each
(lambda (twig)
(destroy-branch-twig (car twig)))
twigs))
(define/public (add-twig parent-twig-id point-index twig) (define/public (add-twig parent-twig-id point-index twig)
(let ((ptwig (get-twig parent-twig-id))) (let ((ptwig (get-twig parent-twig-id)))
; attach to parent twig (when ptwig
(send twig set-pos! (send ptwig get-point point-index)) (send twig set-pos! (send ptwig get-point point-index)) ; attach to parent twig
; tell the twigs about this relationship (might turn out to be overkill)
(send ptwig add-child-twig-id (send twig get-id))
(send twig set-parent-twig-id parent-twig-id))
(send twig set-col! col) (send twig set-col! col)
(send twig set-tex! tex) (send twig set-tex! tex)
(send twig build) (send twig build)
(with-primitive (send twig get-root)
(parent (send ptwig get-root)))
; tell the twigs about this relationship (might turn out to be overkill) (with-primitive (send twig get-root)
(send ptwig add-child-twig-id (send twig get-id)) (parent root))
(send twig set-parent-twig-id parent-twig-id)
(set! twigs (cons (list (send twig get-id) twig) twigs)))) (set! twigs (cons (list (send twig get-id) twig) twigs))))
@ -419,11 +418,6 @@
(send (get-twig twig-id) add-ornament point-index property)) (send (get-twig twig-id) add-ornament point-index property))
(define/public (update-nutrients t d) (define/public (update-nutrients t d)
#;(with-primitive nutrients
(pdata-map!
(lambda (p)
(rndvec))
"p"))
(when (not (null? twigs)) (when (not (null? twigs))
(with-primitive nutrients (with-primitive nutrients
(pdata-index-map! (pdata-index-map!
@ -564,15 +558,17 @@
(fog fog-col fog-strength 1 100)) (fog fog-col fog-strength 1 100))
(define/public (add-plant plant) (define/public (add-plant plant)
(destroy-plant (send plant get-id)) ; just in case
(set! plants (cons (list (send plant get-id) plant) plants))) (set! plants (cons (list (send plant get-id) plant) plants)))
(define/public (get-plant plant-id) (define/public (get-plant plant-id)
(let ((p (assoc plant-id plants))) (let ((p (assoc plant-id plants)))
(when (not p) (error "plant id does not exist " plant-id)) (if (not p) #f (cadr p))))
(cadr p)))
(define/public (add-branch-twig plant-id twig) (define/public (destroy-plant plant-id)
(send (get-plant plant-id) add-branch-twig twig)) (let ((p (get-plant plant-id)))
(when p (send p destroy-plant)
(set! plants (assoc-remove plant-id plants)))))
(define/public (destroy-branch-twig plant-id twig-id) (define/public (destroy-branch-twig plant-id twig-id)
(send (get-plant plant-id) destroy-branch-twig twig-id)) (send (get-plant plant-id) destroy-branch-twig twig-id))
@ -640,27 +636,6 @@
((eq? (send msg get-name) 'destroy-branch-twig) ((eq? (send msg get-name) 'destroy-branch-twig)
(destroy-branch-twig (send msg get-data 'plant-id) (send msg get-data 'twig-id))) (destroy-branch-twig (send msg get-data 'plant-id) (send msg get-data 'twig-id)))
((eq? (send msg get-name) 'new-branch-twig)
(add-branch-twig (send msg get-data 'plant-id)
(cond
((eq? (send msg get-data 'render-type) 'ribbon)
(make-object ribbon-twig-view%
(send msg get-data 'twig-id)
(vector 0 0 0)
(send msg get-data 'type)
(send msg get-data 'dir)
(send msg get-data 'width)
(send msg get-data 'num-points)))
((eq? (send msg get-data 'render-type) 'extruded)
(make-object extruded-twig-view%
(send msg get-data 'twig-id)
(vector 0 0 0)
(send msg get-data 'type)
(send msg get-data 'dir)
(send msg get-data 'width)
(send msg get-data 'num-points))))))
((eq? (send msg get-name) 'new-twig) ((eq? (send msg get-name) 'new-twig)
(add-twig (send msg get-data 'plant-id) (add-twig (send msg get-data 'plant-id)
(send msg get-data 'parent-twig-id) (send msg get-data 'parent-twig-id)