sommercamp fixes on the last day - sounds, space is grow key, fixes

plant-eyes/controller.ss

@@ -22,7 +22,8 @@
      (yaw 0)
      (player-plant #f)
      (player-pos (vector 0 0 0))
-	 (last-pos (vector 0 0 0)))   
+	 (last-pos (vector 0 0 0))
+	 (debounce-space #t))   
     
     (define/public (set-player-plant s)
       (set! pos (send s get-pos))
@@ -67,8 +68,9 @@
 	
 	
     (define/public (update t d)
-      (when (and (key-pressed " ") (not current-twig-growing))
-	      (set! last-pos pos)
+      (when (and (key-pressed " ") debounce-space (not current-twig-growing))
+	      (set! debounce-space #f)
+		  (set! last-pos pos)
           (cond (current-twig      
                (let ((new-twig (send player-plant add-sub-twig current-twig current-point 
                                      (vector 0 1 0) #;(vsub (send current-twig get-point current-point)
@@ -82,8 +84,8 @@
                (send player-plant add-twig current-twig)
                (set! current-twig-growing #t))))			   
 			   
-	  (when (and (key-pressed "f") current-twig-growing)	  
-	  (let ((vel (vmul fwd (* d -3))))
+	  (when (and (key-pressed " ") current-twig-growing)	  
+	    (let ((vel (vmul fwd (* d -3))))
 		  (when 
             (not (collide? (list pos (vadd pos vel)) (send game-view get-stones)))
   	  	    (set! pos (vadd pos vel))
@@ -91,6 +93,9 @@
 		  		(set! last-pos pos)		  		
 		  		(send player-plant grow (vsub pos player-pos))))))
 				
+	  (when (and (not current-twig-growing) (not (key-pressed " ")))
+	     (set! debounce-space #t))
+      
       (when (or (key-pressed "a") (key-special-pressed 100)) (set! yaw (+ yaw 2)))
       (when (or (key-pressed "d") (key-special-pressed 102)) (set! yaw (- yaw 2)))
       (when (or (key-pressed "w") (key-special-pressed 101)) (set! tilt (- tilt 2)))
@@ -101,7 +106,7 @@
       (when (< tilt -88) (set! tilt -88))
       
       (when (not current-twig-growing)
-        (when (key-pressed "q")
+        (when (key-pressed "x")
           (cond ((not current-twig)
                  (set! current-twig (send player-plant get-twig-from-dir (vmul fwd -1)))
                  (set! current-point 2))

plant-eyes/logic.ss

@@ -17,6 +17,7 @@
 (define ornament-grow-probability 8)
 (define curl-amount 40)
 (define start-size 50)
+(define max-ornaments 10) ; per twig
 
 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 ; the base class logic object - all logic side objects can 
@@ -198,14 +199,14 @@
           (send (cadr (choose twigs)) get-random-twig)))
     
     (define/public (add-ornament point-index ornament)
-      ; todo - check max ornaments
-      (send-message 'new-ornament 
+	  (when (< (length ornaments) max-ornaments)
+	      (send-message 'new-ornament 
                      (list 
                       (list 'plant-id (send plant get-id))
                       (list 'twig-id id)
                       (list 'point-index point-index)
                       (list 'property (send ornament get-property))))
-      (set! ornaments (cons (list point-index ornament) ornaments)))
+    	  (set! ornaments (cons (list point-index ornament) ornaments))))
     
     (define/public (get-ornament point-index)
       (cadr (assq point-index ornaments)))
@@ -487,7 +488,7 @@
     (inherit send-message)
     
     (define/public (setup world-list)
-     (let ((pickups (list-ref world-list 1)))
+     (let ((pickups '() #;(list-ref world-list 1)))
       (let ((i 0))
       (for-each
           (lambda (pickup)

plant-eyes/shaders/textoon.frag.glsl

@@ -0,0 +1,30 @@
+varying vec3 N;
+varying vec3 L;
+varying vec3 V;
+varying vec2 T;
+uniform sampler2D BaseMap;
+
+void main()
+{ 
+	vec3 n = normalize(N);
+	vec3 l = normalize(L);
+	vec3 v = normalize(V);
+
+    float HighlightSize=0.1;
+    float ShadowSize=0.2;
+    float OutlineWidth=0.4;
+	
+	vec4 MidColour=gl_FrontMaterial.diffuse;
+	vec4 HighlightColour=MidColour*2.0;
+	vec4 ShadowColour=MidColour*0.5;
+	HighlightColour.a=1.0;
+	ShadowColour.a=1.0;
+	
+    float lambert = dot(l,n);
+    vec4 colour = MidColour;
+    if (lambert > 1.0-HighlightSize) colour = HighlightColour;
+    if (lambert < ShadowSize) colour = ShadowColour;
+    if (dot(n,v) < OutlineWidth) colour = vec4(0,0,0,1);
+
+    gl_FragColor = colour*texture2D(BaseMap, T);
+}

plant-eyes/shaders/textoon.vert.glsl

@@ -0,0 +1,18 @@
+// Copyright (C) 2007 Dave Griffiths
+// Licence: GPLv2 (see COPYING)
+varying vec3 N;
+varying vec3 P;
+varying vec3 V;
+varying vec3 L;
+varying vec2 T;
+
+void main()
+{    
+    N = normalize(gl_NormalMatrix*gl_Normal);
+    P = gl_Vertex.xyz;
+    V = -vec3(gl_ModelViewMatrix*gl_Vertex);
+	vec4 LightPos = gl_LightSource[1].position;
+	L = vec3(gl_ModelViewMatrix*(LightPos-gl_Vertex));
+	T = gl_MultiTexCoord0.xy;
+    gl_Position = ftransform();
+}

plant-eyes/shaders/toon2.frag.glsl

@@ -0,0 +1,26 @@
+varying vec3 normal, lightDir;
+varying vec2 texCoord;
+uniform sampler2D texture;
+
+void main()
+{
+        float intensity;
+        vec3 n;
+        vec4 _color;
+
+        n = normalize(normal);
+        intensity = dot(lightDir, n);
+
+        if (intensity > 0.98)
+                _color = vec4(1.0,1.0,1.0,1.0);
+        else if (intensity > 0.5)
+                _color = vec4(0.8,0.8,0.8,1.0);
+        else if (intensity > 0.35)
+                _color = vec4(0.4,0.4,0.4,1.0);
+        else if (intensity > 0)
+                _color = vec4(0.0,0.0,0.0,1.0); 
+		else _color = texture2D(texture, texCoord);   
+		
+        gl_FragColor = _color;  
+
+} 

plant-eyes/shaders/toon2.vert.glsl

@@ -0,0 +1,14 @@
+varying vec3 normal, lightDir;
+varying vec2 texCoord;
+
+void main()
+{      
+        vec4 ecPos;
+        ecPos = vec4(gl_ModelViewMatrix * gl_Vertex);
+        lightDir = normalize(vec3(gl_LightSource[0].position) - ecPos.xyz);
+        normal = normalize(gl_NormalMatrix * gl_Normal);
+
+        texCoord = vec2(gl_MultiTexCoord0);
+        gl_Position = ftransform();
+
+} 

plant-eyes/view.ss

@@ -15,7 +15,6 @@
 (define wire-mode #f)
 (define fog-col (earth-colour))
 (define fog-strength 0.001)
-(define max-ornaments 10) ; per twig
 (define default-grow-speed 0.5)
 (define grow-overshoot 10)
 
@@ -26,6 +25,10 @@
                         (pdata-copy "p" "rip-pref")))
 
     
+(define (clamp v l u)
+  (if (< v l) l
+    (if (> v u) u v)))
+  
 (define (ripple t speed wave-length)  
                     (pdata-map!
                         (lambda (p pref)
@@ -36,9 +39,9 @@
                                                             (vector 0 0 0))))))))))
                         "p" "rip-pref"))
   
-(define (play-sound sound pos freq)              
-  (when audio-on (let ((growing-noise (oa-load-sample (fullpath "snd/event01.wav")))) 
-    (oa-play growing-noise (vector 0 0 0) (rndf) 0.3))))
+(define (play-sound sound pos freq vol)              
+  (when audio-on (let ((noise (oa-load-sample (fullpath sound)))) 
+    (oa-play noise pos freq vol))))
 
 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
@@ -53,11 +56,13 @@
      (time 0)
 	 (ev-time 0)
 	 (ev-dur 8)
-	 (ev-col (vector 0 0 1)))
+	 (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)
@@ -128,10 +133,11 @@
 		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)))
-		(printf "excite: ~a ~a~n" ev-dur ev-col))
+		(set! ev-time (* ev-dur 4 (rndf))))
 	
     (define/public (update t d)
       (when (< time 1)
@@ -143,13 +149,12 @@
                         (scale (* const-scale sc 0.2 time)))
         (set! time (+ time (* 0.05 d))))
 		
-	  (when (eq? property 'inflatoe)
+	  (when (and (eq? property 'inflatoe) excitation-changed)
 	  	(with-primitive root 
 			(pdata-map!
 				(lambda (p p1 p2)
-				   (vmix p1 p2 (+ 0.5 (* 0.5 (sin ev-time)))))
-				"p" "p1" "p2"))
-		(set! ev-time (+ ev-time d)))
+				   (vmix p1 p2 (clamp light 0 1)))
+				"p" "p1" "p2")))
 				
 	  (when (eq? property 'horn)
 	  	(with-primitive particles 
@@ -157,6 +162,7 @@
 			(pdata-op "*" "c" 0.995))
 	  
 	  	(when (< ev-time 0)
+			(play-sound "snd/wateringcan.wav" pos (+ 0.1 (rndf)) 0.3)
 
 			#;(with-primitive root
                     (identity)
@@ -175,7 +181,9 @@
 						 (vector 0 0 0))))
 				"p"))
 		  (set! ev-time ev-dur))
-	  	(set! ev-time (- ev-time d))))
+	  	(set! ev-time (- ev-time d)))
+		
+		(set! excitation-changed #f))
     
     (super-new)))
 
@@ -309,9 +317,7 @@
         (set! markers (cons (build-locator) markers)))
         
       (define/pubment (add-point point width)
-        (when audio-on (let ((growing-noise (oa-load-sample (fullpath "snd/event01.wav")))) 
-          (oa-play growing-noise (vector 0 0 0) (rndf) 0.3)))
-      
+	  			(play-sound "snd/event01.wav" point (+ 0.1 (rndf)) 0.3) 
                 (set! markers (append markers (list (with-state
                 (parent (get-root))
                 (translate point)
@@ -323,9 +329,8 @@
         (inner (void) add-point point width))
 
       (define/public (add-ornament point-index property)	  	
-        (when (and 
-			(< point-index grow-t) 
-			(< (length ornaments) max-ornaments))
+        (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))
            ; todo - different ornament-view objects per property needed?
@@ -353,7 +358,7 @@
                 
         (inner (void) update t d)
         
-        (when (< grow-t (+ num-points grow-overshoot)) 
+        (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
@@ -475,7 +480,7 @@
         (set! index (+ index 1)))
 
       (define/augment (update t d)                   
-        (when (not (eq? grow-t 999))
+        (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)))