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

sucking, flower changes, all networked...

Browse source
This commit is contained in:
Dave Griffiths 2009-03-13 12:43:08 +00:00
parent 26db0d47c1
commit 38aa608687
1 changed files with 200 additions and 57 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

257
hayfever/hayfever.scm
View file

@ -88,9 +88,9 @@
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; a plant component ; 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 (cond
((null? children) ((null? children)
(let ((root (with-state (let ((root (with-state
@ -98,7 +98,7 @@
(rotate (vector 0 0 180)) (rotate (vector 0 0 180))
(texture (load-texture (string-append "textures/comp-" id ".png"))) (texture (load-texture (string-append "textures/comp-" id ".png")))
(build-plane)))) (build-plane))))
(make-component root '()))) (make-component root col '())))
(else (else
(let* ((connection-list (get-connection-list id)) (let* ((connection-list (get-connection-list id))
(root (with-state (root (with-state
@ -106,7 +106,7 @@
(rotate (vector 0 0 180)) (rotate (vector 0 0 180))
(texture (load-texture (string-append "textures/comp-" id ".png"))) (texture (load-texture (string-append "textures/comp-" id ".png")))
(build-plane))) (build-plane)))
(comp (make-component root (comp (make-component root col
(map (map
(lambda (child connection) (lambda (child connection)
(with-state (with-state
@ -115,7 +115,7 @@
(rotate (vector 0 0 (2dvec->angle (rotate (vector 0 0 (2dvec->angle
(vx connection) (- (vy connection) 0.5)))) (vx connection) (- (vy connection) 0.5))))
(rotate (vector 0 0 0)) (rotate (vector 0 0 0))
(build-component (car child) (cadr child)))) (build-component (car child) col (cadr child))))
children children
connection-list)))) connection-list))))
(with-primitive root (apply-transform)) (with-primitive root (apply-transform))
@ -126,6 +126,15 @@
((null? (component-children component)) component) ((null? (component-children component)) component)
(else (random-leaf (choose (component-children 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) (define (component-print component)
(printf "~a~n" (component-children component))) (printf "~a~n" (component-children component)))
@ -137,9 +146,11 @@
(list-ref l (random (length l)))) (list-ref l (random (length l))))
(define (make-random-plant depth) (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 (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 1) (list "1-1" (list (make-random-plant (+ depth 1)))))
((eq? num-children 2) (list "2-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))))) (make-random-plant (+ depth 1)))))
@ -165,7 +176,8 @@
(root 0) (root 0)
(entity-list '()) (entity-list '())
(id 0) (id 0)
(pollen 0)) (pollen 0)
(my-id 0))
(define/public (init) (define/public (init)
@ -186,7 +198,7 @@
"c") "c")
(pdata-map! (pdata-map!
(lambda (c) (lambda (c)
(let ((s (* 0.1 (grndf)))) (let ((s (* 0.2 (grndf))))
(vector s s 1))) (vector s s 1)))
"s")) "s"))
@ -195,7 +207,7 @@
(rotate (vector 90 0 0)) (rotate (vector 90 0 0))
(scale 100) (scale 100)
(build-plane))) (build-plane)))
(with-state #;(with-state
(hint-depth-sort) (hint-depth-sort)
; (parent root) ; (parent root)
(with-state (with-state
@ -207,19 +219,26 @@
(hint-unlit) (hint-unlit)
(build-plane)) (build-plane))
(with-state (with-state
(scale (vector 19 8 1)) (scale (vector 19 5 1))
(translate (vector 0 0.2 1.5)) (translate (vector 0 0.2 1.5))
(rotate (vector 0 0 180)) (rotate (vector 0 0 180))
(texture (load-texture "textures/mid.png")) (texture (load-texture "textures/mid.png"))
(hint-unlit) (hint-unlit)
(build-plane)))) (build-plane))))
(define (inc-id!)
(set! id (+ id 1)))
(define/public (get-entity-list) (define/public (get-entity-list)
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) (define/public (get-entity id)
(foldl (foldl
(lambda (entity ret) (lambda (entity ret)
@ -232,25 +251,34 @@
(define/public (choose) (define/public (choose)
(list-ref entity-list (random (length entity-list)))) (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) (send entity set-id! id)
(set! entity-list (cons entity entity-list)) (set! entity-list (cons entity entity-list)))
id)
(define/public (destroy-entity id) (define/public (destroy-entity id)
(set! plants (set! entity-list
(filter (filter
(lambda (entity) (lambda (entity)
(cond ((eq? (send entity get-id) id) (cond ((eq? (send entity get-id) id)
(send entity destroy) (send entity destroy-me)
#f) #f)
(else #t))) (else #t)))
entity-list))) entity-list)))
(define/public (update) (define/public (update network)
(with-primitive pollen (with-primitive pollen
(animate-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 (for-each
(lambda (entity) (lambda (entity)
(send entity update this)) (send entity update this))
@ -276,10 +304,25 @@
(with-primitive pollen (with-primitive pollen
(for ((i (in-range 0 np))) (for ((i (in-range 0 np)))
(let ((c (random (pdata-size))) (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! "p" c (vadd (vmul (cirndvec) size) pos))
(pdata-set! "c" c (vector (vx cc) (vy cc) (vz cc) 0.5)))))) (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) (super-new)
(init))) (init)))
@ -306,24 +349,76 @@
(init-field (init-field
(pos (vector 0 0 0)) (pos (vector 0 0 0))
(col (vector 1 1 1)) (col (vector 1 1 1))
(plant-desc '())) (plant-desc '())
(flower-list '())
(current-flower 0))
(field (field
(root-component 0) (root-component 0)
(spray-t 0)) (spray-t 0))
(define/public (get-pos)
pos)
(define/public (get-col)
col)
(define/public (get-desc)
plant-desc)
(define/public (init) (define/public (init)
(with-state (with-state
(hint-depth-sort) (hint-depth-sort)
;(parent (send world get-root)) ;(parent (send world get-root))
;(colour col) (colour col)
(hint-unlit) (hint-unlit)
(translate pos) (translate pos)
(printf "building from:~a~n" plant-desc) (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) (define/public (destroy-me)
(destroy root)) (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) (define/public (update world)
0 0
@ -333,11 +428,18 @@
(set! spray-t (* spray-t 0.9)) (set! spray-t (* spray-t 0.9))
(colour spray-t)))) (colour spray-t))))
(define/public (spray world type) (define/public (spray world flower type)
(let ((pos (vtransform (vector 0 0 0) (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))))) (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) (super-new)
(init))) (init)))
@ -347,6 +449,10 @@
(define network-dispatch% (define network-dispatch%
(class object% (class object%
(field
(waiting #f)
(wait-till 0))
(define (stringify l) (define (stringify l)
(cond (cond
((null? l) l) ((null? l) l)
@ -356,47 +462,86 @@
((number? (car l)) ((number? (car l))
(cons (number->string (car l)) (cons (number->string (car l))
(stringify (cdr l)))) (stringify (cdr l))))
((vector? (car l))
(cons (car l)
(stringify (cdr l))))
((list? (car l)) ((list? (car l))
(cons (stringify (car l)) (stringify (cdr l)))) (cons (stringify (car l)) (stringify (cdr l))))
(else (error "oops")))) (else (error "oops"))))
(define/public (dispatch world) (define (dispatch world)
(cond (cond
((osc-msg "/add-plant") ((osc-msg "/join-game")
(printf "add plant message recieved : ~a~n" (osc 6)) (printf "a new plant has joined the game~n")
(send world add-entity (make-object plant% ; send a plant update for the new player
(vector (osc 0) (osc 1) (osc 2)) (update-plant world) )
(vector (osc 3) (osc 4) (osc 5))
(stringify (eval-string (osc 6)))))) ((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") ((osc-msg "/destroy-plant")
(printf "destroy plant message recieved...~n") (printf "destroy plant message recieved...~n")
(send world destroy-entity (osc 0))) (send world destroy-entity (osc 0)))
((osc-msg "/spray") ((osc-msg "/spray")
; (printf "destroy plant message recieved...~n") ; (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) (define/public (join-game world)
(printf "sending add plant...~n") (printf "sending join-game~n")
(osc-send "/join-game" "" (list))
(set! wait-till (+ (time) 2))
(set! waiting #t))
(let* ((pos (vector (* (crndf) 5) 2 1)) (define/public (update-plant world)
(col (rndvec)) (printf "sending /plant...~n")
(desc (list (make-random-plant 0)))
(desc-str (format "'~a" desc))) (let* ((my-plant (send world get-entity (send world get-my-id)))
(printf "sending:~a~n" desc-str) (pos (send my-plant get-pos))
(osc-send "/add-plant" "ffffffs" (list (vx pos) (vy pos) (vz pos) (col (send my-plant get-col))
(vx col) (vy col) (vz col) desc-str)) (desc-str (format "'~a" (send my-plant get-desc))))
(send world add-entity (make-object plant% pos col 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) (define/public (destroy-plant world id)
(printf "sending destroy plant...~n") (printf "sending destroy plant...~n")
(osc-send "/destroy-plant" "i" (list id)) (osc-send "/destroy-plant" "i" (list id))
(send world destroy-entity id)) (send world destroy-entity id))
(define/public (spray world id type) (define/public (spray world id flower type)
; (printf "sending destroy plant...~n") (osc-send "/spray" "iii" (list id flower type))
(osc-send "/spray" "ii" (list id type)) (send (send world get-entity id) spray world flower type))
(send (send world get-entity id) spray world 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))) (super-new)))
@ -409,13 +554,11 @@
(define w (make-object world% 1)) (define w (make-object world% 1))
(define n (make-object network-dispatch%)) (define n (make-object network-dispatch%))
(send n join-game w)
(define (animate) (define (animate)
(when (key-pressed " ") (send n add-plant w)) (send n update w)
(send n dispatch w) (send w update n))
(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)))
(every-frame (animate)) (every-frame (animate))