added ambient particles and started work on the logic stuff
This commit is contained in:
parent
c465ec71ae
commit
655ea3be51
3 changed files with 316 additions and 42 deletions
2
plant-eyes/README
Normal file
2
plant-eyes/README
Normal 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
253
plant-eyes/plant-eyes-logic.scm
Normal 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)))
|
||||
|
||||
|
||||
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
|
||||
|
|
@ -1,50 +1,55 @@
|
|||
#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")
|
||||
|
||||
(recalc-normals 1))
|
||||
p))
|
||||
|
||||
(define camera (build-locator))
|
||||
|
||||
(define twig%
|
||||
(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))
|
||||
|
||||
(define camera (build-locator))
|
||||
|
||||
(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 (update t)
|
||||
|
||||
(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))))))
|
||||
(for-each
|
||||
(lambda (child)
|
||||
(send child update t))
|
||||
child-twigs)
|
||||
|
||||
(define/public (update t)
|
||||
|
||||
(for-each
|
||||
(lambda (child)
|
||||
(send child update t))
|
||||
child-twigs)
|
||||
|
||||
(when (and (< age size) (< next-ring-time t))
|
||||
(set! next-ring-time (+ t speed))
|
||||
(let ((p (with-state
|
||||
|
@ -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)
|
||||
|
|
Loading…
Reference in a new issue