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))))
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)
(cond ((not (send jab msg-waiting?)) l)
(else
@ -56,11 +65,7 @@
(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))
(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))

88
plant-eyes/logic.ss
View file

@ -62,14 +62,15 @@
(width 0) ; the width of this root
(num-points max-twig-points) ; number of points in 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
(points '()) ; the 3d points for this twig
(widths '())
(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
(branch #f) ; are we a main branch twig?
(w 0) ; the width of this segment
(curl (vmul (crndvec) curl-amount))) ; the angles to turn each point, if curly
@ -96,9 +97,6 @@
(define/public (get-render-type)
render-type)
(define/public (set-branch! s)
(set! branch s))
(define/public (get-point point-index)
(list-ref points point-index))
@ -118,7 +116,7 @@
(when (< (length points) num-points)
(let ((new-point (if (zero? (length points))
; 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)
(vadd last-point (vmul dir dist)))))
@ -141,6 +139,18 @@
(send (cadr twig) grow ndir))
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)
(let ((twig (make-object twig-logic%
(get-point point-index)
@ -151,22 +161,32 @@
(list-ref widths point-index)
(quotient num-points 2)
render-type
dist)))
dist
id
point-index
)))
(send-message 'new-twig (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))
))
(send-message 'new-twig (send twig get-desc-list))
(set! twigs (cons (list point-index twig) twigs))
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)
(cadr (assq point-index twigs)))
@ -375,21 +395,10 @@
(send twig set-id! (get-next-twig-id))
(set! size (* size grow-amount))
(send twig scale size)
(send twig set-branch! #t)
(send-message 'grow-seed (list
(list 'plant-id id)
(list 'amount grow-amount)))
(send-message 'new-branch-twig (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))
))
(send-message 'new-twig (send twig get-desc-list))
(set! twigs (cons-twig twig twigs max-twigs '())))
@ -409,6 +418,16 @@
(list -99 #f)
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)
; grow a new ornament?
@ -484,13 +503,8 @@
(list 'pos (send pickup get-pos))))
(set! pickups (cons pickup pickups)))
(define/public (get-player-plant-desc)
(list (make-object message% 'new-plant (list
(list 'plant-id (send player get-id))
(list 'pos (send player get-pos))
(list 'size (send player get-size))))))
(define/public (serialise)
(send player serialise))
; todo - distribute the checking of stuff like
; this to a random selection of pickups/plants

67
plant-eyes/view.ss
View file

@ -376,15 +376,6 @@
(cadr (assq twig-id twigs))
#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)
(for-each
(lambda (twig-id)
@ -393,19 +384,27 @@
(send (get-twig twig-id) destroy-twig)
(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)
(let ((ptwig (get-twig parent-twig-id)))
; attach to parent twig
(send twig set-pos! (send ptwig get-point point-index))
(when ptwig
(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-tex! tex)
(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)
(send ptwig add-child-twig-id (send twig get-id))
(send twig set-parent-twig-id parent-twig-id)
(with-primitive (send twig get-root)
(parent root))
(set! twigs (cons (list (send twig get-id) twig) twigs))))
@ -419,11 +418,6 @@
(send (get-twig twig-id) add-ornament point-index property))
(define/public (update-nutrients t d)
#;(with-primitive nutrients
(pdata-map!
(lambda (p)
(rndvec))
"p"))
(when (not (null? twigs))
(with-primitive nutrients
(pdata-index-map!
@ -564,15 +558,17 @@
(fog fog-col fog-strength 1 100))
(define/public (add-plant plant)
(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)
(let ((p (assoc plant-id plants)))
(when (not p) (error "plant id does not exist " plant-id))
(cadr p)))
(if (not p) #f (cadr p))))
(define/public (add-branch-twig plant-id twig)
(send (get-plant plant-id) add-branch-twig twig))
(define/public (destroy-plant plant-id)
(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)
(send (get-plant plant-id) destroy-branch-twig twig-id))
@ -640,27 +636,6 @@
((eq? (send msg get-name) 'destroy-branch-twig)
(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)
(add-twig (send msg get-data 'plant-id)
(send msg get-data 'parent-twig-id)