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

added ambient particles and started work on the logic stuff

Browse source
This commit is contained in:
Dave Griffiths 2009-06-23 16:45:26 +01:00
parent c465ec71ae
commit 655ea3be51
3 changed files with 316 additions and 42 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
plant-eyes/README Normal file
View file

@ -0,0 +1,2 @@
i've split off the logic code while I work on it - it will eventually replace
plant-eyes.scm

253
plant-eyes/plant-eyes-logic.scm Normal file
View file

@ -0,0 +1,253 @@
#lang scheme/base
(require fluxus-016/drflux)
(require scheme/class)
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; p l a n t e y e s
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; notes:
; keeping with a view/model client/server render/logic separation, although
; not sure if it's the right approach yet
; logic side gets ticked at a low frequency
; render side gets ticked at framerate
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; a message for sending betwixt logic and render side
(define message%
(class object%
(init-field
(type 'none) ; a symbol denoting the type of the message
(data '())) ; should be an assoc list map of name to values, eg:
; '((name "archibold") (age 53))
; shouldn't put logic objects in here - 'raw' data only
(define/public (get-data arg-name)
(cadr (assoc arg-name data)))
(super-new)))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; the base class logic object - all logic side objects can
; send messages to the render side at any time by calling add-message
; this takes care of the propagation of information. (not just oo fetish, I hope)
(define game-logic-object%
(class object%
(field
(messages '())
(children '()))
(define/public (send-message msg)
(set! messages (cons msg messages)))
(define/pubment (update) ; need to augement this if we have child logic objects,
(let ((m messages)) ; and call update on them too.
(set! messages '())
(append
(inner ('()) update) ; the augmented method gets called here
m)))
(super-new)))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; a twig, which can contain other twigs things.
; (roots and shoots are both twigs)
(define twig-logic%
(class game-logic-object%
(init-field
(id #f) ; our id (for matching up with the renderer geometry)
(plant #f) ; the plant we belong to
(type 'root) ; or 'shoot
(dir (vector 0 1 0)) ; the general direction we are pointing in
(width 1)) ; the width of this root
(field
(points '()) ; the 3d points for this twig
(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
(inherit send-message)
(define/public (get-type)
type)
(define/public (get-dir)
dir)
(define/public (get-point point-index)
(list-ref points point-index))
(define/public (add-twig point-index twig)
(set! twigs (cons (list point-index twig) twigs)))
(define/public (get-twig point-index)
(cadr (assq point-index twigs)))
(define/public (add-ornament point-index ornament)
; tell the renderer something has occurred
(send-message (make-object message% 'new-ornament
(list
(send plant get-id)
id
point-index)))
(set! ornaments (cons (list point-index ornament) ornaments)))
(define/public (get-ornament point-index)
(cadr (assq point-index ornaments)))
; adds the ornament if it's close, and checks sub-twigs
; returns true if it's succeded
(define/public (check/add-ornament pickup)
; check each point in our twig
(let ((found (foldl
(lambda (point found)
; if we havent found anything yet and it's intersecting
(cond ((and (not found) (< (vdist point (send pickup get-pos)) (+ width (send pickup get-size))))
(add-ornament (send pickup create-ornament plant))
#t)
(else #f)))
#f
points)))
; now check each sub-twig
(if (not found)
(foldl
(lambda (twig found)
(if (not found)
(send twig check/add-ornament)
#f))
#f
twigs)
found)))
(define/augment (update)
(append
(map
(lambda (ornament)
(send ornament update))
ornaments)
(map
(lambda (twig)
(send twig update))
twigs)))
(super-new)))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; abilities live on twigs, and can do things.
; this is the base class for all abilities.
(define ornament-logic%
(class game-logic-object%
(init-field
(plant #f) ; the plant we belong to
(twig #f) ; the twig we are on
(point-index -1)) ; the index to the point on our twig
(field
(pos (send twig get-point point-index))) ; figure out the position here
(define/public (get-pos)
pos)
(super-new)))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; pickups map to abilities, and live out in space
; this is the base class for all pickups.
(define pickup-logic%
(class game-logic-object%
(field
(type 'none)
(pos (vector 0 0 0)))
(define/public (get-pos)
pos)
; converts pickup->ormament
; override this
(define/public (create-ornament plant)
(make-object ornament-logic% plant)) ; todo twig/point-index???
(super-new)))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(define plant-logic%
(class game-logic-object%
(init-field
(pos (vector 0 0 0)))
(field
(twigs '()) ; a assoc list map of ages to twigs
(age 0) ; the age of this plant
(max-twigs 10)) ; the maximum twigs allowed at any time - oldest removed first
(define/public (check/add-ornament pickup)
(foldl
(lambda (twig found)
(if (not found)
(send twig check/add-ornament pickup)
#f))
#f
twigs))
(define/public (destroy-twig twig)
0)
; a util to keep a fixed size list of twigs, calling destroy twig when needed.
(define (cons-twig thing in count out)
(cond
((null? in)
(cons thing out))
((zero? count)
(destroy-twig (car in))
(cons thing out))
(else (cons-twig thing (cdr in) (- count 1) (append out (list (car in)))))))
(define/public (add-twig twig)
(set! twigs (cons-twig twig twigs max-twigs '())))
(define/augment (update)
(map
(lambda (twig)
(send twig update))
twigs))
(super-new)))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
(define game-logic%
(class game-logic-object%
(field
(plants '())
(pickups '()))
(define/public (add-plant plant)
(set! plants (cons plant plants)))
(define/public (add-pickups pickup)
(set! pickups (cons pickup pickups)))
; todo - distribute the checking of stuff like
; this to a random selection of pickups/plants
; to distribute the cpu load
(define/augment (update)
(for-each
(lambda (pickup)
(for-each
(lambda (plant)
(send plant check/add-ormament pickup))
plants))
pickups)
(map
(lambda (plant)
(send plant update))
plants))
(super-new)))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

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

@ -1,49 +1,54 @@
#lang scheme/base
(require fluxus-016/drflux)
(require scheme/class)
(clear)
(define (build-ring n sr er)
;=====================================================================
(clear)
(define (build-ring n sr er)
(let ((p (build-polygons (+ (* n 2) 2) 'triangle-strip)))
(with-primitive p
(pdata-index-map!
(lambda (i p)
(let ((a (* (/ (quotient i 2) n) (* 2 3.141)))
(s (* (if (odd? i) sr er) 5)))
(vector (* (cos a) s) (* (sin a) s) (if (odd? i) 0 5 ))))
"p")
(with-primitive p
(pdata-index-map!
(lambda (i p)
(let ((a (* (/ (quotient i 2) n) (* 2 3.141)))
(s (* (if (odd? i) sr er) 5)))
(vector (* (cos a) s) (* (sin a) s) (if (odd? i) 0 5 ))))
"p")
(recalc-normals 1))
p))
(recalc-normals 1))
p))
(define camera (build-locator))
(define camera (build-locator))
(define twig%
(define twig%
(class object%
(init-field
(size 100)
(radius 1)
(speed 0.2))
(field
(root (build-locator))
(child-twigs '())
(age 0)
(tx (mident))
(next-ring-time 0))
(init-field
(size 100)
(radius 1)
(speed 0.2))
(field
(root (build-locator))
(child-twigs '())
(age 0)
(tx (mident))
(next-ring-time 0))
(define/public (build pos dir)
(with-primitive root
(translate pos)
(cond (dir
(concat (maim dir (vector 0 0 1)))
(rotate (vector 0 -90 0)))
(else (rotate (vmul (crndvec) 20))))))
(define/public (build pos dir)
(with-primitive root
(translate pos)
(cond (dir
(concat (maim dir (vector 0 0 1)))
(rotate (vector 0 -90 0)))
(else (rotate (vmul (crndvec) 20))))))
(define/public (update t)
(define/public (update t)
(for-each
(lambda (child)
(send child update t))
child-twigs)
(for-each
(lambda (child)
(send child update t))
child-twigs)
(when (and (< age size) (< next-ring-time t))
(set! next-ring-time (+ t speed))
@ -123,7 +128,21 @@
(class object%
(field
(twigs '())
(pickups (build-list 10 (lambda (_)
(nutrients (let ((p (with-state
(hint-depth-sort)
(texture (load-texture "textures/particle.png"))
(build-particles 5000))))
(with-primitive p
(pdata-map!
(lambda (p)
(vmul (vadd (crndvec) (vector 0 -1 0)) 90))
"p")
(pdata-map!
(lambda (s)
(vector 1 1 1))
"s"))
p))
(pickups (build-list 1 (lambda (_)
(make-object pickup% (vmul (vsub (crndvec) (vector 0 1 0)) 50)))))
(indicator (let ((p (with-state
(hint-depth-sort)