From cf07513ea7b37b5e051fefb27194a65c160e6a1b Mon Sep 17 00:00:00 2001 From: Dave Griffiths Date: Tue, 23 Jun 2009 17:35:46 +0100 Subject: [PATCH] more plant eyes logic foo --- plant-eyes/plant-eyes-logic.scm | 130 ++++++++++++++++++++++++++++---- 1 file changed, 114 insertions(+), 16 deletions(-) diff --git a/plant-eyes/plant-eyes-logic.scm b/plant-eyes/plant-eyes-logic.scm index c5fe31b..71dcaf0 100644 --- a/plant-eyes/plant-eyes-logic.scm +++ b/plant-eyes/plant-eyes-logic.scm @@ -7,18 +7,34 @@ ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; notes: -; keeping with a view/model client/server render/logic separation, although -; not sure if it's the right approach yet +; +; * keeping with a render/logic separation, although this is quite different to +; the hexagon game. the main advantage is that the logic can be ticked at a +; lower frequency - or even different parts at different rates, whereas the +; renderer side needs ticking every frame +; +; * need to try to keep all the intensive every thing vs every thing checking +; in the logic side, where it can be done over many frames (i'm thinking the +; lags involved with things like nutrients getting absorbed may not matter +; too much in this game) +; +; * using a message passing system to formalise the passing of information on +; the logic side. this makes it possible to have objects sending messages +; at any point, and have them collected up and dispached in the renderer side +; +; * line segments are computed in the logic side, and can be represented any +; way by the renderer - maybe the players plant will be geometry and everyone +; elses will be ribbons (stoopid LOD) -; logic side gets ticked at a low frequency -; render side gets ticked at framerate +(define branch-probability 10) ; as in, one in 10 +(define branch-width-reduction 0.95) ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; 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 + (name '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 @@ -26,6 +42,9 @@ (define/public (get-data arg-name) (cadr (assoc arg-name data))) + (define/public (print) + (printf "msg: ~a ~a~n" name data)) + (super-new))) ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -38,14 +57,22 @@ (messages '()) (children '())) - (define/public (send-message msg) - (set! messages (cons msg messages))) + (define/public (send-message name data) + (set! messages (cons (make-object message% name data) messages))) + ; convert a list of lists in to just a single list - needed to convert + ; the update lists into one big list of messages + (define (flatten l) + (cond + ((null? l) '()) + ((list? (car l)) (append (flatten (car l)) (flatten (cdr l)))) + (else (cons (car l) (flatten (cdr l)))))) + (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 + (flatten (inner (void) update)) ; the augmented method gets called here m))) (super-new))) @@ -69,6 +96,12 @@ (inherit send-message) + (define/public (get-id) + id) + + (define/public (set-id! s) + (set! id s)) + (define/public (get-type) type) @@ -78,7 +111,28 @@ (define/public (get-point point-index) (list-ref points point-index)) + (define/public (grow) + (let ((new-point (vector 0 0 0))) ; todo: grow along dir + (set! points (append points (list new-point))) ; + (send-message 'twig-grow (list + (list 'plant-id (send plant get-id)) + (list 'twig-id id) + (list 'point new-point)))) + (when (zero? (random branch-probability)) + (add-twig (- (length twigs) 1) + (make-object twig-logic% (send plant get-next-twig-id) plant type dir + ; todo dir+rnd + (* width branch-width-reduction)))) + (for-each + (lambda (twig) + (send (cadr twig) grow)) + twigs)) + (define/public (add-twig point-index twig) + (send-message 'new-twig (list + (list 'plant-id (send plant get-id)) + (list 'twig-id id) + (list 'point-index point-index))) (set! twigs (cons (list point-index twig) twigs))) (define/public (get-twig point-index) @@ -86,11 +140,11 @@ (define/public (add-ornament point-index ornament) ; tell the renderer something has occurred - (send-message (make-object message% 'new-ornament + (send-message 'new-ornament (list (send plant get-id) id - point-index))) + point-index)) (set! ornaments (cons (list point-index ornament) ornaments))) (define/public (get-ornament point-index) @@ -128,7 +182,7 @@ ornaments) (map (lambda (twig) - (send twig update)) + (send (cadr twig) update)) twigs))) (super-new))) @@ -175,12 +229,31 @@ (define plant-logic% (class game-logic-object% (init-field + (id #f) (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 + (max-twigs 10) ; the maximum twigs allowed at any time - oldest removed first + (next-twig-id 0)) + + (inherit send-message) + + (define/public (get-id) + id) + + (define/public (grow) + (for-each + (lambda (twig) + (send twig grow)) + twigs)) + + ; we need to maintain our list of twig ids here, for this plant + (define/public (get-next-twig-id) + (let ((id next-twig-id)) + (set! next-twig-id (+ next-twig-id 1)) + next-twig-id)) (define/public (check/add-ornament pickup) (foldl @@ -203,8 +276,12 @@ (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) + (send twig set-id! (get-next-twig-id)) + (send-message 'new-root-twig (list + (list 'plant-id id) + (list 'twig-id (send twig get-id)))) (set! twigs (cons-twig twig twigs max-twigs '()))) (define/augment (update) @@ -216,14 +293,17 @@ (super-new))) ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - + (define game-logic% (class game-logic-object% (field (plants '()) (pickups '())) + (inherit send-message) + (define/public (add-plant plant) + (send-message 'new-plant '("hello")) (set! plants (cons plant plants))) (define/public (add-pickups pickup) @@ -247,7 +327,25 @@ (super-new))) - +(define (run) + (let ((l (send game update))) + (for-each + (lambda (m) + (send m print)) + l))) + ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - \ No newline at end of file +(define game (make-object game-logic%)) + +(define plant1 (make-object plant-logic% "dave@fo.am" (vector 0 0 0))) +(define plant2 (make-object plant-logic% "plant00001@fo.am" (vector 0 1 0))) + +(send game add-plant plant1) +(send game add-plant plant2) +(run) +(send plant1 add-twig (make-object twig-logic% 0 plant1 (vector 0 1 0) 1)) +(run) +(for ((i (in-range 0 50))) + (send plant1 grow) + (run))