From 38aa60868722f2185314f9d2b1bf6f10b6605f43 Mon Sep 17 00:00:00 2001 From: Dave Griffiths Date: Fri, 13 Mar 2009 12:43:08 +0000 Subject: [PATCH] sucking, flower changes, all networked... --- hayfever/hayfever.scm | 257 ++++++++++++++++++++++++++++++++---------- 1 file changed, 200 insertions(+), 57 deletions(-) diff --git a/hayfever/hayfever.scm b/hayfever/hayfever.scm index 1eaf102..6dab3a4 100644 --- a/hayfever/hayfever.scm +++ b/hayfever/hayfever.scm @@ -88,9 +88,9 @@ ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; a plant component -(define-struct component (root children)) +(define-struct component (root (col #:mutable) children)) -(define (build-component id children) +(define (build-component id col children) (cond ((null? children) (let ((root (with-state @@ -98,7 +98,7 @@ (rotate (vector 0 0 180)) (texture (load-texture (string-append "textures/comp-" id ".png"))) (build-plane)))) - (make-component root '()))) + (make-component root col '()))) (else (let* ((connection-list (get-connection-list id)) (root (with-state @@ -106,7 +106,7 @@ (rotate (vector 0 0 180)) (texture (load-texture (string-append "textures/comp-" id ".png"))) (build-plane))) - (comp (make-component root + (comp (make-component root col (map (lambda (child connection) (with-state @@ -115,7 +115,7 @@ (rotate (vector 0 0 (2dvec->angle (vx connection) (- (vy connection) 0.5)))) (rotate (vector 0 0 0)) - (build-component (car child) (cadr child)))) + (build-component (car child) col (cadr child)))) children connection-list)))) (with-primitive root (apply-transform)) @@ -126,6 +126,15 @@ ((null? (component-children component)) component) (else (random-leaf (choose (component-children component)))))) +(define (component-leaves component) + (cond + ((null? (component-children component)) (list component)) + (else + (foldl + (lambda (child r) + (append (component-leaves child) r)) + '() + (component-children component))))) (define (component-print component) (printf "~a~n" (component-children component))) @@ -137,9 +146,11 @@ (list-ref l (random (length l)))) (define (make-random-plant depth) - (let ((num-children (if (> depth 3) 0 (choose (list 0 1 2 3))))) + (let ((num-children (cond ((> depth 2) 0) + ((< depth 1) (choose (list 2 3))) + (else (choose (list 0 1 2 3)))))) (cond - ((eq? num-children 0) (list (choose (list "2" "3" "4" "5" "6" "7" "8" "9" "10")) (list))) + ((eq? num-children 0) (list (choose (list "11")) (list))) ((eq? num-children 1) (list "1-1" (list (make-random-plant (+ depth 1))))) ((eq? num-children 2) (list "2-1" (list (make-random-plant (+ depth 1)) (make-random-plant (+ depth 1))))) @@ -165,7 +176,8 @@ (root 0) (entity-list '()) (id 0) - (pollen 0)) + (pollen 0) + (my-id 0)) (define/public (init) @@ -186,7 +198,7 @@ "c") (pdata-map! (lambda (c) - (let ((s (* 0.1 (grndf)))) + (let ((s (* 0.2 (grndf)))) (vector s s 1))) "s")) @@ -195,7 +207,7 @@ (rotate (vector 90 0 0)) (scale 100) (build-plane))) - (with-state + #;(with-state (hint-depth-sort) ; (parent root) (with-state @@ -207,19 +219,26 @@ (hint-unlit) (build-plane)) (with-state - (scale (vector 19 8 1)) + (scale (vector 19 5 1)) (translate (vector 0 0.2 1.5)) (rotate (vector 0 0 180)) (texture (load-texture "textures/mid.png")) (hint-unlit) (build-plane)))) - (define (inc-id!) - (set! id (+ id 1))) - (define/public (get-entity-list) entity-list) + (define/public (get-my-id) + my-id) + + (define/public (make-my-plant) + (let* ((pos (vector (* (crndf) 5) 2 1)) + (col (hsv->rgb (vector (rndf) 0.5 1))) + (desc (list (make-random-plant 0)))) + (set! my-id (length entity-list)) + (set-entity my-id (make-object plant% pos col desc)))) + (define/public (get-entity id) (foldl (lambda (entity ret) @@ -232,25 +251,34 @@ (define/public (choose) (list-ref entity-list (random (length entity-list)))) - (define/public (add-entity entity) - (inc-id!) + + (define/public (set-entity id entity) + ; if it already exists, destroy it + ; (do we want to do this all the time?) + (when (get-entity id) + (destroy-entity id)) + (send entity set-id! id) - (set! entity-list (cons entity entity-list)) - id) + (set! entity-list (cons entity entity-list))) (define/public (destroy-entity id) - (set! plants + (set! entity-list (filter (lambda (entity) (cond ((eq? (send entity get-id) id) - (send entity destroy) + (send entity destroy-me) #f) (else #t))) entity-list))) - (define/public (update) + (define/public (update network) (with-primitive pollen (animate-pollen)) + + ; update my plant with player input + (when (get-entity my-id) + (send (get-entity my-id) player-update this network)) + (for-each (lambda (entity) (send entity update this)) @@ -276,10 +304,25 @@ (with-primitive pollen (for ((i (in-range 0 np))) (let ((c (random (pdata-size))) - (cc (vadd col (vmul (grndvec) 0.2)))) + (cc (vmul col 1))) (pdata-set! "p" c (vadd (vmul (cirndvec) size) pos)) (pdata-set! "c" c (vector (vx cc) (vy cc) (vz cc) 0.5)))))) + (define/public (suck-pollen pos size) + (with-primitive pollen + (pdata-index-fold + (lambda (i p c r) + (cond ((< (vdist pos p) (/ size 10)) + (pdata-set! "p" i (vector -1000 0 0)) + (cons c r)) + ((< (vdist pos p) size) + (pdata-set! "p" i (vadd p + (vmul (vnormalise (vsub pos p)) 0.1))) + r) + (else r))) + '() + "p" "c"))) + (super-new) (init))) @@ -306,25 +349,77 @@ (init-field (pos (vector 0 0 0)) (col (vector 1 1 1)) - (plant-desc '())) + (plant-desc '()) + (flower-list '()) + (current-flower 0)) (field (root-component 0) (spray-t 0)) + (define/public (get-pos) + pos) + + (define/public (get-col) + col) + + (define/public (get-desc) + plant-desc) + (define/public (init) (with-state (hint-depth-sort) ;(parent (send world get-root)) - ;(colour col) + (colour col) (hint-unlit) (translate pos) (printf "building from:~a~n" plant-desc) - (set! root-component (build-component "1-0" plant-desc)))) + (set! root-component (build-component "1-1" col plant-desc)) + (set! flower-list (component-leaves root-component)))) - (define/public (destroy-plant) - (destroy root)) + (define/public (destroy-me) + (destroy (component-root root-component))) + + (define/public (player-update world network) + (when (key-special-pressed 100) + (set! current-flower (modulo (+ current-flower 1) (length flower-list)))) + + (when (key-special-pressed 102) + (set! current-flower (modulo (- current-flower 1) (length flower-list)))) + + + ; bit odd, have to go through network to tell other clients to + ; spray, and need to get the id of the player plant from the world... + (when (key-special-pressed 101) + (send network spray world (send world get-my-id) current-flower 0)) + + (let ((flower (list-ref flower-list current-flower))) + + (with-primitive (component-root flower) + (when (key-special-pressed 103) + (rotate (vector 0 0 20)) + (let ((colours (suck world current-flower))) + (when (not (zero? (length colours))) + (let + ((av-col (vdiv (foldl vadd (vector 0 0 0) colours) (length colours)))) + + (set-component-col! flower + (vadd (vmul (component-col flower) 0.9) + (vmul av-col 0.1))) + + (send network flower-update world (send world get-my-id) + current-flower (component-col flower)))))) + + + (rotate (vector 0 0 2))))) + + (define/public (flower-update flower col) + (let ((flower (list-ref flower-list flower))) + (set-component-col! flower col) + (with-primitive (component-root flower) + (colour (component-col flower))))) + (define/public (update world) 0 #;(with-primitive root @@ -333,11 +428,18 @@ (set! spray-t (* spray-t 0.9)) (colour spray-t)))) - (define/public (spray world type) + (define/public (spray world flower type) (let ((pos (vtransform (vector 0 0 0) - (with-primitive (component-root (random-leaf root-component)) + (with-primitive (component-root (list-ref flower-list flower)) (get-global-transform))))) - (send world puff-pollen pos (vector 1 1 1) 0.2 100))) + (send world puff-pollen pos (component-col (list-ref flower-list flower)) + 0.2 10))) + + (define/public (suck world flower) + (let ((pos (vtransform (vector 0 0 0) + (with-primitive (component-root (list-ref flower-list flower)) + (get-global-transform))))) + (send world suck-pollen pos 5))) (super-new) (init))) @@ -347,6 +449,10 @@ (define network-dispatch% (class object% + (field + (waiting #f) + (wait-till 0)) + (define (stringify l) (cond ((null? l) l) @@ -356,47 +462,86 @@ ((number? (car l)) (cons (number->string (car l)) (stringify (cdr l)))) + ((vector? (car l)) + (cons (car l) + (stringify (cdr l)))) ((list? (car l)) (cons (stringify (car l)) (stringify (cdr l)))) (else (error "oops")))) - (define/public (dispatch world) + (define (dispatch world) (cond - ((osc-msg "/add-plant") - (printf "add plant message recieved : ~a~n" (osc 6)) - (send world add-entity (make-object plant% - (vector (osc 0) (osc 1) (osc 2)) - (vector (osc 3) (osc 4) (osc 5)) - (stringify (eval-string (osc 6)))))) + ((osc-msg "/join-game") + (printf "a new plant has joined the game~n") + ; send a plant update for the new player + (update-plant world) ) + + ((osc-msg "/plant") + (printf "add plant message recieved : ~a~n" (osc 0)) + (send world set-entity (osc 0) (make-object plant% + (vector (osc 1) (osc 2) (osc 3)) + (vector (osc 4) (osc 5) (osc 6)) + (stringify (eval-string (osc 7)))))) + + ((osc-msg "/flower") + (printf "flower change msg recieved~n") + (send (send world get-entity (osc 0)) flower-update + (osc 1) (vector (osc 2) (osc 3) (osc 4)))) + ((osc-msg "/destroy-plant") (printf "destroy plant message recieved...~n") (send world destroy-entity (osc 0))) + ((osc-msg "/spray") ; (printf "destroy plant message recieved...~n") - (send (send world get-entity (osc 0)) spray world (osc 1))))) + (let ((e (send world get-entity (osc 0)))) + ; it's possible to get spray events before the + ; plant has been created... + (when e + (send e spray world (osc 1) (osc 2))))))) - (define/public (add-plant world) - (printf "sending add plant...~n") + (define/public (join-game world) + (printf "sending join-game~n") + (osc-send "/join-game" "" (list)) + (set! wait-till (+ (time) 2)) + (set! waiting #t)) + + (define/public (update-plant world) + (printf "sending /plant...~n") - (let* ((pos (vector (* (crndf) 5) 2 1)) - (col (rndvec)) - (desc (list (make-random-plant 0))) - (desc-str (format "'~a" desc))) - (printf "sending:~a~n" desc-str) - (osc-send "/add-plant" "ffffffs" (list (vx pos) (vy pos) (vz pos) - (vx col) (vy col) (vz col) desc-str)) - (send world add-entity (make-object plant% pos col desc)))) + (let* ((my-plant (send world get-entity (send world get-my-id))) + (pos (send my-plant get-pos)) + (col (send my-plant get-col)) + (desc-str (format "'~a" (send my-plant get-desc)))) + + (osc-send "/plant" "iffffffs" (list (send world get-my-id) + (vx pos) (vy pos) (vz pos) + (vx col) (vy col) (vz col) + desc-str)))) (define/public (destroy-plant world id) (printf "sending destroy plant...~n") (osc-send "/destroy-plant" "i" (list id)) (send world destroy-entity id)) - (define/public (spray world id type) - ; (printf "sending destroy plant...~n") - (osc-send "/spray" "ii" (list id type)) - (send (send world get-entity id) spray world type)) + (define/public (spray world id flower type) + (osc-send "/spray" "iii" (list id flower type)) + (send (send world get-entity id) spray world flower type)) + + (define/public (flower-update world id flower col) + (osc-send "/flower" "iifff" (list id flower (vx col) (vy col) (vz col))) + (send (send world get-entity id) flower-update flower col)) + + + (define/public (update world) + ; wait for all other players to register their plants + (when (and waiting (< wait-till (time))) + (set! waiting #f) + (send world make-my-plant) + (update-plant world)) + (dispatch world)) + (super-new))) @@ -409,13 +554,11 @@ (define w (make-object world% 1)) (define n (make-object network-dispatch%)) +(send n join-game w) (define (animate) - (when (key-pressed " ") (send n add-plant w)) - (send n dispatch w) - (send w update) - (when (and (zero? (random 50)) (not (null? (send w get-entity-list))) ) - (send n spray w (send (send w choose) get-id) 0))) + (send n update w) + (send w update n)) (every-frame (animate))