fin roots

plant-eyes/ornament-views.ss

@@ -146,11 +146,11 @@
 
 (define leaf-ornament-view%
   (class ornament-view%
-    (inherit-field rot)
+    (inherit-field col rot)
 	(define/augment (centred?) #t)
 	(define/augment (above-ground-only?) #t)
     (define/augment (build-root)
-               (colour (vector 0.8 1 0.6))                             
+               (colour col)                             
                (texture (load-texture "textures/leaf.png"))
                (set! rot (vector 0 0 0))
                (load-primitive "meshes/leaf.obj"))    
@@ -163,6 +163,7 @@
     (inherit-field rot col)	
 	(define/augment (want-particles?) #t)
     (define/augment (build-root)
+			   (texture (load-texture "textures/wiggle.png"))
 			   (shader "shaders/toon.vert.glsl" "shaders/toon.frag.glsl")
 			   (colour col)
                (set! rot (vector (* (rndf) 360) 0 0))
@@ -200,6 +201,7 @@
   (class ornament-view%
     (inherit-field rot col)
     (define/augment (build-root)
+			   (texture (load-texture "textures/wiggle.png"))
 			   (shader "shaders/toon.vert.glsl" "shaders/textoon.frag.glsl")
                (colour col)                             
                (set! rot (vector (* (rndf) 360) 0 0))
@@ -213,6 +215,7 @@
     (inherit-field rot col)
 	(define/augment (above-ground-only?) #t)
     (define/augment (build-root)
+			   (texture (load-texture "textures/wiggle.png"))
 			   (shader "shaders/toon.vert.glsl" "shaders/textoon.frag.glsl")
                (colour col)            
                (set! rot (vector (* (rndf) 360) 0 0))
@@ -221,145 +224,3 @@
 
 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
-
-#;(define leaf-ornament-view%
-  (class ornament-view%
-    (init-field
-     (pos (vector 0 0 0))
-     (sc 1)
-     (dir (vector 0 0 1))
-     (property 'none)
-	 (col (vector 1 1 1))
-     (time 0)
-	 (ev-time 0)
-	 (ev-dur 8)
-	 (ev-col (vector 0 0 1))
-	 (light 0))
-    
-    (field
-     (const-scale (if (eq? property 'leaf) 2 4))
-     (rot (vector 0 0 0))
-	 (excitation-changed #f)
-     (root (with-state
-            (translate pos)
-			;(hint-frustum-cull)
-            (concat (maim dir (vector 0 1 0)))
-            (scale (* const-scale sc))
-			;(hint-origin)
-            ;(shader "shaders/textoon.vert.glsl" "shaders/textoon.frag.glsl")
-            (cond 
-              ((eq? property 'wiggle) 
-;               (opacity 1)
-               (hint-depth-sort)
-               (colour (vector 0.5 0.0 0.0))
-               (load-primitive "meshes/wiggle.obj"))
-              ((eq? property 'leaf) 
-               (colour (vector 0.8 1 0.6))                             
-               (texture (load-texture "textures/leaf.png"))
-               (set! rot (vector 0 0 0))
-               (load-primitive "meshes/leaf.obj"))
-			  ((eq? property 'horn) 
-			   (backfacecull 0)
-			   (shader "shaders/toon.vert.glsl" "shaders/toon.frag.glsl")
-			   (colour col)
-               (set! rot (vector (* (rndf) 360) 0 0))
-               (load-primitive "meshes/horn.obj"))        
-			  ((eq? property 'inflatoe) 
-			   (backfacecull 0)
-			   (shader "shaders/toon.vert.glsl" "shaders/textoon.frag.glsl")
-			   (texture (load-texture "textures/wiggle.png"))
-			   (colour col)
-               (set! rot (vector (* (rndf) 360) 0 0))
-               (let ((p (load-primitive "meshes/inflatoe-full.obj")))
-			     (let ((dp (load-primitive "meshes/inflatoe-empty.obj")))
-				   (with-primitive p
-				     (pdata-copy "p" "p1")
-				     (pdata-add "p2" "v")
-					 (pdata-index-map!
-					   (lambda (i p2)
-					     (with-primitive dp
-						   (pdata-ref "p" i)))
-					   "p2"))
-					(destroy dp))
-				  p))
-			 (else (error "unrecognised pickup property")))))
-	  (particles (if (eq? property 'horn)
-	  	(let ((p (with-state
-	  		(parent root)
-			(translate (vector 0 0 2))
-			(hint-depth-sort)
-            (hint-unlit)
-            (blend-mode 'src-alpha 'one)
-            (texture (load-texture "textures/particle.png"))
-			(build-particles 30))))
-			(with-primitive p
-				(pdata-add "vel" "v")
-				(pdata-map!
-					(lambda (vel)
-						(vmul (srndvec) 0.01))
-					"vel")
-				(pdata-map!
-					(lambda (s)
-						(vmul (vector 1 1 1) (* 0.25 (rndf))))
-					"s")
-				(pdata-map!
-					(lambda (c)
-						(vadd ev-col (vmul (rndvec) (* 0.2 (rndf)))))
-					"c"))
-			p)
-		0)))
-    
-	(define/public (set-excitations! a b)
-		(set! excitation-changed #t)
-		(set! light a)
-		(set! ev-dur (if (zero? a) 9999 (/ 1 a)))
-		(set! ev-col (vmix (vector 0 0 1) (vector 1 0 0) b))
-		(set! ev-time (* ev-dur 4 (rndf))))
-	
-    (define/public (update t d)
-      (when (< time 1)
-        (with-primitive root
-                        (identity)
-                        (translate pos)
-                        (concat (maim dir (vector 0 1 0)))
-                        (rotate rot)
-                        (scale (* const-scale sc 0.2 time)))
-        (set! time (+ time (* 0.05 d))))
-		
-	  (when (and (eq? property 'inflatoe) excitation-changed)
-	  	(with-primitive root 
-			(pdata-map!
-				(lambda (p p1 p2)
-				   (vmix p1 p2 (clamp light 0 1)))
-				"p" "p1" "p2")))
-				
-	  (when (eq? property 'horn)
-	  	(with-primitive particles 
-			(pdata-op "+" "p" "vel")
-			(pdata-op "*" "c" 0.995))
-	  
-	  	(when (< ev-time 0)
-			(play-sound "snd/wateringcan.wav" pos (+ 0.1 (rndf)) 0.3)
-
-			#;(with-primitive root
-                    (identity)
-                    (translate pos)
-                    (concat (maim dir (vector 0 1 0)))
-                    (rotate rot)
-                    (scale (* const-scale sc 0.2 ev-time)))
-					
-		  ; todo inherit and call event happen or somesuch
-		  (with-primitive particles
-		  	(pdata-index-map!		
-				(lambda (i p)
-					(cond ((zero? (random 2)) p)
-						(else
-						 (pdata-set! "c" i (vector (+ 0.5 (* 0.5 (rndf))) (+ 0.5 (* 0.5 (rndf))) 1))
-						 (vector 0 0 0))))
-				"p"))
-		  (set! ev-time ev-dur))
-	  	(set! ev-time (- ev-time d)))
-		
-		(set! excitation-changed #f))
-    
-    (super-new)))

plant-eyes/view.ss

@@ -7,7 +7,7 @@
 (define debug-messages #f) ; prints out all the messages sent to the renderer
 
 (define (ornament-colour) (vector 0.5 1 0.4))
-(define (pickup-colour) (vector 1 1 1))
+(define (pickup-colour) (vector 1 1 0.5))
 (define (earth-colour) (vector 0.2 0.1 0))
 (define (stones-colour) (vmul (earth-colour) (+ 0.5 (* (rndf) 0.5))))
 
@@ -17,6 +17,11 @@
 (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 (pre-ripple)
                     (when (not (pdata-exists? "rip-pref"))
                         (pdata-copy "p" "rip-pref")))
@@ -46,28 +51,20 @@
             (translate pos)
             (rotate rot)
             (colour (pickup-colour))
-            (scale 0.3)
 			(shader "shaders/textoon.vert.glsl" "shaders/textoon.frag.glsl") 
-			(scale 5) 
             (hint-frustum-cull)
-            ;(shader "shaders/textoon.vert.glsl" "shaders/textoon.frag.glsl")
+            (texture (load-texture "textures/wiggle.png"))
-            (texture
-             (cond 
-              ((eq? type 'wiggle) (load-texture "textures/wiggle.png"))
-              ((eq? type 'leaf) (load-texture "textures/leaf.png"))
-              ((eq? type 'curly) (load-texture "textures/curl.png"))
-              ((eq? type 'inflatoe) (load-texture "textures/wiggle.png"))
-			  (else 0)))
             (cond 
               ((eq? type 'wiggle) (load-primitive "meshes/pickup.obj"))
-              ((eq? type 'leaf) (load-primitive "meshes/leaf.obj"))
+              ((eq? type 'leaf) 
+			    (texture (load-texture "textures/leaf.png"))
+				(load-primitive "meshes/leaf.obj"))
               ((eq? type 'curly) (load-primitive "meshes/pickup.obj"))
               ((eq? type 'nutrient) (load-primitive "meshes/nutrient.obj"))
-              ((eq? type 'horn) 
+              ((eq? type 'horn) (load-primitive "meshes/horn.obj"))
-			    (backfacecull 0) 
+              ((eq? type 'inflatoe) (load-primitive "meshes/inflatoe-full.obj"))
-				(load-primitive "meshes/horn.obj"))
+              ((eq? type 'fork) (load-primitive "meshes/fork.obj"))
-              ((eq? type 'inflatoe) 
+              ((eq? type 'flower) (load-primitive "meshes/flower.obj")))))
-				(load-primitive "meshes/inflatoe-full.obj")))))
      (from pos)
      (destination (vector 0 0 0))
      (speed 0.05)
@@ -296,6 +293,55 @@
 
 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
+(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%
       
@@ -306,19 +352,20 @@
        (profile '())
        (path '())
        (root 0)
-       (widths '()))
+       (widths '())
+	   (fins '()))
       
       (define/override (build)
        (set! profile (build-circle-profile 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)
+                            (backfacecull 0)
                             (when wire-mode 
                               (hint-none)
                               (hint-wire))
-                        ;(shader "shaders/toon.vert.glsl" "shaders/toon.frag.glsl")
+                        (shader "shaders/toon.vert.glsl" "shaders/toon.frag.glsl")
-                		(shader "shaders/fresnel.vert.glsl" "shaders/fresnel.frag.glsl")
+                		;(shader "shaders/frtrans.vert.glsl" "shaders/frtrans.frag.glsl")
                       (texture (load-texture tex))
                        (opacity 0.6)
                        (colour col)
@@ -347,6 +394,21 @@
         (set! index (+ index 1)))
 
       (define/augment (update t d)                   
+	    (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)
+	  
         (when (and (not (eq? grow-t -1)) (not (eq? grow-t 999)))
           (with-primitive root
             (partial-extrude grow-t profile path widths (vector 1 0 0) 0.05)))
@@ -386,8 +448,8 @@
                (build-locator)))
         (seed (with-state
                (parent root)
-               ;(shader "shaders/toon.vert.glsl" "shaders/toon.frag.glsl")
+               (shader "shaders/toon.vert.glsl" "shaders/toon.frag.glsl")
-               (shader "shaders/fresnel.vert.glsl" "shaders/fresnel.frag.glsl")
+               ;(shader "shaders/frtrans.vert.glsl" "shaders/frtrans.frag.glsl")
                (texture (load-texture tex))
                (backfacecull 0)
                (opacity 0.6)

plant-eyes/world-build.scm

@@ -8,9 +8,16 @@
 
 (define pickup-models (list
         (list 'leaf "meshes/leaf.obj")
+        (list 'flower "meshes/flower.obj")
+        (list 'fork "meshes/fork.obj")
         (list 'horn "meshes/horn.obj")
         (list 'inflatoe "meshes/inflatoe-full.obj")
-        (list 'nutrient "meshes/nutrient.obj")))
+        (list 'nutrient "meshes/nutrient.obj")
+        (list 'nutrient "meshes/nutrient.obj")
+        (list 'nutrient "meshes/nutrient.obj")
+        (list 'nutrient "meshes/nutrient.obj")
+        (list 'nutrient "meshes/nutrient.obj")
+        ))
 
 (define (extract-list t l)
     (foldl
@@ -42,7 +49,7 @@
             (lambda (_)
                 (make-ob 'seed 'seed "meshes/seed.obj"
                     (vmul (srndvec) (* size area 0.5)) 
-                    (* 0.12 50)
+                    (* 0.5 50)
                     (vmul (rndvec) 0) 0)))
         
         (build-list num-pickups 
@@ -50,7 +57,7 @@
                 (let ((pickup (choose pickup-models)))
                 (make-ob 'pickup (car pickup) (cadr pickup)
                     (vmul (srndvec) (* 150 area))
-                    0.5
+                    2
                     (vmul (rndvec) 360) 0))))
         
         
@@ -101,7 +108,7 @@
 
 (clear)
 (clear-colour 0)
-(define s (init 5 200 100 1 10))
+(define s (init 5 300 100 1 10))
 (build s)
 
 (define l (make-light 'spot 'free))