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"
  "path-gen.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 0 0))
(define (dust-colour) (vmul (vector 0.05 0.05 0.05) (* 2 (rndf))))
(define (stones-colour) (vector 0.55 0.5 0.45))
(define (alive-colour) (vmul (vector 1 1 1) (+ 0.5 (* (rndf) 0.5))))
(define (worm-colour) (vmul (vector 1.0 0.8 0.8) (+ 0.5 (* (rndf) 0.5))))
(define (marker-colour) (vector 0.3 0.8 0.3))
(define (sky-colour) (vdiv (vector 170 153 135) 256))

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

(define above-fog-col (vector 0.9 0.9 1))
(define above-fog-strength 0.01)
(define ground-change-duration 4)

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

(define max-twiglets-per-twig 10)

 
(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 500))))
                (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.01)
		(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 from)
            (from-dir (vector 0 0 0))
            (to-dir (vector 0 0 0))
            (time 0)
            (tick 1)
			(speed 0)
			(idle-sound-time (+ 2 (* (rndf) 10))))
                
        (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 (play-idle-sound pos)
			(cond
				((eq? type 'worm) (play-sound 'worm-idle pos))
				((eq? type 'butterfly) (play-sound 'butterfly-idle pos))
				((eq? type 'spider) (play-sound 'spider-idle pos))))
		
        (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))
    	 		 (when (< idle-sound-time 0)
					(set! idle-sound-time (+ 2 (* (rndf) 10)))
			 		(play-idle-sound (car h)))
				 (set! speed (vmag (cadr h)))
                 (concat (maim (vector 0 1 0) (vnormalise (cadr h)))))
				 
               (set! time (+ time d))
			   (set! idle-sound-time (- idle-sound-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 speed)      
        (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
						(set! anim-d (* 0.01 (/ 1 (max 0.0001 speed))))
						(when (> anim-t anim-d)
							(set! anim-t 0)
							(set! blendshape (modulo (+ blendshape 1) 3))
							(set-blendshape blendshape))
                        (identity)                        
						(do-tx t d)	
						(rotate (vector 0 0 -90))					
                        (scale 0.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 (with-state
					(hint-unlit)
					(colour 0)
					(load-primitive "meshes/butterfly-body.obj"))))
        		(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 from)
            (from-dir2 from-dir)
       		(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 'nutrient) (colour (vector 1 1 0.5)) (build-squiggle 2 2))
              ((eq? type 'leaf) (colour (vector 0.5 1 0.5)) (build-squiggle 2 4))
              ((eq? type 'horn) (colour (vector 0.5 1 1)) (build-squiggle 3 4))
              ((eq? type 'inflatoe) (colour (vector 1 0.5 0.5)) (build-squiggle 4 5))
              ((eq? type 'fork) (colour (vector 0.5 0.5 1)) (build-squiggle 5 2))
              ((eq? type 'flower) (colour (vector 1 0.5 0.75)) (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 sp) 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)
	        (play-sound 'twig-start-growing 
				(with-primitive (get-root) (vtransform (vector 0 0 0) (get-global-transform))))
            (set! grow-t 0)
            (set! markers (cons (build-locator) markers)))
        
        (define/pubment (start-shrinking)
			(play-sound 'twig-start-decay 
				(with-primitive (get-root) (vtransform (vector 0 0 0) (get-global-transform))))
            (set! shrink-t (if (growing?) grow-t (+ num-points grow-overshoot)))
			(for-each
				(lambda (o)
					(send (cadr o) start-shrinking))
				ornaments)
			(inner (void) start-shrinking))
        
        (define/pubment (add-point point width make-marker)
            (when make-marker
	            (play-sound 'place-marker (vadd point (with-primitive (get-root)
					(vtransform (vector 0 0 0) (get-global-transform)))))
                (set! markers (append markers (list (let ((p (with-state
                                (parent (get-root))
                                (translate point)
                                (scale 0.001)
                                (colour (marker-colour))
                                (build-sphere 8 8)))) (with-primitive p (shader-set! (list "Pos" point))) p)))))
            
            (inner (void) add-point point width make-marker))
        
		(define/pubment (update-markers t d)
			(for-each 
				(lambda (marker)
					(with-primitive marker
						(let ((sc (vmag (vtransform-rot (vector 0 1 0) (get-transform)))))
							(when (< sc 0.1)
								(scale (+ 1.0 (* d 1)))))))
				markers))
		
        (define/public (add-ornament point-index property)          
            (when (< point-index grow-t)
				(play-sound 'twig-new-ornament 
					(vadd (get-point point-index) 
						(with-primitive (get-root) (vtransform (vector 0 0 0) (get-global-transform)))))
                (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)))
                          (set! ornaments (cons (list point-index ornament) ornaments))))))
        
        (define/pubment (set-excitations! a b)
            (for-each
                (lambda (ornament)
                    (send (cadr ornament) set-excitations! a b))
                ornaments))
        
        (define/pubment (update t d)        
            (inner (void) update t d)     
			
			(update-markers t d)
			
            (when (> shrink-t 0) 
                (set! shrink-t (- shrink-t (* d grow-speed))))
            
            (when (< shrink-t 0)
                (set! delme #t))
 
			(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)))
					#;(play-sound 'twig-eat-marker 
						(with-primitive (car markers) (vtransform (vector 0 0 0) (get-global-transform))))
                    (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 grow-speed shrink-t)
		(inherit growing?)
        
        (field
            (root 0)
            (widths '())
            (points '())
            (global-growth 0)
            (global-growth-time 20)
			(finalised #f))
        
		
        (define/override (build sp)
			(set! grow-speed (* grow-speed 5))
            (set! root (let ((p (with-state
                                (translate pos)
								(hint-frustum-cull)
                                (colour col)
                                (hint-unlit)
								(shader "shaders/ribbon.vert.glsl" "shaders/ribbon.frag.glsl")
                                (texture (load-texture "textures/ribbon-twig.png")) 
                                (build-ribbon num-points))))
                    (with-primitive p
						(shader-set! (list "Base" 0 "Origin" pos))
                        (pdata-map! 
                            (lambda (w)
                                0)
                            "w")
                        (pdata-set! "w" 0 radius))
                    p)))
        
        
        (define/override (get-root)
            root)

        (define/public (finalised?)
            finalised)
        
        #;(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 (start-shrinking)
			(set! grow-speed (* grow-speed 3)))
		
        (define/augment (update t d)
            (when (and (> grow-t 0) (< grow-t (+ (length points) 10)))
                (with-primitive root
					(identity)
					(translate pos)
					(scale (/ global-growth global-growth-time))
                    (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")
					(recalc-bb)))
					
			(when (> shrink-t 0)
        	  (with-primitive root
            	(identity)
				(translate pos)
				(scale (/ shrink-t (+ num-points grow-overshoot)))))
						
			(when (and (not (growing?)) (not finalised))
				(with-primitive root
					(recalc-bb)
					(hint-frustum-cull))
				(set! finalised #t))

             (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)
			(col (vector 1 1 1))
			(shape-params '(0 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)
				(send t set-col! col)
                (with-state
                    (parent par)
                    (send t build shape-params))
                (let ((path-gen (make-object path-gen% (car shape-params) (cadr shape-params) 
														(vector 0 0 0) (send t get-dir)))
                        (ppos (vector 0 0 0)))
                    (for ((i (in-range 0 length)))
							(let ((width (if (eq? i (- length 1)) 0 (/ width (+ i 1)))))
                            (send t add-point (send path-gen get-pos (* 5 width)) width #f))))
                (send t start-growing)
                t))
        
        
        
        (define/public (update t d)
            (for-each 
                (lambda (twig)
                    (send twig update t d)
                    (when (and 
                            (< (length twigs) 10)
                            (> (send twig get-num-points) 5) 
                            (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)
			
			#;(set! twigs (filter
				(lambda (twig)
					(not (send twig finalised?)))
				twigs)))
        
		(define/public (start-shrinking)
			(for-each
				(lambda (twig)
					(send twig start-shrinking))
				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
	  	ornaments grow-speed delme markers marker-destroy-t)
      
      (field
       (profile '())
       (path '())
       (root 0)
       (widths '())
	   (fins '())
	   (twiglets '())
	   (finalised #f)
	   (shape-params '(0 0)))
      
      (define/override (build sp)
	   (set! shape-params sp)
       (set! profile (build-circle-points 7 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))
							 (ambient (vmul col 0.5))
                        (shader "shaders/tree.vert.glsl" "shaders/tree.frag.glsl")
                       (texture (load-texture "textures/root-norm.png"))
                        (colour col)
                       (build-partial-extrusion profile path 3))))
				(with-primitive p 				
				   (shader-set! (list "NormalMap" 0)))

               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/augment (start-shrinking)
		(for-each
			(lambda (o)
				(send o start-shrinking))
			twiglets))

      (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)                   
            
			(for-each
                (lambda (ornament)
                    (send (cadr ornament) update t d))
                ornaments)           


		(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)
					 (> grow-t 3)
					 (< (length twiglets) max-twiglets-per-twig))				
		  	(let ((t (make-object twiglets% (get-root) col shape-params))
			      (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 (and (not (growing?)) (not finalised))
			(with-primitive root
				(recalc-bb)
				(hint-frustum-cull))
			(set! finalised #t))
						
			)
      
      (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)
	   (shape-params '(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 (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)
               (ambient (vmul col 0.5))
               (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 (and #f is-player) (let ((p (with-state
                            ;(hint-depth-sort)
							(hint-nozwrite)
                            (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 shape-params)
          
          (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) 0
        (when (get-twig twig-id)
          (send (get-twig twig-id) add-ornament point-index property)))

	(define/public (hide-twigs s)
		(for-each
			(lambda (twig)
				(with-primitive (send (cadr twig) get-root)
					(hide s)))
			twigs))

	(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 nutrients
		(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 nutrients (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)
	  	(play-sound 'going-above-ground pos)
	  	(when dust (send dust set-above-ground #t)))

	  (define/public (below-ground)
	  	(play-sound 'going-below-ground pos)
	  	(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 (build-locator)
	   #;(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 
				(- num-markers (length markers))))))
			
		(set! next-marker 0)
	
		(for ((i (in-range 0 num-markers)))
			(with-primitive (list-ref markers i)
			    (identity)
                (scale 0.1)
				(colour (marker-colour))
				(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/pensharp.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.04)
			  (translate (vector 0 10 5))
			  ; 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)
			(scale 0.99))
		(set! next-marker (+ next-marker 1)))
		
	(define/pubment (update-markers t d)
		(for-each 
			(lambda (marker)
				(with-primitive marker
					(let ((sc (vmag (vtransform-rot (vector 0 1 0) (get-transform)))))
						(when (and (< sc 0.1) (> sc 0))
							(scale (- 1.0 (* d 1)))))))
			markers))
		
	(define/public (update t d)
		(update-text t d)
		(update-markers 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 0 0))
      (light-diffuse l (vector 1 1 1))
      (light-position l (vector 0 500 0)))
      (set! stones
           (map 
              (lambda (stone)
                (let ((p (with-state  
                          (hint-frustum-cull)
                 (colour 1)
				 (ambient 0.5)
                 (translate (list-ref stone 2))
                 (scale (list-ref stone 3))
                 (rotate (list-ref stone 4))
				 (cond 
				 	((eq? (list-ref stone 0) 'stone)
                		(colour (stones-colour))
                		(ambient (vmul (stones-colour) 0.5))
						(shader "shaders/tree.vert.glsl" "shaders/rocks.frag.glsl")
						(texture (load-texture "textures/root-norm.png")))
				 	((eq? (list-ref stone 0) 'tree)
						(colour (vector 0.45 0.4 0.3))
	   					(ambient (vmul (vector 0.45 0.4 0.3) 0.5))
						(shader "shaders/tree.vert.glsl" "shaders/rocks.frag.glsl")
                 		(texture (load-texture "textures/root-norm.png")))
				 	((eq? (list-ref stone 0) 'bg)
						(hint-unlit)
						(translate (vector 0 12 0))
						(colour 1)
                 		(texture (load-texture "textures/bg3.png"))))
						
                 (load-primitive (list-ref stone 1)))))
                  (with-primitive p 				 
				  	#;(when (eq? (list-ref stone 0) 'stone)
				 		(pdata-map!
							(lambda (t)
								(vmul t 4))
							"t"))
					(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-none)
	 	(hint-unlit)
		(hint-wire)
		(colour 0.5)
		;(opacity 0.2)
        (texture (load-texture "textures/top.png"))
		(hint-vertcols)
        (translate (vector 0 0 0))
        (rotate (vector 90 0 0)) 
		(scale 500)       
		(line-width 2)
		(backfacecull 0)
        (build-seg-plane 80 80))))
		(with-primitive p
			(poly-convert-to-indexed)
			(pdata-map!
				(lambda (t)
					(vmul t 10))
				"t")
			(pdata-map!
				(lambda (c)
					(vmul (vector 1 0.8 0.7) (rndf)))
				"c")			
			(pdata-map!
				(lambda (p)
					(vadd p (vmul (grndvec) 0.001)))
				"p")) p))
	  (with-state ; cap the top of the world
	  	(translate (vector 0 300 0))
		(rotate (vector 90 0 0))
		(scale 5000)
		(hint-unlit)
		(colour (sky-colour))
		(build-plane))
	  (below-ground))

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

	(define/public (above-ground)
	  #;(with-primitive floor
		(colour (vector 0.4 0.6 0.4))
        (texture (load-texture "textures/top.png")))
	  (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)
	  #;(with-primitive floor
        (texture (load-texture "textures/top.png"))
		(colour (vector 0.4 0.6 0.4)))
	  (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 (max 0 (/ ground-change-t ground-change-duration)))
			      (anim-t (if going-up t (- 1 t))))
		     
			 (set-fov 53 0.1 (lerp 1000 1000 anim-t))
			 (clear-colour fog-col)
 			 ;(clear-colour (vmix fog-col above-fog-col anim-t))
			 ;(fog (vmix fog-col above-fog-col anim-t) (lerp fog-strength above-fog-strength 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 'nutrient) "found a nutrient")
        	   ((eq? type 'leaf) "found a nutrient from the leaf plant")
        	   ((eq? type 'horn) "found a nutrient from the horn plant")
        	   ((eq? type 'inflatoe) "found an inflatoe growing ability")
        	   ((eq? type 'fork) "found a nutrient from the canopy plant")
        	   ((eq? type 'flower) "found a nutrient from the flower plant")) 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))    
		 
     ;(when (> (length messages) 0) (printf "~a~n" (length 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
						 (list (send msg get-data 'curve)
						 		(send msg get-data 'corner)))))
                      
           ((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) 
						 #f
						 (list (send msg get-data 'curve)
						 		(send msg get-data 'corner)))))
                      
          
           ((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)))