From 655ea3be518c76eb49051d053ebdcffafb7e3289 Mon Sep 17 00:00:00 2001 From: Dave Griffiths Date: Tue, 23 Jun 2009 16:45:26 +0100 Subject: [PATCH] added ambient particles and started work on the logic stuff --- plant-eyes/README | 2 + plant-eyes/plant-eyes-logic.scm | 253 ++++++++++++++++++++++++++++++++ plant-eyes/plant-eyes.scm | 103 +++++++------ 3 files changed, 316 insertions(+), 42 deletions(-) create mode 100644 plant-eyes/README create mode 100644 plant-eyes/plant-eyes-logic.scm diff --git a/plant-eyes/README b/plant-eyes/README new file mode 100644 index 0000000..792629e --- /dev/null +++ b/plant-eyes/README @@ -0,0 +1,2 @@ +i've split off the logic code while I work on it - it will eventually replace +plant-eyes.scm diff --git a/plant-eyes/plant-eyes-logic.scm b/plant-eyes/plant-eyes-logic.scm new file mode 100644 index 0000000..c5fe31b --- /dev/null +++ b/plant-eyes/plant-eyes-logic.scm @@ -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))) + + +;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + \ No newline at end of file diff --git a/plant-eyes/plant-eyes.scm b/plant-eyes/plant-eyes.scm index 865ab78..2de4726 100644 --- a/plant-eyes/plant-eyes.scm +++ b/plant-eyes/plant-eyes.scm @@ -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)