groworld/plant-eyes/plant-eyes.scm

#lang scheme/base
(require fluxus-016/drflux)
(require scheme/class)

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; p l a n t   e y e s   
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

; notes:
;
; * keeping with a view/logic separation, although this is quite different to 
;   the hexagon game. the main advantages:
;     - just a divide and conquer strategy for staying sane 
;     - able to debug the logic without the view, or vice versa
;     - the logic can be ticked at a lower frequency - or even different 
;       parts at different rates, whereas the view 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 automatically collected up and dispatched to 
;   the view
;
; * line segments are computed in the logic side, and can be represented any
;   way by the view - maybe the players plant will be geometry and everyone
;   elses will be ribbons (stoopid LOD)
;
; * 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 debug-messages #f) ; prints out all the messages sent to the renderer

(define branch-probability 2) ; as in one in branch-probability chance
(define branch-width-reduction 0.5)
(define twig-jitter 0.5)
(define branch-jitter 1)
(define max-twig-points 20)
(define start-twig-width 0.1)

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; a message for sending betwixt logic and render side
(define message%
  (class object%
    (init-field
     (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
    
    (define/public (get-name)
      name)
    
    (define/public (get-data arg-name)
      (cadr (assoc arg-name data)))
    
    (define/public (print)
      (printf "msg: ~a ~a~n" 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 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
          m
          (flatten (inner (void) update))))) ; the augmented method gets called here
    
    (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 0)            ; the width of this root
     (num-points max-twig-points) ; number of points in this twig
     (render-type 'extruded)) ; the way to tell the view to render this twig
    
    (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
     (last-point (vector 0 0 0)))     
    
    (inherit send-message)
    
    (define/public (get-id)
      id)
    
    (define/public (set-id! s)
      (set! id s))
    
    (define/public (get-type)
      type)
    
    (define/public (get-dir)
      dir)
    
    (define/public (get-width)
      width)
    
    (define/public (get-num-points)
      num-points)
    
    (define/public (get-render-type)
      render-type)
    
    (define/public (get-point point-index)
      (list-ref points point-index))
    
    (define/public (grow)
      (when (< (length points) num-points)
        (let ((new-point (if (zero? (length points))
                             (vector 0 0 0) ; first point should be at the origin
                             (vadd last-point dir (vmul (srndvec) twig-jitter)))))
          (set! last-point new-point)
          (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 (and (> (length points) 1) (> num-points 1) (zero? (random branch-probability)))
          (add-twig (- (length points) 1) 
                    (make-object twig-logic% (send plant get-next-twig-id) 
                      plant 
                      type 
                      (vadd dir (vmul (srndvec) branch-jitter))
                      (* width branch-width-reduction)
                      (quotient num-points 2)
                      render-type))))
      (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 'parent-twig-id id)
                               (list 'point-index point-index)
                               (list 'twig-id (send twig get-id))
                               (list 'type (send twig get-type))
                               (list 'dir (send twig get-dir))
                               (list 'width (send twig get-width))
                               (list 'num-points (send twig get-num-points))
                               (list 'render-type (send twig get-render-type))
                               ))
      (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)
      (send-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 (cadr 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
     (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
     (next-twig-id 0))
    
    (inherit send-message)
    
    (define/public (get-id)
      id)

    (define/public (get-pos)
      pos)

    (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
       (lambda (twig found)
         (if (not found)
             (send twig check/add-ornament pickup)
             #f))
       #f
       twigs))
    
    (define/public (destroy-twig twig)
      (send-message 'destroy-branch-twig (list
                                   (list 'plant-id id)
                                   (list 'twig-id (send twig get-id))
                                   )))

    ; 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)
      (send twig set-id! (get-next-twig-id))
      (send-message 'new-branch-twig (list 
                               (list 'plant-id id)
                               (list 'twig-id (send twig get-id))
                               (list 'type (send twig get-type))
                               (list 'dir (send twig get-dir))
                               (list 'width (send twig get-width))
                               (list 'num-points (send twig get-num-points))             
                               (list 'render-type (send twig get-render-type))
                               ))
      (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 '()))
   
    (inherit send-message)
    
    (define/public (add-player plant)
      (send-message 'player-plant (list
                                (list 'plant-id (send plant get-id))
                                (list 'pos (send plant get-pos))))
      (set! plants (cons plant plants)))
    
    (define/public (add-plant plant)
      (send-message 'new-plant (list
                                (list 'plant-id (send plant get-id))
                                (list 'pos (send plant get-pos))))
      (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)))

;==============================================================================
;==============================================================================

; extrusion code

(define (draw-profile index profile offset)
    (cond ((not (null? profile))
            (pdata-set! "p" index (vadd (car profile) offset))
            (draw-profile (+ index 1) (cdr profile) offset))))


(define (transform-profile profile m)
    (cond
        ((null? profile) '())
        (else
            (cons (vtransform (car profile) m) 
                (transform-profile (cdr profile) m)))))

; figures out the vector for rotation of the profile
(define (path-vector first-segment path lv)
    (let* ((v (if (null? (cdr path))        ; last segment?
                    lv                      ; use the last vector used
                    (vsub (cadr path) (car path)))) ; use the next point
            (vd (if first-segment v          ; first segment?
                    (vadd (vmul lv 0.5) ; blend with the last vector
                        (vmul v 0.5)))))
        vd))

(define (extrude-segment index profile path lv)
    (cond ((not (null? path))
            (let ((v (path-vector (zero? index) path lv)))                
                (draw-profile index (transform-profile profile 
                        (mmul
                            (maim v (vector 1 0 0))
                            (mrotate (vector 0 90 0))))
                    (car path))
                v))))


(define (extrude-segment-blend index profile path lv t)
    (cond ((not (null? path))
            ; figure out the vector for rotation of the profile
            (let ((v (path-vector (zero? index) path lv)))
                (cond ((null? (cdr path))
                        (draw-profile index (transform-profile profile 
                                (mmul
                                    (maim v (vector 1 0 0))
                                    (mrotate (vector 0 90 0))))
                            (car path)))
                    (else
                        (let ((v2 (path-vector (zero? index) (cdr path) v)))
                            (draw-profile index (transform-profile profile 
                                    (mmul
                                        (maim (vmix (vnormalise v) (vnormalise v2) t) (vector 1 0 0))
                                        (mrotate (vector 0 90 0))))
                                (vmix (car path) (vadd (car path) v2) t)))))
                v))))


(define (extrude index profile path lv)
    (cond ((not (null? path))
            (let ((v (extrude-segment index profile path lv)))
                (extrude (+ index (length profile)) profile (cdr path) v)))))

(define (stitch-face index count profile-size in)
    (cond 
        ((eq? 1 count) 
            (append in (list (+ (- index profile-size) 1) index (+ index profile-size) 
                    (+ (- index profile-size) 1 profile-size))))
        (else
            (append 
                (list (+ index 1) index
                    (+ index profile-size) (+ index profile-size 1))
                (stitch-face (+ index 1) (- count 1) profile-size in)))))

(define (stitch-indices index profile-size path-size in)
    (cond 
        ((eq? 1 path-size) in)
        (else
            (append
                (stitch-face index profile-size profile-size '())
                (stitch-indices (+ index profile-size) 
                    profile-size
                    (- path-size 1)
                    in)))))

(define (build-extrusion profile path)
    (let ((p (build-polygons (* (length profile) (length path)) 'quad-list)))
        (with-primitive p
            (poly-set-index (stitch-indices 0 (length profile) (length path) '()))
            (extrude 0 profile path (vector 0 0 0))
            (recalc-normals 0))
        p))

; partial extrusions are for animating

(define (build-partial-extrusion profile path)
    (let ((p (build-polygons (* (length profile) (length path)) 'quad-list)))
        (with-primitive p
            (poly-set-index (stitch-indices 0 (length profile) (length path) '())))
        p))

(define (chop-front l n)
    (cond ((null? l) l)
        (else
            (if (zero? n) (cons (car l) (chop-front (cdr l) n))
                (chop-front (cdr l) (- n 1))))))

; returns the last vector
(define (partial-extrude p t v profile path)
    (with-primitive p 0
        
        (let* ((start (* (floor t) (length profile)))
                (end (* (length path) (length profile)))
                (v (extrude-segment start profile 
                        (chop-front path (floor t)) v)))
            
            (when (< t (- (length path) 1))
                (for ((i (in-range (+ start (length profile)) (+ start (* 2 (length profile))))))
                    (pdata-set! "p" i (vsub (pdata-ref "p" (- i (length profile))) 
                            (vmul v (- (floor t) t)))))
                
                ; collapse the yet un-extruded part into the last vert
                (for ((i (in-range (+ start (* (length profile) 2)) end)))
                    (pdata-set! "p" i (pdata-ref "p" (+ (length profile) start)))))
            
            (recalc-normals 0)
            v)))

#;(define (partial-extrude p t v profile path)
    (with-primitive p 0
        
        (let* ((start (* (floor t) (length profile)))
                (end (* (length path) (length profile)))
                (v (extrude-segment-blend start profile 
                        (chop-front path (floor t)) v (- (floor t) t))))
            
            (when (< t (- (length path) 1))
                #;(for ((i (in-range (+ start (length profile)) (+ start (* 2 (length profile))))))
                    (pdata-set! "p" i (vsub (pdata-ref "p" (- i (length profile))) 
                            (vmul v (- (floor t) t)))))
                
                ; collapse the yet un-extruded part into the last vert
                (for ((i (in-range (+ start (* (length profile) 1)) end)))
                    (pdata-set! "p" i (pdata-get "p" start))))
            
            (recalc-normals 0)
            v)))

(define (build-circle-profile n r)
    (define (_ n c l)
        (cond ((zero? c) l)
            (else
                (let ((a (* (/ c n) (* 2 3.141))))                 
                    (_ n (- c 1) 
                        (cons (vmul (vector (sin a) (cos a) 0) r) l))))))
    (_ n n '()))

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

(define twig-view%
    (class object%
      (init-field
       (id 0)
       (pos (vector 0 0 0))
       (type 'none)
       (dir (vector 0 1 0))
       (radius 1)
       (num-points 0)) 
      
      (field
       (index 0)
       (parent-twig-id -1)
       (child-twig-ids '()))
      
      (define/public (get-id)
        id)
      
      (define/public (build)
        0)

      (define/public (set-pos! s)
        (set! pos s))
      
      (define/public (get-root)
        (error "need to overide this"))

      (define/public (set-parent-twig-id s)
        (set! parent-twig-id s))
      
      (define/public (get-point point-index)
        (error "need to overide this"))
      
      (define/public (add-child-twig-id twig-id)
        (set! child-twig-ids (cons twig-id child-twig-ids)))
      
      (define/public (grow point)
        (error "need to override this"))

      (define/public (update t d)
        (error "need to override this"))
      
      (super-new)))

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

(define ribbon-twig-view%
    (class twig-view%
      
      (inherit-field pos radius num-points index)
      
      (field
       (root 0))
      
      (define/override (build)
        (set! root (let ((p (with-state
                       (translate pos)
                       (hint-unlit)
                       ;(concat (maim dir (vector 0 0 1)))
                       (build-ribbon num-points))))
               (with-primitive p
                               (pdata-map! 
                                (lambda (w)
                                  0)
                                "w")
                               (pdata-set! "w" 0 radius))
               p)))
      
      
      (define/override (get-root)
        root)

      (define/override (get-point point-index)
        (with-primitive root
                        (pdata-ref "p" point-index)))
     
      (define/override (grow point)
        (with-primitive root
                        (pdata-index-map! ; set all the remaining points to the end
                         (lambda (i p)    ; in order to hide them
                           (if (< i index)
                               p
                               point))
                         "p")
                        (pdata-index-map! ; do a similar thing with the width
                         (lambda (i w)    
                           (if (< i (+ index 1))
                               w
                               radius))
                         "w"))
        (set! index (+ index 1)))

      (define/override (update t d)
        0)

      (super-new)))

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

(define extruded-twig-view%
    (class twig-view%
      
      (inherit-field index radius num-points pos)
      
      (field
       (profile '())
       (path '())
       (root 0)
       (v (vector 0 0 0))
       (grow-speed 1))
      
      (define/override (build)
       (set! profile (build-circle-profile 5 radius))
       (set! path (build-list num-points (lambda (_) (vector 0 0 0))))
       (set! root (let ((p (with-state
                       (translate pos)
                       ;(hint-unlit)
                       ;(concat (maim dir (vector 0 0 1)))
                       (build-partial-extrusion profile path))))
               p)))
      
      (define/override (get-root)
        root)
      
      (define/override (get-point point-index)
        (when (> point-index index) (error "asked for point before we've set it"))
        (list-ref path point-index))
      
      (define (list-set l c s)
        (cond ((null? l) '())
              ((zero? c) (cons s (list-set (cdr l) (- c 1) s)))
              (else (cons (car l) (list-set (cdr l) (- c 1) s)))))
      
      (define/override (grow point)
        (set! path (list-set path (+ index 1) point))
        (set! t 0)
        (set! v (partial-extrude root index v profile path))
        (set! index (+ index 1)))

      (define/override (update t d)
        (when (< t 1)
            (set! v (partial-extrude root (+ (- index 1) t) v profile path)))
        (set! t (+ t (* d grow-speed))))
      
      (define/public (get-end-pos)
        (with-primitive root
                        (pdata-ref "p" (* index (length profile)))))
      
      (super-new)))

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

(define plant-view%
    (class object%
      
      (init-field
       (id "none")
       (pos (vector 0 0 0)))
       
       (field 
        (twigs '()) ; a assoc list map between ids and twigs stored flat here,       
                    ; for fast access, but prims heirachically in the scenegraph
        (root (with-state 
               (translate pos)
               (build-locator)))
        (seed (with-state
               (parent root)
               (texture (load-texture "textures/skin.png"))
               (backfacecull 0)
               (opacity 0.6)
               (colour (vector 0.8 1 0.6))
               (hint-depth-sort)
               (hint-unlit)
               (load-primitive "meshes/seed.obj"))))
        
      (define/public (get-id)
        id)
      
      (define/public (get-twig twig-id)
        (cadr (assq twig-id twigs)))

      (define/public (add-branch-twig twig)     
        ; attach to seed
        (with-primitive (send twig get-root)
                        (parent root))
        (send twig build)
        (set! twigs (cons (list (send twig get-id) twig) twigs)))

      (define/public (add-twig parent-twig-id point-index twig)     
        (let ((ptwig (get-twig parent-twig-id)))
          ; attach to parent twig       
          (with-primitive (send twig get-root)
                          (parent (send ptwig get-root)))
          
          (send twig set-pos! (send ptwig get-point point-index))
          (send twig build)
          
          ; tell the twigs about this relationship (might turn out to be overkill)
          (send ptwig add-child-twig-id (send twig get-id))
          (send twig set-parent-twig-id parent-twig-id)
          
          (set! twigs (cons (list (send twig get-id) twig) twigs))))      
      
      (define/public (grow-twig twig-id point)
        (send (get-twig twig-id) grow point))      
      
      (define/public (update t d)
        
        (with-primitive seed
                        (scale (+ 1 (* 0.001 (sin (* 2 t))))))                       
        
        (for-each 
         (lambda (twig)
           (send (cadr twig) update t d))
         twigs))
        
      (super-new)))

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

(define game-view%
  (class object%
    (field
     (plants '()) ; map of ids -> plants     
     (camera (build-cube))
     (player-plant-id #f)
     (current-twig-id #f))
    
    (define/public (get-player)
      (get-plant player-plant-id))
    
    (define/public (add-plant plant player)
      (set! plants (cons (list (send plant get-id) plant) plants))
      (when player (set! player-plant-id (send plant get-id))))
    
    (define/public (get-plant plant-id)
      (cadr (assq plant-id plants)))
    
    (define/public (add-branch-twig plant-id twig)
      (when (eq? plant-id player-plant-id)
        (set! current-twig-id (send twig get-id)))
      (send (get-plant plant-id) add-branch-twig twig))
    
    (define/public (add-twig plant-id parent-twig-id point-index twig)
      (send (get-plant plant-id) add-twig parent-twig-id point-index twig))
    
    (define/public (update t d messages)      
                        
      (for-each 
       (lambda (plant)
         (send (cadr plant) update t d))
       plants)
      
      (when current-twig-id
        (let ((twig (send (get-player) get-twig current-twig-id)))
          (with-primitive camera
                          (identity)
                          (translate (send twig get-end-pos)))))
      
      
      (when debug-messages
        (for-each
         (lambda (msg)
           (send msg print))
         messages))      
      (for-each
       (lambda (msg)
         (cond
           ((eq? (send msg get-name) 'player-plant)
            (add-plant (make-object plant-view% 
                         (send msg get-data 'plant-id) 
                         (send msg get-data 'pos)) #t))
                      
           ((eq? (send msg get-name) 'new-plant)
            (add-plant (make-object plant-view% 
                         (send msg get-data 'plant-id) 
                         (send msg get-data 'pos)) #f))           
           
           ((eq? (send msg get-name) 'new-branch-twig)
            (add-branch-twig (send msg get-data 'plant-id) 
                             (cond 
                               ((eq? (send msg get-data 'render-type) 'ribbon)
                                (make-object ribbon-twig-view%                               
                                  (send msg get-data 'twig-id)
                                  (vector 0 0 0)
                                  (send msg get-data 'type)                               
                                  (send msg get-data 'dir)
                                  (send msg get-data 'width)
                                  (send msg get-data 'num-points)))

                             ((eq? (send msg get-data 'render-type) 'extruded)
                              (make-object extruded-twig-view%                               
                                (send msg get-data 'twig-id)
                                (vector 0 0 0)
                                (send msg get-data 'type)                               
                                (send msg get-data 'dir)
                                (send msg get-data 'width)
                                (send msg get-data 'num-points))))))
           
           ((eq? (send msg get-name) 'new-twig)
            (add-twig (send msg get-data 'plant-id)
                      (send msg get-data 'parent-twig-id)
                      (send msg get-data 'point-index)
                      (cond                         
                        ((eq? (send msg get-data 'render-type) 'ribbon)
                         (make-object ribbon-twig-view%                               
                           (send msg get-data 'twig-id)
                           (vector 0 0 0) ; will be filled in by add-twig
                           (send msg get-data 'type)                               
                           (send msg get-data 'dir)
                           (send msg get-data 'width)
                           (send msg get-data 'num-points)))
                        
                        ((eq? (send msg get-data 'render-type) 'extruded)
                         (make-object extruded-twig-view%                               
                           (send msg get-data 'twig-id)
                           (vector 0 0 0) ; will be filled in by add-twig
                           (send msg get-data 'type)                               
                           (send msg get-data 'dir)
                           (send msg get-data 'width)
                           (send msg get-data 'num-points))))))
           
           ((eq? (send msg get-name) 'twig-grow)
            (send (get-plant (send msg get-data 'plant-id)) grow-twig
                  (send msg get-data 'twig-id)
                  (send msg get-data 'point)))
           
           ))
       messages))
    
    


    (super-new)))

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
(clear)
(define gl (make-object game-logic%))
(define gv (make-object game-view%))
 
(define plant1 (make-object plant-logic% "dave@fo.am" (vector 0 0 0)))
(define plant2 (make-object plant-logic% "plant00001@fo.am" (vector 6 0 0)))

(send gl add-player plant1)
(send gl add-plant plant2)

(send plant1 add-twig (make-object twig-logic% 0 plant1 'root (vector 0 -1 0) start-twig-width 10 'extruded))
(send plant2 add-twig (make-object twig-logic% 0 plant2 'root (vector 0 -1 0) start-twig-width 10 'ribbon))

(define t 0)
(define tick-time 0)
(define tick 0.5)
(define d 0.02)

(define (animate)
  (when (< tick-time t)
    (set! tick-time (+ t tick))
    (send plant1 grow)
    (send plant2 grow)
    (send gv update t d (send gl update)))
  (send gv update t d '())
  (set! t (+ t d)))

(for ((i (in-range 0 100)))
     (animate))

(every-frame (animate))