sucking, flower changes, all networked...
This commit is contained in:
Dave Griffiths
parent
26db0d47c1
commit
38aa608687
1 changed files with 200 additions and 57 deletions
|
|
@ -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,24 +349,76 @@
|
|||
(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
|
||||
|
|
@ -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))
|
||||
|
||||
(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))))
|
||||
(define/public (update-plant world)
|
||||
(printf "sending /plant...~n")
|
||||
|
||||
(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))
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue