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

pickups working again, added world builder script

Browse source
This commit is contained in:
Dave Griffiths 2009-08-04 09:06:14 +01:00
parent 179899697d
commit 8a621cde3c
10 changed files with 1074 additions and 716 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
plant-eyes/controller.ss
View file

@ -66,7 +66,7 @@
(define/public (update)
(define/public (update t d)
(when (and (key-pressed " ") (not current-twig-growing))
(set! last-pos pos)
(cond (current-twig
@ -83,7 +83,7 @@
(set! current-twig-growing #t))))
(when (and (key-pressed "f") current-twig-growing)
(let ((vel (vmul fwd -0.1)))
(let ((vel (vmul fwd (* d -3))))
(when
(not (collide? (list pos (vadd pos vel)) (send game-view get-stones)))
(set! pos (vadd pos vel))

117
plant-eyes/game-modes.ss Normal file
View file

@ -0,0 +1,117 @@
#lang scheme
(require scheme/class fluxus-016/fluxus "logic.ss" "view.ss" "controller.ss" "client.ss" "jabberer.ss" "list-utils.ss")
(provide (all-defined-out))
(define-struct player-info (jid pass tex pos col))
(define gui-game-mode%
(class object%
(init-field
(seed-obs '()))
(field
(players (list
(make-player-info "plant0000001@fo.am" "plant0000001"
"textures/plant0000001.png" (list-ref (list-ref seed-obs 0) 1)
(vector 0.5 1 0.5))
(make-player-info "plant0000002@fo.am" "plant0000002"
"textures/plant0000002.png" (list-ref (list-ref seed-obs 1) 1)
(vector 0.5 1 0))
(make-player-info "plant0000003@fo.am" "plant0000003"
"textures/plant0000003.png" (list-ref (list-ref seed-obs 2) 1)
(vector 0 1 0.5))
(make-player-info "plant0000004@fo.am" "plant0000004"
"textures/plant0000004.png" (list-ref (list-ref seed-obs 3) 1)
(vector 0.75 1 0.5))
(make-player-info "plant0000005@fo.am" "plant0000005"
"textures/plant0000005.png" (list-ref (list-ref seed-obs 4) 1)
(vector 0.5 1 0.75))
))
(seeds '())
(clicked -1))
(define/public (get-player-info)
(list-ref players clicked))
(define/public (setup)
(let ((c 0))
(set! seeds (map
(lambda (pi)
(with-state
(translate (vmul (vector (sin (* 2 3.141 (/ c (length players))))
(cos (* 2 3.141 (/ c (length players)))) 0) 4))
;(texture (load-texture (player-info-tex pi)))
(colour (player-info-col pi))
(set! c (+ c 1))
;(shader "shaders/toon.vert.glsl" "shaders/toon.frag.glsl")
(load-primitive "meshes/seed.obj")))
players))))
(define/public (update t d)
(for-each
(lambda (seed)
(with-primitive seed
(rotate (vector 0 1 0))))
seeds)
(cond
((mouse-button 1)
(let ((o (mouse-over)))
(cond
(o
(set! clicked (which-element o seeds 0))
(when clicked
(for-each
(lambda (seed)
(destroy seed))
seeds))
(if clicked #t #f))
(else
#f))))
(else
#f)))
(super-new)))
(define main-game-mode%
(class object%
(init-field
(world-list '()))
(field
(gl (make-object game-logic%))
(gv (make-object game-view%))
(c (make-object controller% gv))
(cl #f)
(tick-time 0)
(player #f)
(logic-tick 0.5)) ; time between logic updates
(define/public (setup pi)
(set! cl (make-object client% (player-info-jid pi) (player-info-pass pi)))
(set! player (make-object plant-logic%
(player-info-jid pi)
(player-info-pos pi)
(player-info-col pi)
(player-info-tex pi)))
(send c set-player-plant player)
(send gl add-player player)
(send c setup)
(send gv setup world-list)
(send gl setup world-list)
(send cl setup))
(define/public (update t d)
(when (< tick-time t)
(let ((messages (send gl update)))
; pass the messages to the network client
(send gv update t d (send cl update messages gl))) ; and the game view
(set! tick-time (+ t logic-tick)))
(send gv update t d '())
(send c update t d))
(super-new)))

20
plant-eyes/logic.ss
View file

@ -14,7 +14,7 @@
(define num-pickups 10)
(define pickup-dist-radius 200)
(define pickup-size 1)
(define ornament-grow-probability 4)
(define ornament-grow-probability 8)
(define curl-amount 40)
(define start-size 50)
@ -219,7 +219,8 @@
(lambda (point found)
(set! i (+ i 1))
; if we havent found anything yet and it's intersecting
(cond ((and (not found) (< (vdist point (send pickup get-pos))
(cond ((and (not found) (< (vdist (vadd (send plant get-pos) point)
(send pickup get-pos))
(+ width (send pickup get-size))))
(send plant add-property (send pickup get-type))
(send pickup pick-up) ; this will remove the pickup for us
@ -447,7 +448,7 @@
(when twig
(let
((property (choose properties))
(point-index (random (send twig get-length))))
(point-index (+ 1 (random (- (send twig get-length) 2)))))
(when (not (eq? property 'curly))
(send twig add-ornament point-index
@ -481,10 +482,15 @@
(inherit send-message)
(define/public (setup)
(for ((i (in-range 0 num-pickups)))
(add-pickup (make-object pickup-logic% i (choose (list 'leaf 'curly 'wiggle))
(vmul (srndvec) pickup-dist-radius)))))
(define/public (setup world-list)
(let ((pickups (list-ref world-list 1)))
(let ((i 0))
(for-each
(lambda (pickup)
(add-pickup (make-object pickup-logic% i (choose (list 'leaf))
(list-ref pickup 1)))
(set! i (+ i 1)))
pickups))))
(define/public (add-player plant)
(printf "new player plant added ~a~n" (send plant get-id))

1356
plant-eyes/meshes/leaf.obj
View file

File diff suppressed because it is too large Load diff

123
plant-eyes/plant-eyes.scm
View file

@ -1,6 +1,6 @@
;#lang scheme/base
;(require fluxus-016/drflux)
(require scheme/class "logic.ss" "view.ss" "controller.ss" "client.ss" "jabberer.ss" "list-utils.ss")
(require scheme/class "game-modes.ss" "logic.ss" "view.ss" "controller.ss" "client.ss" "jabberer.ss" "list-utils.ss")
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; p l a n t e y e s
@ -35,117 +35,25 @@
; * in the same way, the line segments can be created in any way by the logic
; side - eg. lsystem, or different methods per plant (or per twig even)
(define-struct player-info (jid pass tex pos col))
(define gui-game-mode%
(class object%
(field
(players (list
(make-player-info "plant0000001@fo.am" "plant0000001"
"textures/plant0000001.png" (vector 11.682296752929688 -27.272457122802734 -2.8969409465789795) (vector 0.5 1 0.5))
(make-player-info "plant0000002@fo.am" "plant0000002"
"textures/plant0000002.png" (vector 22.92951774597168 -24.62310218811035 -4.961982727050781) (vector 0.5 1 0))
(make-player-info "plant0000003@fo.am" "plant0000003"
"textures/plant0000003.png" (vector 11.626119613647461 -24.734521865844727 -25.146560668945312) (vector 0 1 0.5))
(make-player-info "plant0000004@fo.am" "plant0000004"
"textures/plant0000004.png" (vector -18.757593154907227 -10.819361686706543 37.17854690551758)(vector 0.75 1 0.5))
(make-player-info "plant0000005@fo.am" "plant0000005"
"textures/plant0000005.png" (vector -10.964780807495117 -20.065677642822266 23.76084327697754) (vector 0.5 1 0.75))
))
(seeds '())
(clicked -1))
(define/public (get-player-info)
(list-ref players clicked))
(define/public (setup)
(let ((c 0))
(set! seeds (map
(lambda (pi)
(with-state
(translate (vmul (vector (sin (* 2 3.141 (/ c (length players))))
(cos (* 2 3.141 (/ c (length players)))) 0) 4))
;(texture (load-texture (player-info-tex pi)))
(colour (player-info-col pi))
(set! c (+ c 1))
;(shader "shaders/toon.vert.glsl" "shaders/toon.frag.glsl")
(load-primitive "meshes/seed.obj")))
players))))
(define/public (update t d)
(for-each
(lambda (seed)
(with-primitive seed
(rotate (vector 0 1 0))))
seeds)
(cond
((mouse-button 1)
(let ((o (mouse-over)))
(cond
(o
(set! clicked (which-element o seeds 0))
(when clicked
(for-each
(lambda (seed)
(destroy seed))
seeds))
(if clicked #t #f))
(else
#f))))
(else
#f)))
(super-new)))
(define main-game-mode%
(class object%
(field
(gl (make-object game-logic%))
(gv (make-object game-view%))
(c (make-object controller% gv))
(cl #f)
(tick-time 0)
(player #f)
(logic-tick 0.5)) ; time between logic updates
(define/public (setup pi)
(set! cl (make-object client% (player-info-jid pi) (player-info-pass pi)))
(set! player (make-object plant-logic%
(player-info-jid pi)
(player-info-pos pi)
(player-info-col pi)
(player-info-tex pi)))
(send c set-player-plant player)
(send gl add-player player)
(send c setup)
(send gv setup)
(send gl setup)
(send cl setup))
(define/public (update t d)
(when (< tick-time t)
(let ((messages (send gl update)))
; pass the messages to the network client
(send gv update t d (send cl update messages gl))) ; and the game view
(set! tick-time (+ t logic-tick)))
(send gv update t d '())
(send c update))
(super-new)))
(define world-list (let* ((f (open-input-file "world.txt"))
(o (list (read f)(read f)(read f))))
(close-input-port f)
o))
(clear)
(clear-shader-cache)
(define mode 'gui)
(define gui (make-object gui-game-mode%))
(define game (make-object main-game-mode%))
(define gui (make-object gui-game-mode% (list-ref world-list 0)))
(define game (make-object main-game-mode% world-list))
(send gui setup)
;(define t 0)
;(define d 0.02)
;(define (flxtime) t)
;(define (update-time) (set! t (+ t d)))
;(define (delta) d)
(define (animate)
(cond
((eq? mode 'gui)
@ -153,6 +61,9 @@
(send game setup (send gui get-player-info))
(set! mode 'game)))
((eq? mode 'game)
(send game update (flxtime) (delta)))))
(send game update (flxtime) (delta))))
#;(update-time))
(every-frame (animate))
;(start-framedump "pe7" "jpg")

1
plant-eyes/stones.txt
View file

File diff suppressed because one or more lines are too long

BIN
plant-eyes/textures/leaf.png
View file

Binary file not shown.
Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 2.6 KiB

After

Width:  |  Height:  |  Size: 46 KiB

51
plant-eyes/view.ss
View file

@ -15,31 +15,30 @@
(define wire-mode #f)
(define fog-col (earth-colour))
(define fog-strength 0.001)
(define max-ornaments 2) ; per twig
(define max-ornaments 30) ; per twig
(define default-grow-speed 0.5)
(when audio-on (oa-start)) ;; start openAL audio
(define stones-list (let* ((f (open-input-file "stones.txt"))
(o (read f)))
(close-input-port f)
o))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(define ornament-view%
(class object%
(init-field
(pos (vector 0 0 0))
(sc 1)
(dir (vector 0 0 1))
(property 'none)
(time 0))
(field
(rot (vmul (rndvec) 360))
(const-scale 2)
(rot (vector 0 0 0))
(root (with-state
(translate pos)
(rotate rot)
(scale 0.01)
(concat (maim dir (vector 0 1 0)))
(scale (* const-scale sc))
;(shader "shaders/textoon.vert.glsl" "shaders/textoon.frag.glsl")
(cond
((eq? property 'wiggle)
; (opacity 1)
@ -47,9 +46,11 @@
(colour (vector 0.5 0.0 0.0))
(load-primitive "meshes/wiggle.obj"))
((eq? property 'leaf)
(colour (vector 0.8 1 0.6))
(texture (load-texture "textures/leaf2.png"))
(load-primitive "meshes/leaf.obj"))
(colour (vector 0.8 1 0.6))
(texture (load-texture "textures/leaf.png"))
(set! rot (vector 0 0 0))
(hint-origin)
(load-primitive "meshes/leaf.obj"))
(else (error ""))))))
(define/public (update t d)
@ -57,8 +58,9 @@
(with-primitive root
(identity)
(translate pos)
(rotate rot)
(scale (* 0.2 time)))
(concat (maim dir (vector 0 1 0)))
(rotate rot)
(scale (* const-scale sc 0.2 time)))
(set! time (+ time (* 0.1 d)))))
(super-new)))
@ -79,12 +81,16 @@
(rotate rot)
(colour (pickup-colour))
(scale 0.3)
;(shader "shaders/textoon.vert.glsl" "shaders/textoon.frag.glsl")
(texture
(cond
((eq? type 'wiggle) (load-texture "textures/wiggle.png"))
((eq? type 'leaf) (load-texture "textures/leaf.png"))
((eq? type 'curly) (load-texture "textures/curl.png"))))
(load-primitive "meshes/pickup.obj")))
(cond
((eq? type 'wiggle) (load-primitive "meshes/pickup.obj"))
((eq? type 'leaf) (load-primitive "meshes/leaf.obj"))
((eq? type 'curly) (load-primitive "meshes/pickup.obj")))))
(from pos)
(destination (vector 0 0 0))
(speed 0.05)
@ -204,6 +210,9 @@
(set! ornaments (cons (list point-index
(make-object ornament-view%
(get-point point-index)
(get-width point-index)
(vnormalise (vsub (get-point point-index)
(get-point (- point-index 1))))
property))
ornaments)))))
@ -393,7 +402,7 @@
"point")
(pdata-map!
(lambda (point)
(* 0.12 (+ 0.1 (rndf))))
(* 3 (+ 0.1 (rndf))))
"speed")
(pdata-map!
(lambda (offset)
@ -488,9 +497,9 @@
(send (cadr new-twig) get-point new-point)))
((< (vdist (vadd (send twig get-point point) offset) p) 0.1)
(pdata-set! "point" i (- point 1))
(vadd p (vmul (vnormalise (vsub (vadd (send twig get-point (- point 1)) offset) p)) speed)))
(vadd p (vmul (vnormalise (vsub (vadd (send twig get-point (- point 1)) offset) p)) (* speed d))))
(else
(vadd p (vmul (vnormalise (vsub (vadd (send twig get-point point) offset) p)) speed))))))
(vadd p (vmul (vnormalise (vsub (vadd (send twig get-point point) offset) p)) (* speed d)))))))
"p" "twig" "point" "offset" "speed"))))
(define/public (update t d)
@ -603,7 +612,7 @@
(stones '()))
(define/public (setup)
(define/public (setup world-list)
(let ((l (make-light 'point 'free)))
(light-diffuse 0 (vector 0.5 0.5 0.5))
(light-diffuse l (vector 1 1 1))
@ -627,7 +636,7 @@
(load-primitive (list-ref stone 0)))))
(with-primitive p (apply-transform) (recalc-bb)) ; apply the transform to speed up the ray tracing, don't have to tranform the ray into object space
p))
stones-list)))
(list-ref world-list 2))))
(define/public (get-stones)
stones)

117
plant-eyes/world-build.scm Normal file
View file

@ -0,0 +1,117 @@
(define-struct ob (type mesh (pos #:mutable) size rot (root #:mutable)))
(define stone-models (list
; "meshes/fork.obj"
"meshes/stone1.obj"
"meshes/stone2.obj"
"meshes/stone3.obj"))
(define pickup-models (list
"meshes/leaf.obj"))
(define (extract-list t l)
(foldl
(lambda (ob l)
(if (eq? (ob-type ob) t)
(cons (list
(ob-mesh ob)
(ob-pos ob)
(ob-size ob)
(ob-rot ob)) l) l))
'()
l))
(define (write-out fn s)
(let ((f (open-output-file fn)))
(write (extract-list 'seed s) f)
(write (extract-list 'pickup s) f)
(write (extract-list 'stone s) f)
(close-output-port f)))
(define (choose l)
(list-ref l (random (length l))))
(define (init num-seeds num-pickups num-stones area size)
(append
(build-list num-seeds
(lambda (_)
(make-ob 'seed "meshes/seed.obj"
(vmul (srndvec) (* size area 0.5))
(* 0.12 50)
(vmul (rndvec) 0) 0)))
(build-list num-pickups
(lambda (_)
(make-ob 'pickup (choose pickup-models)
(vmul (srndvec) area)
0.1
(vmul (rndvec) 360) 0)))
(build-list num-stones
(lambda (_)
(make-ob 'stone (choose stone-models)
(vmul (srndvec) area)
(* size (- 1 (expt (rndf) 2)))
(vmul (rndvec) 360) 0)))))
(define (build l)
(for-each
(lambda (ob)
(set-ob-root! ob (with-state
(cond
((eq? (ob-type ob) 'seed) (colour (vector 0 1 0)))
((eq? (ob-type ob) 'pickup) (colour (vector 1 1 0)))
((eq? (ob-type ob) 'stone) (colour (vector 1 0.5 0))))
(load-primitive (ob-mesh ob)))))
l))
(define (relax l amount)
(for-each
(lambda (ob)
(set-ob-pos! ob (foldl
(lambda (other r)
(cond ((< (vdist (ob-pos ob) (ob-pos other)) (* 5 (+ (ob-size ob) (ob-size other))))
(vadd r (vmul (vnormalise (vsub (ob-pos ob) (ob-pos other))) amount)))
(else r)))
(cond ((> (vy (ob-pos ob)) 0)
(vadd (ob-pos ob) (vector 0 (* amount -30) 0)))
(else (ob-pos ob)))
l)))
l))
(define (update l)
(for-each
(lambda (ob)
(with-primitive (ob-root ob)
(identity)
(translate (ob-pos ob))
(rotate (ob-rot ob))
(scale (ob-size ob))))
l))
(clear)
(clear-colour 0)
(define s (init 5 30 200 1 10))
(build s)
(define l (make-light 'spot 'free))
(light-diffuse 0 (vector 0 0 0))
(light-specular 0 (vector 0 0 0))
(light-diffuse l (vector 1 1 1))
(light-position l (vector 0 1000 0))
(light-specular l (vector 0.1 0.1 0.1))
(define done #f)
(define (animate)
(when (key-pressed "s") (write-out "world.txt" s))
(relax s 0.1)
(update s))
(every-frame (animate))

1
plant-eyes/world.txt Normal file
View file

File diff suppressed because one or more lines are too long