groworld/plant-eyes/scripts/view.ss

;; p l a n t   e y e s  [ copyright (c) 2009 foam vzw : gpl v3 ]

#lang scheme/base
(require scheme/class 
  fluxus-016/fluxus 
  fluxus-016/shapes 
  "sound.ss" 
  "message.ss" 
  "list-utils.ss" 
  "ornament-views.ss")
  
(provide (all-defined-out))

; the fluxus code to make things look the way they do

(define debug-messages #f) ; prints out all the messages sent to the renderer

(define (ornament-colour) (vector 0.7 0.7 0.7))
(define (pickup-colour) (vector 1 1 1))
(define (earth-colour) (vector 0.1 0.1 0.1))
(define (dust-colour) (vmul (vector 0.05 0.05 0.05) (* 2 (rndf))))
(define (stones-colour) (vmul (vector 0.5 0.5 0.5) (* (crndf) 0.5)))
(define (alive-colour) (vmul (vector 1 1 1) (+ 0.5 (* (rndf) 0.5))))
(define (worm-colour) (vmul (vector 0.8 0.8 0.8) (+ 0.5 (* (rndf) 0.5))))

(define wire-mode #f)
(define fog-col (earth-colour))
(define fog-strength 0.1)
(define default-grow-speed 0.5)
(define grow-overshoot 10)

(define min-fin-len 3)
(define fin-length-var 4)
(define fin-grow-prob 200)
(define max-fins-per-twig 5)

(define above-fog-col (vector 0.95 0.95 0.95))
(define above-fog-strength 0.01)
(define ground-change-duration 4)
 
(define (pre-ripple)
                    (when (not (pdata-exists? "rip-pref"))
                        (pdata-copy "p" "rip-pref")))
  
(define (ripple t speed wave-length)  
                    (pdata-map!
                        (lambda (p pref)
                            (vadd pref (vmul (srndvec) 
                                    (* 0.1 (+ 1 (sin (+ (* t speed) (* wave-length     
                                                        (vdist (vtransform p 
                                                                (minverse (get-transform))) 
                                                            (vector 0 0 0))))))))))
                        "p" "rip-pref"))

(define (fract n)
    (- n (floor n)))

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

 (define dust%
    (class object%
        (field
            (rate 1)
			(above-ground #f)
            (next-p 0)
            (root (let ((p (with-state
				(colour 0)
				(hint-depth-sort)
				(texture (load-texture "textures/particle.png"))
                (build-particles 1000))))
                (with-primitive p
                    (pdata-map! 
                        (lambda (c)
                            (vector 0 0 0 0.01))
                        "c")
                   (pdata-map! 
                        (lambda (p)
                            (vmul (srndvec) 100))
                        "p")
					(pdata-map! 
                        (lambda (s)
							(let ((s (* 4 (rndf))))
                            (vector s s s)))
                        "s")) p))
            (emitter (with-state (build-locator)))
			(pos (with-primitive root (vtransform (vector 0 0 0) (get-global-transform)))))

	(define/public (set-above-ground s)
		(set! above-ground s)
		(with-primitive root
			(colour (if s 1 0))
			(pdata-map!
				(lambda (c)
					(if s (vector 1 1 1 0.01) (vector 0 0 0 0.01)))
				"c")))

    (define/public (update t d)

        (let ((emitter-pos (with-primitive emitter
            (identity)
			(translate (vmul pos -1)) ; makes the particles relative to the centre of the plant
            (concat (get-locked-matrix))  ; which makes the depth sorting work better
            (translate (vector 0 0 -10))
            (vtransform (vector 0 0 0) (get-transform)))))

        (with-primitive root
        (for ((i (in-range 0 rate)))
            (pdata-set! "p" next-p (vadd emitter-pos (vmul (srndvec) 10)))
            (pdata-set! "c" next-p (if above-ground (vector 1 1 1 0.01) (vector 0 0 0 0.01)))
            (pdata-set! "s" next-p (let ((s (* 4 (rndf)))) (vector s s s)))
            (set! next-p (+ next-p 1)))
		(pdata-op "*" "c" 1.04)
		(pdata-op "*" "s" 0.995))))

    (super-new)))

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

(define insect-view%
    (class object%
		(init-field
			(id 0)
			(from (vector 0 0 0))
			(type 'none))
	
        (field
            (to (vector 0 0 0))
            (from-dir (vector 1 0 0))
            (to-dir (vector 1 0 0))
            (time 0)
            (tick 1))
                
        (define/public (move pos dur)
            (set! from to)
            (set! from-dir to-dir)
            (set! to pos)
            (set! to-dir (vnormalise (vsub from to)))
            (set! time 0)
            (set! tick dur))
        
        (define/public (update t d)
           (set! time (+ time d)))
		   
		(define/public (do-tx t d)
			(let* ((t (min (/ time tick) 1))
                   (h (hermite-tangent from to (vmul from-dir 2) (vmul to-dir 2) t)))
                 (translate (car h))
                 (concat (maim (vector 0 0 1) (vnormalise (cadr h)))))
               (set! time (+ time d)))
        
        (super-new)))

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

(define (add-blendshape key model)
    (let ((b (load-primitive model))
            (pname (string-append "p" (number->string key))))
        (pdata-add pname "v")
        (pdata-index-map!
            (lambda (i p)
                (with-primitive b (pdata-ref "p" i)))
            pname)
        (destroy b)))

(define (set-blendshape key)
    (pdata-copy (string-append "p" (number->string key)) "p"))

(define spider-insect-view%
    (class insect-view%
        (inherit-field from to from-dir to-dir time tick)      
        (inherit do-tx)

        (field
            (root (let ((p (with-state
				(hint-unlit)
				(colour (vector 0 0 0))
				(load-primitive "meshes/spider-1.obj"))))
				(with-primitive p				
					(pdata-copy "p" "p0")
    				(add-blendshape 1 "meshes/spider-2.obj")
    				(add-blendshape 2 "meshes/spider-3.obj") p)))
			(anim-t 0)
			(anim-d (* 0.2 (rndf)))
			(blendshape 0))
        
        (define/override (update t d)
            (with-primitive root
			
						(when (> anim-t anim-d)
							(set! anim-t 0)
							(set! blendshape (modulo (+ blendshape 1) 3))
							(set-blendshape blendshape))
			
                        (identity)                        
						(do-tx t d)						
                        (scale 1))
			(set! anim-t (+ anim-t d)))
        
        (super-new)))
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

(define butterfly-insect-view%
    (class insect-view%
        (inherit-field from to from-dir to-dir time tick)      
        (inherit do-tx)
		
        (field
            (root (let ((p (build-locator)))
        		(with-state
            		(colour (rndvec))
            		(parent p)
            		(hint-depth-sort)
            		(hint-unlit)
            		(backfacecull 0)
            		(texture (load-texture "textures/butterfly.png"))
            		(load-primitive "meshes/butterfly.obj")
            		(translate (vector 0 0.001 0))
            		(load-primitive "meshes/butterfly.obj")) p)))
        
        (define/override (update t d)
            (with-primitive root
    			(let ((a (* 90 (rndf))))
        			(with-primitive (car (get-children))
            			(rotate (vector 0 0 a)))
        			(with-primitive (cadr (get-children))
            			(rotate (vector 0 0 (- a)))))
                    (identity)
                    (do-tx t d) 
                    (scale 1))
            (set! time (+ time d)))
        
        (super-new)))

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

(define worm-insect-view%
    (class insect-view%
        (inherit-field from to from-dir to-dir time tick)      
        
        (field 
            (hidden #t)
            (from2 (vector 0 0 0))
            (from-dir2 (vector 0 0 0))
       		(root (let ((p (build-ribbon 20)))
              (with-primitive p
                (translate (vector 0 0 -0.1))
				(hint-depth-sort)
                ;(hint-unlit)
                (colour (worm-colour))
                (texture (load-texture "textures/worm.png"))
                (let ((width (+ 0.5 (* 0.5 (rndf)))))
                    (pdata-index-map!
                        (lambda (i w)
                            width #;(+ 0.05 (* (abs (sin (* i 0.5))) 0.1)))
                        "w"))
                #;(pdata-map!
                    (lambda (c)
                        (vector 1 1 1))
                    "c"))
				p)))

        (define/override (move pos dur)
            (set! from2 from)
            (set! from to)
            (set! from-dir2 from-dir)
            (set! from-dir to-dir)
            (set! to pos)
            (set! to-dir (vmul (vsub to from) 5))
            (set! time 0)
            (set! tick dur))      
         
        (define/override (update t d)
                    (let ((nt (/ time tick))) ; normalise time
					    (when (< nt 1)
                        (with-primitive root
                            (pdata-index-map!
                                (lambda (i p)
                                    (let ((st (- nt (* i 0.05))))
                                        (if (< st 0) 
                                            (hermite from2 from (vmul from-dir2 2) (vmul from-dir 2) (+ st 1))
                                            (hermite from to (vmul from-dir 2) (vmul to-dir 2) st))))
                            "p"))))
        
        (set! time (+ time d)))
    
    (super-new)))

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

    (define (build-squiggle x y)
      (let ((p (build-ribbon 15))
	  	    (x (/ x 10))
			(y (/ y 10)))
        (with-primitive p
		    (pdata-add "vel" "v")
			(pdata-map! 
				(lambda (vel)
					(vmul (srndvec) 0.1))
				"vel")
            (pdata-index-map!
                (lambda (i p)
                    (vector (cos (/ i x)) (sin (/ i y)) (/ i (pdata-size))))
                "p")
            (pdata-index-map!
                (lambda (i p)
                    (* 0.5 (sin (* 3.141 (/ i (pdata-size))))))
                "w")
            (pdata-map!
                (lambda (c)
                    (vector 1 1 1))
                "c")
		    (pdata-copy "p" "pref")
			(recalc-bb))  
        p))

(define pickup-view%
  (class object%
    (init-field
     (id -1)
     (type 'none)
     (pos (vector 0 0 0))
	 (highlit #f))
    
    (field
     (rot (vmul (rndvec) 360))
     (root (let ((p (with-state	 		
            (translate pos)
            (rotate rot)
            (colour (pickup-colour))
			(texture (load-texture "textures/spark.png"))
			(shader "shaders/spark.vert.glsl" "shaders/spark.frag.glsl")
			(hint-nozwrite)
            (hint-frustum-cull)
			(blend-mode 'src-alpha 'one)
            (cond 
              ((eq? type 'wiggle) (build-squiggle 4 2))
              ((eq? type 'leaf) (build-squiggle 2 4))
              ((eq? type 'curly) (build-squiggle 4 6))
              ((eq? type 'nutrient) (build-squiggle 2 2))
              ((eq? type 'horn) (build-squiggle 3 4))
              ((eq? type 'inflatoe) (build-squiggle 4 5))
              ((eq? type 'fork) (build-squiggle 5 2))
              ((eq? type 'flower) (build-squiggle 4 3))))))
			  (with-primitive p (shader-set! (list "BaseMap" 0))) p))
     (from pos)
     (destination (vector 0 0 0))
     (speed 0.05)
     (t -1)
	 (destroy-time -99)
	 (dissolve-time -99)
	 (delme #f))
		
	(define/public (get-type)
		type)	
	
    (define/public (pick-up point)
      (set! destroy-time point))
	  
	(define/public (delme?)
		delme)
		
	(define/public (highlight)
	  (set! highlit #t))
	  
	(define/public (get-root)
		root)
    
    (define/public (move-to s)
      (set! t 0)
      (set! from pos)
      (set! destination s))
    
    (define/public (update t d)
	
      (with-primitive root
                      (rotate (vector (* d (if highlit 50 10)) 0 0)))
					  
	  (when (and highlit (eq? dissolve-time -99))
	  	(with-primitive root
	  		(pdata-map!
				(lambda (p pref)
					(vadd pref (vmul (srndvec) 0.1)))
				"p" "pref")))
	
	  (when (> destroy-time -99)
	    (set! destroy-time (- destroy-time (* d default-grow-speed 0.5)))
		(when (< destroy-time 0)
		   (set! destroy-time -100)
		   (set! dissolve-time 4)))

	  (when (> dissolve-time -99)
	    (set! dissolve-time (- dissolve-time d))
	  	(with-primitive root
		  (pdata-op "+" "p" "vel")
		  (pdata-op "*" "w" 0.95))		  
		(when (< dissolve-time 0)
		   (destroy root)
		   (set! delme #t)))
		   
        (set! t (+ t speed)))
    
    (super-new)))

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

(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 '())
            (ornaments '())
            (col (vector 1 1 1))
            (tex "")
            (markers '())
            (shrink-t 0)
            (grow-t -1)
            (marker-destroy-t 0)
            (grow-speed default-grow-speed)
            (delme #f))
        
        (define/public (get-id) id)        
        (define/public (delme?) delme)        
        (define/public (get-dir) dir)        
        (define/public (set-dir! s) (set! dir s))        
        (define/public (set-col! s) (set! col s))        
        (define/public (set-tex! s) (set! tex s))
        (define/public (get-pos) pos)
        (define/public (build) 0)        
        (define/public (get-num-points) index)
        (define/public (get-grow-t) grow-t)      
        (define/public (set-pos! s) (set! pos s))
        (define/public (get-child-twig-ids) child-twig-ids)
        (define/public (get-root) (error "need to overide this"))        
        (define/public (destroy-twig) (destroy (get-root)))
        (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 (get-width point-index) (error "need to overide this"))
        (define/public (set-grow-speed s) (set! grow-speed s))
		
        (define/public (add-child-twig-id twig-id)
            (set! child-twig-ids (cons twig-id child-twig-ids)))
        
        (define/public (growing?)
            (< grow-t (+ num-points grow-overshoot)))
        
        (define/public (start-growing)
            (set! grow-t 0)
            (set! markers (cons (build-locator) markers)))
        
        (define/public (start-shrinking)
            (set! shrink-t (if (growing?) grow-t (+ num-points grow-overshoot))))
        
        (define/pubment (add-point point width make-marker)
            (play-sound "snd/event01.wav" point (+ 0.1 (rndf)) 0.3) 
            (when make-marker
                (set! markers (append markers (list (with-state
                                (parent (get-root))
                                (translate point)
                                (scale 0.1)
                                (shader "shaders/toon.vert.glsl" "shaders/toon.frag.glsl")
                                (colour col)
                                (build-sphere 8 8))))))
            
            (inner (void) add-point point width make-marker))
        
        (define/public (add-ornament point-index property)          
            (when (< point-index grow-t)
                (play-sound "snd/nix.00203.wav" (get-point point-index) (+ 0.1 (rndf)) 0.3)
                (with-state
                    (parent (get-root))
                    (let ((ornament (property->ornament property
                                    (get-point point-index)
                                    (get-width point-index)
                                    (vnormalise (vsub (get-point point-index) (get-point (- point-index 1))))
                                    col)))
                        ; check above ground
                        (let ((pos (with-primitive (get-root) (vtransform (vector 0 0 0) (get-global-transform)))))
                            (if (not (and (send ornament above-ground-only?) 
                                        (< (vy (vadd pos (get-point point-index))) 1)))
                                ; todo - delete existing ornaments here
                                (set! ornaments (cons (list point-index ornament) ornaments))
                                (send ornament destroy-ornament)))))))
        
        (define/pubment (set-excitations! a b)
            (for-each
                (lambda (ornament)
                    (send (cadr ornament) set-excitations! a b))
                ornaments))
        
        (define/pubment (update t d)        
            (for-each
                (lambda (ornament)
                    (send (cadr ornament) update t d))
                ornaments)
            
            (when (> shrink-t 0) 
                (set! shrink-t (- shrink-t (* d grow-speed))))
            
            (when (< shrink-t 0)
                (set! delme #t))
            
            (inner (void) update t d)
            
            (when (and (not (eq? grow-t -1)) (< grow-t (+ num-points grow-overshoot)))
                (set! grow-t (+ grow-t (* d grow-speed)))
                (when (and (not (null? markers)) (> 0 (- marker-destroy-t grow-t)))
                    ; soundtodo: marker gobble
                    (set! marker-destroy-t (+ 1 marker-destroy-t))
                    (destroy (car markers))
                    (set! markers (cdr markers))))
            
            (when (> grow-t (+ num-points 10)) 
                (set! grow-t 999)))
        
        (super-new)))

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

(define ribbon-twig-view%
    (class twig-view%
        
        (inherit-field pos radius num-points index col tex grow-t)
        
        (field
            (root 0)
            (widths '())
            (points '())
            (global-growth 0)
            (global-growth-time 100))
        
        (define/override (build)
            (set! root (let ((p (with-state
                                (translate pos)
                                (colour (vmul col 0.2))
                                (hint-unlit)
                                (texture (load-texture "textures/ribbon-twig.png")) 
                                (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 (get-width point-index)
            (with-primitive root
                (pdata-ref "w" point-index)))
        
        (define/override (get-point point-index)
            (list-ref points point-index))
        
        (define/override (get-width point-index)
            (list-ref widths point-index))
        
        (define/augment (add-point point width make-marker)
            #;(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"))
            (set! widths (append widths (list width)))
            (set! points (append points (list point)))
            (set! index (+ index 1)))
        
        (define/augment (update t d)
            (when (and (> grow-t 0) (< grow-t (+ (length points) 10)))
                (with-primitive root
                    (pdata-index-map!
                        (lambda (i w)    
                            (* (/ global-growth global-growth-time)
                                (cond ((< i (- grow-t 1))
                                    (list-ref widths i))
                                ((< i grow-t)
                                    (* (list-ref widths i) (fract grow-t)))
                                (else
                                    0))))
                        "w")
                    
                    (pdata-index-map!
                        (lambda (i p)    
                            (cond ((< i (- grow-t 1))
                                    (list-ref points i))
                                ((equal? i (inexact->exact (floor (+ grow-t 1))))
                                    (vmix 
                                        (list-ref points i)
                                        (list-ref points (- i 1)) (fract grow-t)))
                                (else
                                    (list-ref points i))))
                        "p")))

             (when (< global-growth global-growth-time)
                (set! global-growth (+ global-growth d))))
        
        (super-new)))

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

; bunches of ribbon twigs 
(define twiglets%
    (class object%
        (init-field
            (par 0))

        (field
            (twigs '()))
        
        (define/public (build pos dir width length)
            (set! twigs (list (build-tree pos dir width length))))
        
        (define (build-tree pos dir width length)
            (let   ((t (make-object ribbon-twig-view% 0 pos 'ribbon 
                                dir 
                                (* width (+ 0.5 (rndf))) length)))
				(send t set-grow-speed 0.1)
                (with-state
                    (parent par)
                    (send t build))
                (let ((m (mrotate (vmul (srndvec) 45)))
                        (ppos (vector 0 0 0)))
                    (for ((i (in-range 0 length)))
                        (let ((dir (vtransform (send t get-dir) m))
                                (width (if (eq? i (- length 1)) 0 (/ width (+ i 1)))))
                            (send t set-dir! dir)
                            (send t add-point ppos width #f)
                            (set! ppos (vadd ppos (vmul dir (* 5 width)))))))
                (send t start-growing)
                t))
        
        
        
        (define/public (update t d)
            (for-each 
                (lambda (twig)
                    (send twig update t d)
                    (when (and 
                            (< (length twigs) 20)
                            (> (send twig get-num-points) 2) 
                            (zero? (random 400)))
                        (let ((pi (inexact->exact (floor (send twig get-grow-t)))))
                            (when (and (> pi 0) (< pi (send twig get-num-points)))
                               (set! twigs (cons 
                                        (build-tree 
                                            (vadd (send twig get-pos) (send twig get-point pi)) 
                                            (send twig get-dir)
                                            (/ (send twig get-width pi) 1.4) 
                                            (/ (send twig get-num-points) 2))
                                        twigs))))))
                twigs))
        
        (super-new)))



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

(define fin%
    (class object%
        (init-field
            (fin-size 1)
            (twig-ob #f)
            (col (vector 0 0 0))
            (path-len 0)
            (profile-len 0))
        
        (field
            (fin-len (min (- path-len 1) (+ min-fin-len (random fin-length-var))))
            (root (build-polygons (* fin-len 2) 'triangle-strip))
            (pos (random profile-len))
            (start (* (random (- path-len fin-len)) profile-len))
            (grow-t 0)
            (grow-speed (* (rndf) 0.1)))
        
        (define/public (build)
            (with-primitive root
                (parent twig-ob)
                (texture (load-texture "textures/fin-roots.png"))
                (hint-unlit)
                (hint-depth-sort)
                (colour col)
                (backfacecull 0)
                (pdata-index-map!
                    (lambda (i t)
                        (vector (/ (+ (quotient i 2) 1) (/ (pdata-size) 2)) (if (odd? i) 1 0) 0))
                    "t")))
        
        (define/public (update t d)
            (when (< grow-t 1)
            (with-primitive root
                (pdata-index-map!            
                    (lambda (i p)            
                        (let* ((ti (+ start pos (* (quotient i 2) profile-len)))
                                (tp (with-primitive twig-ob (pdata-ref "p" ti)))
                                (tn (with-primitive twig-ob (pdata-ref "n" ti))))
                            (if (even? i)
                                tp
                                (vadd tp (vmul tn (* grow-t fin-size))))))
                    "p"))
            
            (set! grow-t (+ grow-t (* d grow-speed)))))
        
        (super-new)))

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

(define extruded-twig-view%
    (class twig-view%
      
	  (inherit growing?)
      (inherit-field index radius num-points pos dir col tex grow-t shrink-t)
      
      (field
       (profile '())
       (path '())
       (root 0)
       (widths '())
	   (fins '())
	   (twiglets '()))
      
      (define/override (build)
       (set! profile (build-circle-points 12 1))
       (set! path (build-list num-points (lambda (_) (vector 0 0 0))))
       (set! widths (build-list num-points (lambda (_) 1)))
       (set! root (let ((p (with-state
                            (backfacecull 1)
                            (when wire-mode 
                              (hint-none)
                              (hint-wire))
                        (shader "shaders/twig.vert.glsl" "shaders/twig.frag.glsl")
                		;(shader "shaders/toon.vert.glsl" "shaders/toon.frag.glsl")
                       (texture (load-texture "textures/cells-1.png"))
                       ;(multitexture 1 (load-texture "textures/cells-2.png"))
                       ;(multitexture 2 (load-texture "textures/cells-3.png"))
                       ;(multitexture 3 (load-texture "textures/root-norm.png"))
                       (colour col)
                       #;(colour (vector 1 1 1))
                       #;(texture (load-texture "textures/root.png")) 
                       (build-partial-extrusion profile path 3))))
				(with-primitive p 				
    			   (shader-set! (list "Maps" (list 0 1 2) "NormalMap" 3)))

               p)))
      
      (define/override (get-root)
        root)
      
      (define/override (get-point point-index)
        (list-ref path point-index))

      (define/override (get-width point-index)
        (list-ref widths 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/augment (add-point point width make-marker)
        (set! path (list-set path index point))
        (set! widths (list-set widths index width))
        (set! index (+ index 1)))

      (define/augment (update t d)                   
		(with-primitive root
		    (shader-set! (list "Time" t))
			#;(let ((t (inexact->exact (round (fmod (* 5 t) 3)))))
				(cond 
					((eq? t 0) (texture (load-texture "textures/cells-1.png")))
					((eq? t 1) (texture (load-texture "textures/cells-2.png")))
					((eq? t 2) (texture (load-texture "textures/cells-3.png"))))))

	    #;(when (and (zero? (random fin-grow-prob))
		           (< (length fins) max-fins-per-twig)
				   (not (growing?))
				   (> (length path) 1))
		  (let ((new-fin (make-object fin% (+ 0.3 (* radius (rndf))) root 
		        (vmul col (rndf))
		  		(length path) (length profile))))
		   (send new-fin build)
		  (set! fins (cons new-fin fins))))
	  
	    (for-each
		  (lambda (fin)
		    (send fin update t d))
		  fins)

	    (for-each
		  (lambda (twiglet)
		    (send twiglet update t d))
		  twiglets)
	  
        (when (and (not (eq? grow-t -1)) (not (eq? grow-t 999)))
	      ; randomly add twiglets as we are growing
		  (when (and (zero? (random 100)) (< grow-t num-points))
		  	(let ((t (make-object twiglets% (get-root)))
			      (pi (inexact->exact (floor grow-t))))
				(send t build (get-point pi) dir (/ (get-width pi) 2) 20)
				(set! twiglets (cons t twiglets))))	
          (with-primitive root
            (partial-extrude grow-t profile path widths (vector 1 0 0) 0.05)))
		
		(when (> shrink-t 0)
          (with-primitive root
            (partial-extrude shrink-t profile path widths (vector 1 0 0) 0.05)))		
		   
		#;(when (not (growing?))
			(with-primitive root
              (pre-ripple)
		      (ripple t 1 0.001))))
      
      (define/public (get-end-pos)
          (list-ref path (if (zero? index) 0 (- index 1)))
        #;(with-primitive root (pdata-ref "p" (- (* index (length profile)) 1))))

      (super-new)))

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

(define plant-view%
    (class object%
      
      (init-field
       (id "none")
       (pos (vector 0 0 0))
       (size 0)
       (col (vector 1 1 1))
       (tex "")
	   (is-player #f))
       
       (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 (let ((p (with-state
               (parent root)
               (shader "shaders/seed.vert.glsl" "shaders/seed.frag.glsl")
               (texture (load-texture "textures/cells-1.png"))
               (multitexture 1 (load-texture "textures/cells-2.png"))
               (multitexture 2 (load-texture "textures/cells-3.png"))
			   (multitexture 3 (load-texture "textures/root-norm.png"))
			   (backfacecull 0)
               (opacity 0.75)
               (colour col)
               (hint-depth-sort)
               (scale (* 0.06 size))
                            (when wire-mode 
                              (hint-none)
                              (hint-wire))
               ;(hint-unlit)
               (load-primitive "meshes/seed.obj"))))
			   (with-primitive p 
    			   (shader-set! (list "Maps" (list 0 1 2) "NormalMap" 3)))    			
			    p))
	(dust (if is-player (with-state
		(parent root)
		(make-object dust%)) #f))
    (nutrients (if is-player (let ((p (with-state
                            (hint-depth-sort)
                            (hint-unlit)
                            (parent root)
                            (blend-mode 'src-alpha 'one)
                            (texture (load-texture "textures/smoke.png"))
                            (build-particles 100))))
                        (with-primitive p
                                      (pdata-add "twig" "f")
                                      (pdata-add "point" "f")
                                      (pdata-add "offset" "v")
                                      (pdata-add "speed" "f")
                                      (pdata-map! 
                                       (lambda (point)
                                         0)
                                       "point")
                                      (pdata-map! 
                                       (lambda (point)
                                         (* 3 (+ 0.1 (rndf))))
                                       "speed")
                                      (pdata-map! 
                                       (lambda (offset)
                                         (vector 0 0 0))
                                       "offset")
                                      (pdata-map! 
                                       (lambda (c)
                                         (vector 1 1 1))
                                       "c")
                                      (pdata-map! 
                                       (lambda (p)
                                         (vmul (vadd (crndvec) (vector 0 -1 0)) 900))
                                       "p")
                                      (pdata-map! 
                                (lambda (s)
                                    (vmul (vector 1 1 1) (+ 0.1 (rndf))))
                                "s"))
                        p) #f)))
        
      (define/public (is-player?)
        is-player)

      (define/public (get-id)
        id)
      
      (define/public (get-col)
        col)
      
      (define/public (get-twig twig-id)
        (let ((l (assq twig-id twigs)))
          (if l              
              (cadr (assq twig-id twigs))
              #f)))						  
      
      (define/public (destroy-branch-twig twig-id)
	    (when (get-twig twig-id) ; might have destroyed itself already
          (for-each
           (lambda (twig-id)
             (destroy-branch-twig twig-id))
           (send (get-twig twig-id) get-child-twig-ids))
          (send (get-twig twig-id) destroy-twig))
        (set! twigs (assoc-remove twig-id twigs)))
      
      (define/public (destroy-plant)
        (destroy root)
        (for-each
         (lambda (twig)
           (destroy-branch-twig (car twig)))
         twigs))
   
      (define/public (shrink-twig twig-id)
        (send (get-twig twig-id) start-shrinking)
		(for-each
         (lambda (twig-id)
           (shrink-twig twig-id))
         (send (get-twig twig-id) get-child-twig-ids)))
      
      (define/public (add-twig parent-twig-id point-index twig)
        (let ((ptwig (get-twig parent-twig-id)))
          (when ptwig                        
            (send twig set-pos! (send ptwig get-point point-index)) ; attach to parent twig   
            ; 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))
            
          (send twig set-col! col)   
          (send twig set-tex! tex)   
          (send twig build)
          
          (with-primitive (send twig get-root)
                          (parent root))
                    
          (set! twigs (cons (list (send twig get-id) twig) twigs))))
      
      (define/public (add-twig-point twig-id point width)
          (when (get-twig twig-id)
             (send (get-twig twig-id) add-point point width is-player)))

      (define/public (start-twig-growing twig-id)
        (when (get-twig twig-id)
          (send (get-twig twig-id) start-growing)))
      
      (define/public (grow-seed amount)
        (with-primitive seed (scale amount)))
      
      (define/public (add-ornament twig-id point-index property)
        (when (get-twig twig-id)
          (send (get-twig twig-id) add-ornament point-index property)))

	(define/public (set-excitations! a b)
	  (for-each 
         (lambda (twig)
           (send (cadr twig) set-excitations! a b))
         twigs))
      
	  (define/public (nutrient-absorb twig-id twig-point)
	    (when is-player 
		(with-primitive nutrients
	  	(let ((p (random (pdata-size))))
		  (pdata-set! "twig" p twig-id)
		  (pdata-set! "point" p twig-point)
		  (pdata-set! "p" p (send (get-twig twig-id) get-point twig-point))
		  (pdata-set! "offset" p (vmul (srndvec) (
		     send (get-twig twig-id) get-width twig-point)))))))
			 
      (define/public (update-nutrients t d)
 		 (when (and is-player (not (null? twigs)))
 			(with-primitive nutrients
 							(pdata-index-map!
 							 (lambda (i p twig-id point offset speed)
 							   (let* ((twig-id (inexact->exact twig-id))
 									  (twig (get-twig twig-id))
 									  (point (inexact->exact point)))
 							   (cond 
 								 ((or (< point 1) (not twig))
 								  (let* ((new-twig (choose twigs))
 										 (num-points (send (cadr new-twig) get-num-points))
 										 (new-point (if (zero? num-points) 0 (random num-points))))
 									(pdata-set! "twig" i (car new-twig))
 									(pdata-set! "point" i new-point)
 									(pdata-set! "offset" i (vmix offset (vmul (srndvec) (send (cadr new-twig) get-width new-point)) 0.2))
 									(send (cadr new-twig) get-point new-point)))
 								 ((< (vdist (vadd (send twig get-point point) offset) p) 0.1)
 								  (pdata-set! "point" i (- point 1))							   
 								  (vadd p (vmul (vnormalise (vsub (vadd (send twig get-point (- point 1)) offset) p)) (* speed d))))
 								 (else
 								  (vadd p (vmul (vnormalise (vsub (vadd (send twig get-point point) offset) p)) (* speed d)))))))
 							 "p" "twig" "point" "offset" "speed"))))

	  (define/public (above-ground)
	  	(when dust (send dust set-above-ground #t)))

	  (define/public (below-ground)
	  	(when dust (send dust set-above-ground #f)))
              
      (define/public (update t d)
	  	(when dust (send dust update t d))
	  
	     (with-primitive seed
		 	(shader-set! (list "Time" t))
			#;(let ((t (inexact->exact (round (fmod (* 5 t) 3)))))
				(cond 
					((eq? t 0) (texture (load-texture "textures/cells-1.png")))
					((eq? t 1) (texture (load-texture "textures/cells-2.png")))
					((eq? t 2) (texture (load-texture "textures/cells-3.png"))))))

	  
        (update-nutrients t d)
        (with-primitive seed
                        (scale (+ 1 (* 0.001 (sin (* 2 t))))))                       
        (for-each 
         (lambda (twig)
           (when (send (cadr twig) delme?)
		   	  (destroy-branch-twig (car twig))))
         twigs)
		 
        (for-each 
         (lambda (twig)
           (send (cadr twig) update t d))
         twigs))
        
      (super-new)))

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

(define (build-env-box top bottom left right front back lower)    
  (let ((p (build-locator)))
    (with-state
     (parent p)
  (hint-unlit)  
  
  (list
  (let ((t (with-state
        (texture (load-texture top))
        (translate (vector 0 0.5 0))
        (rotate (vector 90 0 0))
        (build-plane))))
      (when lower (with-primitive t
                      (pdata-map!
                       (lambda (t)
                         (vmul t 10))
                       "t"))
                       ) t)
    
    (with-state
        (texture (load-texture left))
        (translate (vector 0 0 -0.5))
        (rotate (vector 0 0 0))
        (build-plane))
    
    (with-state
        (texture (load-texture back))
        (translate (vector 0.5 0 0))
        (rotate (vector 0 90 0))
        (build-plane))
    
    (with-state
        (texture (load-texture right))
        (translate (vector 0 0 0.5))
        (rotate (vector 0 0 0))
        (build-plane))
    
    (with-state
        (texture (load-texture front))
        (translate (vector -0.5 0 0))
        (rotate (vector 0 90 0))
        (build-plane))
    
    (if lower
      (with-state
        (texture (load-texture bottom))
        (translate (vector 0 -0.5 0))
        (rotate (vector 90 0 0))        
        (build-plane)) 0)))))

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

(define grow-hud%
  (class object%
	  
	(field
	 (cam #f)
	 (hud (build-locator))
	 (grow-mode-hud 
	   (let ((p (with-state 
	     (parent hud) 
		 (translate (vector 0 0 3))
		 (scale (vector 1.3 1 1))
		 (hint-depth-sort)
		 (hint-nozwrite)
		 (texture (load-texture "textures/grow-mode-hud.png"))
		 (hint-unlit)
		 (build-plane))))
		 (with-primitive p (hide 1)) p))
     (grow-mode-hud-state #f)
	 (grow-mode-hud-t 2)
	 (markers (make-marker-list 10))
	 (next-marker 0)
	 (text-list '())
	 (next-text-t -1)
	 (new-text #f))

	(define/public (make-marker-list n)
		(build-list n 
	 		(lambda (_)
				(let ((p (with-state
                    (parent hud)
					(hint-unlit)
					(colour 0.5)
                    (build-sphere 8 8))))
					(with-primitive p (hide 1)) p))))
				
	(define/public (set-cam s)
		(set! cam s)
		(with-primitive hud
			(parent cam)))

	(define/public (set-mode-on num-markers)
		(when (> num-markers (length markers))
			(set! markers (append markers (make-marker-list 10))))
			
		(set! next-marker 0)
	
		(for ((i (in-range 0 num-markers)))
			(with-primitive (list-ref markers i)
			    (identity)
                (scale 0.1)
				(hide 0)
				(let ((a (* (/ i num-markers) 360 0.0174532925)))
  				  (translate (vmul (vector (sin a) (cos a) 0) 15)))))
	
		(with-primitive grow-mode-hud (hide 0) (opacity 0))
		(set! grow-mode-hud-state #t)
		(set! grow-mode-hud-t 0))

	(define/public (set-mode-off)
		(with-primitive grow-mode-hud (hide 0) (opacity 0))
		(set! grow-mode-hud-state #f)
		(set! grow-mode-hud-t 0))
	
	(define/public (display text time)
		(set! new-text #t)
		(set! text-list (append text-list (list (list time (let ((t (with-state
			(build-type "meshes/zeimusu_-_Let_s_Trace_Basic.ttf" text))))
			(let* ((p (type->poly t))
				   (shad (build-copy p)))
			(destroy t)
  			(with-primitive p
			  (hide 1)
			  (parent hud)
			  (hint-unlit)
			  (colour 1)
			  (scale 0.08)
			  (translate (vector 0 10 0))
			  ; subtract the centre point to centre the text
			  (let ((c (vdiv (pdata-fold vadd (vector 0 0 0) "p") (pdata-size))))
			    (translate (vmul c -1))))
			(with-primitive shad
				(parent p)
				(translate (vector 0 0 -0.01))
				(hint-wire)
				(wire-colour (vector 0 0 0))
				(line-width 5))
				 p)))))))
			
	(define/public (update-text t d)
	  
	  (when (and new-text (eq? next-text-t -1))
	  	(set! next-text-t (+ t (car (car text-list)))))
      
	  (set! new-text #f)
	  
	  (when (not (null? text-list))
	    (let ((i (car text-list)))
		  (with-primitive (cadr i) (hide 0))
		  (when (> t next-text-t)
			(destroy (cadr i))
			(set! text-list (cdr text-list))
			(if (null? text-list)
				(set! next-text-t -1)
				(set! next-text-t (+ t (car (car text-list)))))))))
			
	(define/public (scrub-marker)
		(with-primitive (list-ref markers next-marker)
			(hide 1))
		(set! next-marker (+ next-marker 1)))
		
	(define/public (update t d)
		(update-text t d)
		(when (< grow-mode-hud-t 1)
			(with-primitive grow-mode-hud
				(opacity (if grow-mode-hud-state 
					(* grow-mode-hud-t 0.5)
					(* (- 1 (* grow-mode-hud-t )) 0.5)))))
					
		(when (and (> grow-mode-hud-t 1) (not grow-mode-hud-state))
			(with-primitive grow-mode-hud (hide 1)))
			
		(set! grow-mode-hud-t (+ grow-mode-hud-t d 0.02)))
					
	(super-new)))


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

(define game-view%
  (class object%
    
    (field
     (plants '()) ; map of ids -> plants     
     (pickups '()) ; map of ids -> pickups
	 (insects '()) ; map of ids -> insects
     (camera-dist 1)
     (env-root (with-state (scale 1000) (build-locator)))
     (root-camera-t 0)
     (num-msgs 0)
	 (grow-hud (make-object grow-hud%))
	 (floor #f)

     #;(upper-env (with-state
                 (parent env-root)
                 (hint-depth-sort)
                 (colour 2)
                 (translate (vector 0 0.28 0))
                 (build-env-box "textures/top.png" "textures/bottom-trans.png" 
                                "textures/left.png" "textures/right.png"
                                "textures/front.png" "textures/back.png")))
    #;(lower-env (with-state
                (parent env-root)
                 (hint-depth-sort)
                 (translate (vector 0 -0.22001 0))
                 (build-env-box "textures/bottom-trans.png" "textures/bottom.png" 
                                "textures/sleft.png" "textures/sright.png"
                                "textures/sfront.png" "textures/sback.png")))
    #;(upper-env (with-state
                 (parent env-root)
                 ;(hint-depth-sort)
                 (hint-unlit)
                 (translate (vector 0 0.28 0))
                 (build-env-box "textures/sky-top.png" "textures/floor.png" 
                                "textures/sky-side.png" "textures/sky-side.png"
                                "textures/sky-side.png" "textures/sky-side.png" #f)))
    #;(lower-env (with-state
                (parent env-root)
                 ;(hint-depth-sort)
                 (hint-unlit)
                 (colour (earth-colour))
                 (translate (vector 0 -0.22001 0))
                 (build-env-box "textures/floor.png" "textures/earth-bottom.png" 
                                "textures/earth-side.png" "textures/earth-side.png"
                                "textures/earth-side.png" "textures/earth-side.png" #t)))
                                
    (stones '())
	(ground-change-t 0)
	(going-up #f))
    
    (define/public (setup world-list)      
      (let ((l (make-light 'point 'free)))
      (light-diffuse 0 (vector 0.5 0.5 0.5))
      (light-diffuse l (vector 1 1 1))
      (light-position l (vector 10 50 -4)))
	  (below-ground)      
      (set! stones
           (map 
              (lambda (stone)
                (let ((p (with-state  
                          (hint-frustum-cull)
                 ;(shader "shaders/toon.vert.glsl" "shaders/toon.frag.glsl")
                 (colour (stones-colour))
                 (translate (list-ref stone 2))
                 (scale (list-ref stone 3))
                 (rotate (list-ref stone 4))
                 (texture (load-texture "textures/stone.png"))
                 (load-primitive (list-ref stone 1)))))
                  (with-primitive p (apply-transform) (recalc-bb)) ; apply the transform to speed up the ray tracing, don't have to tranform the ray into object space
                  p))
              (list-ref world-list 2)))
	  (set! floor (let ((p (with-state
	 	(hint-unlit)
		(colour 0.2)
        (texture (load-texture "textures/stone.png"))
        (translate (vector 0 10 0))
        (rotate (vector 90 0 0)) 
		(scale 1000)       
		(backfacecull 0)
        (build-seg-plane 10 10))))
		(with-primitive p
			(pdata-map!
				(lambda (t)
					(vmul t 10))
				"t")) p)))

	(define/public (set-cam s)
		(send grow-hud set-cam s))

	(define/public (above-ground)
		(printf "above-ground~n")
	  (for-each
	  	(lambda (plant)
		  	(send (cadr plant) above-ground))
		plants)
	  (for-each
	  	(lambda (pickup)
			(with-primitive (send (cadr pickup) get-root) (hide 1)))
		pickups)
	  (set! going-up #t)
	  (set! ground-change-t ground-change-duration))

	(define/public (below-ground)
		(printf "below-ground~n")
	  (for-each
	  	(lambda (plant)
		  	(send (cadr plant) below-ground))
		plants)
	  (for-each
	  	(lambda (pickup)
			(with-primitive (send (cadr pickup) get-root) (hide 0)))
		pickups)
	  (set! going-up #f)
	  (set! ground-change-t ground-change-duration))
 
	(define/public (update-ground-change t d)
	    (when (> ground-change-t 0)
			(set! ground-change-t (- ground-change-t d))
			(let* ((t (/ ground-change-t ground-change-duration))
			      (anim-t (if going-up t (- 1 t))))
			 (set-fov 53 0.1 (lerp 100 500 anim-t))
 			 (clear-colour (vmix fog-col above-fog-col anim-t))
			 (fog (vmix fog-col above-fog-col anim-t) (lerp 0.04 0.01 anim-t) 1 100))))
	
    (define/public (get-stones)
      stones)
    
    (define/public (add-plant plant)
      ;(destroy-plant (send plant get-id)) ; just in case
      (set! plants (cons (list (send plant get-id) plant) plants)))
    
    (define/public (get-plant plant-id)
      (let ((p (assoc plant-id plants)))
        (if (not p) #f (cadr p))))
    
    (define/public (destroy-plant plant-id)
      (let ((p (get-plant plant-id)))
        (when p (send p destroy-plant)
          (set! plants (assoc-remove plant-id plants)))))
    
    (define/public (destroy-branch-twig plant-id twig-id)
      (send (get-plant plant-id) destroy-branch-twig twig-id))
    
    (define/public (add-twig plant-id parent-twig-id point-index twig)
      (when (get-plant plant-id)
        (send (get-plant plant-id) add-twig parent-twig-id point-index twig)))
    
    (define/public (grow-seed plant-id amount)    
      (when (get-plant plant-id)
        (send (get-plant plant-id) grow-seed amount)))
    
    (define/public (get-pickup pickup-id)
	  (let ((p (assq pickup-id pickups)))
	  	(if p (cadr p) #f)))
    
    (define/public (add-pickup pickup-id type pos)
      (set! pickups (cons (list pickup-id (make-object pickup-view% pickup-id type pos)) pickups)))

    (define/public (add-insect insect-id pos type)
		(cond 
			((eq? type 'worm)
		      (set! insects (cons (list insect-id 
			  		(make-object worm-insect-view% insect-id pos type)) insects)))
			((eq? type 'spider)
		      (set! insects (cons (list insect-id 
			  		(make-object spider-insect-view% insect-id pos type)) insects)))
			((eq? type 'butterfly)
		      (set! insects (cons (list insect-id 
			  		(make-object butterfly-insect-view% insect-id pos type)) insects)))))

    (define/public (get-insect insect-id)
      (cadr (assq insect-id insects)))
     
    (define/public (pick-up-pickup pickup-id point)
	  (let ((pu (get-pickup pickup-id)))
	  (when pu
        (send (get-pickup pickup-id) pick-up point))))

    (define/public (highlight-pickup plant-id pickup-id)
	 (let ((pu (get-pickup pickup-id)))
	  (when pu
	    (let* ((p (get-pickup pickup-id))
		      (type (send p get-type)))
        (send p highlight)
		(when (send (get-plant plant-id) is-player?)
		  (display 
		    (cond 
        	   ((eq? type 'wiggle) "wiggle found")
        	   ((eq? type 'leaf) "leaf found")
        	   ((eq? type 'curly) "curly found")
        	   ((eq? type 'nutrient) "nutrients found")
        	   ((eq? type 'horn) "horn found")
        	   ((eq? type 'inflatoe) "inflatoe found")
        	   ((eq? type 'fork) "fork found")
        	   ((eq? type 'flower) "flower found")) 4))))))
    	
    (define/public (add-ornament plant-id twig-id point-index property)
      (when (get-plant plant-id)
        (send (get-plant plant-id) add-ornament twig-id point-index property)))
  
    (define/public (shrink-twig plant-id twig-id)
      (when (get-plant plant-id)
        (send (get-plant plant-id) shrink-twig twig-id)))
                        
	(define/public (set-excitations! a b)
	  (for-each 
       (lambda (plant)
         (send (cadr plant) set-excitations! a b))
       plants))	   
	   
	(define/public (set-grow-mode-on num)
		(send grow-hud set-mode-on num))

	(define/public (set-grow-mode-off)
		(send grow-hud set-mode-off))
		
	(define/public (scrub-marker)
		(send grow-hud scrub-marker))
	
	(define/public (display text time)
		(send grow-hud display text time))
	
    (define/public (update t d messages)                     
	   
	  (update-ground-change t d)
	  (send grow-hud update t d)
	  
	  (for-each 
       (lambda (plant)
         (send (cadr plant) update t d))
       plants)

      (for-each 
       (lambda (pickup)
         (send (cadr pickup) update t d))
       pickups)

      (for-each 
       (lambda (insect)
         (send (cadr insect) update t d))
       insects)
      
      (when debug-messages
        (for-each
         (lambda (msg)
           (send msg print))
         messages))    
	
	 (set! pickups (filter 
                     (lambda (pickup)
                       (not (send (cadr pickup) delme?)))
                     pickups))  
					  
      (for-each
       (lambda (msg)
         (cond
           ((eq? (send msg get-name) 'player-plant) 
            (printf "adding player plant to view ~a~n" (send msg get-data 'plant-id))
            (add-plant (make-object plant-view% 
                         (send msg get-data 'plant-id) 
                         (send msg get-data 'pos)
                         (send msg get-data 'size)
                         (send msg get-data 'col)
                         (send msg get-data 'tex) #t)))
                      
           ((eq? (send msg get-name) 'new-plant)
            (printf "adding new plant to view ~a~n" (send msg get-data 'plant-id))
            (add-plant (make-object plant-view% 
                         (send msg get-data 'plant-id) 
                         (send msg get-data 'pos)
                         (send msg get-data 'size)
                         (send msg get-data 'col)
                         (send msg get-data 'tex))))
                      
          
           ((eq? (send msg get-name) 'grow-seed)
            (grow-seed (send msg get-data 'plant-id) 
                       (send msg get-data 'amount)))
           
           ((eq? (send msg get-name) 'destroy-branch-twig)
            (destroy-branch-twig (send msg get-data 'plant-id) (send msg get-data 'twig-id)))          
           
           ((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) 'add-twig-point)
		     (when (get-plant (send msg get-data 'plant-id))
               (send (get-plant (send msg get-data 'plant-id)) add-twig-point
                  (send msg get-data 'twig-id)
                  (send msg get-data 'point)
                  (send msg get-data 'width))))
           
           ((eq? (send msg get-name) 'start-growing)
 		     (when (get-plant (send msg get-data 'plant-id))
               (send (get-plant (send msg get-data 'plant-id)) start-twig-growing
                  (send msg get-data 'twig-id))))                  
           
           ((eq? (send msg get-name) 'new-pickup)
            (add-pickup 
             (send msg get-data 'pickup-id) 
             (send msg get-data 'type) 
             (send msg get-data 'pos)))
			            
           ((eq? (send msg get-name) 'pick-up-pickup)
            (pick-up-pickup 
             (send msg get-data 'pickup-id)
			 (send msg get-data 'point)))
 
           ((eq? (send msg get-name) 'pick-up-highlight)
            (highlight-pickup
             (send msg get-data 'plant-id)
			 (send msg get-data 'pickup-id)))

           ((eq? (send msg get-name) 'shrink-twig)
            (shrink-twig
			 (send msg get-data 'plant-id)
			 (send msg get-data 'twig-id)))

          ((eq? (send msg get-name) 'new-ornament)
		   (add-ornament 
			(send msg get-data 'plant-id)
			(send msg get-data 'twig-id)
			(send msg get-data 'point-index)
			(send msg get-data 'property)))
			   
           ((eq? (send msg get-name) 'vrob)
                (set! num-msgs (+ num-msgs 1))
            (printf "num light-level msgs: ~a~n" num-msgs)
			 (set-excitations! 
			 	(send msg get-data 'light-level) 
			 	(send msg get-data 'soil-moisture))
             #;(for-each 
                  (lambda (p)
                  (with-primitive p
                      (colour (send msg get-data 'amount))))
                    upper-env))
           
		   ((eq? (send msg get-name) 'new-insect)
            (add-insect  
                         (send msg get-data 'insect-id) 
                         (send msg get-data 'pos)
                         (send msg get-data 'type)))
            
			((eq? (send msg get-name) 'insect-move)
               (send (get-insect (send msg get-data 'insect-id)) move
                  (send msg get-data 'pos)
                  (send msg get-data 'duration)))
                      
           ))
       messages))
    
    


    (super-new)))