From d1330587aecba88c9105e7e743a991c6dbe6312e Mon Sep 17 00:00:00 2001 From: Dave Griffiths Date: Mon, 27 Jul 2009 09:26:41 +0100 Subject: [PATCH] started dealing with plant serialisation for network play --- plant-eyes/client.ss | 15 ++++--- plant-eyes/controller.ss | 4 +- plant-eyes/logic.ss | 88 +++++++++++++++++++++++----------------- plant-eyes/view.ss | 75 ++++++++++++---------------------- 4 files changed, 88 insertions(+), 94 deletions(-) diff --git a/plant-eyes/client.ss b/plant-eyes/client.ss index c1ebf49..7f71fe2 100644 --- a/plant-eyes/client.ss +++ b/plant-eyes/client.ss @@ -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)) diff --git a/plant-eyes/controller.ss b/plant-eyes/controller.ss index 2f17413..0a026a0 100644 --- a/plant-eyes/controller.ss +++ b/plant-eyes/controller.ss @@ -64,8 +64,8 @@ (when (or (key-pressed "a") (key-special-pressed 100)) (set! yaw (+ yaw 2))) (when (or (key-pressed "d") (key-special-pressed 102)) (set! yaw (- yaw 2))) (when (or (key-pressed "w") (key-special-pressed 101)) (set! tilt (- tilt 2))) - (when (or (key-pressed "s") (key-special-pressed 103)) (set! tilt (+ tilt 2))) - + (when (or (key-pressed "s") (key-special-pressed 103)) (set! tilt (+ tilt 2))) + ; clamp tilt to prevent gimbal lock (when (> tilt 88) (set! tilt 88)) (when (< tilt -88) (set! tilt -88)) diff --git a/plant-eyes/logic.ss b/plant-eyes/logic.ss index 6dfdf24..c37d4fc 100644 --- a/plant-eyes/logic.ss +++ b/plant-eyes/logic.ss @@ -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 diff --git a/plant-eyes/view.ss b/plant-eyes/view.ss index c2d0c76..6e172dc 100644 --- a/plant-eyes/view.ss +++ b/plant-eyes/view.ss @@ -375,15 +375,6 @@ (if l (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 @@ -393,21 +384,29 @@ (send (get-twig twig-id) destroy-twig) (set! twigs (assoc-remove twig-id twigs))) - (define/public (add-twig parent-twig-id point-index twig) + (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) - - (set! twigs (cons (list (send twig get-id) twig) twigs)))) + (parent root)) + + (set! twigs (cons (list (send twig get-id) twig) twigs)))) (define/public (grow-twig twig-id point width) (send (get-twig twig-id) grow point width)) @@ -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)) @@ -638,28 +634,7 @@ (send msg get-data 'amount))) ((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)))))) + (destroy-branch-twig (send msg get-data 'plant-id) (send msg get-data 'twig-id))) ((eq? (send msg get-name) 'new-twig) (add-twig (send msg get-data 'plant-id)