pickup dissolving and grow hud

plant-eyes/scripts/controller.ss

@@ -34,7 +34,8 @@
 	 (seed-return-timer 0)
 	 (seed-return-secs-per-point 3)
 	 (twig-stack '())
-	 (above-ground #f))   
+	 (above-ground #f)
+	 (cam-pos (vector 0 0 0)))   
     
     (define/public (set-player-plant s)
       (set! pos (send s get-pos))
@@ -55,7 +56,8 @@
     
     (define/public (setup)
       (lock-camera cam)
-      (camera-lag 0.2)
+      (camera-lag 0)
+	  (send game-view set-cam cam)
       (set-camera-transform (mtranslate (vector 0 0 -4))))
     
 	    ; moveme
@@ -82,6 +84,7 @@
 	      (set! seed-return #f)
 	      (set! debounce-space #f)
 		  (set! last-pos pos)
+		  (send game-view set-grow-mode #t)
           (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)
@@ -146,6 +149,7 @@
       
       ; if we are on a twig not growing
      (when (and current-twig-growing (not (send current-twig growing?)))
+		 (send game-view set-grow-mode #f)
          (set! current-twig-growing #f)			
 		 (set! seed-return #t)
          (set! current-point (- (send current-twig get-num-points) 1)))
@@ -163,11 +167,13 @@
       (let* ((side (vnormalise (vcross up fwd)))
              (up (vnormalise (vcross fwd side))))
         
+		(set! cam-pos (vlerp cam-pos pos 0.9))
+		
         (with-primitive cam
                         (identity)
                         (concat (vector (vx side) (vy side) (vz side) 0
                                         (vx up) (vy up) (vz up) 0
                                         (vx fwd) (vy fwd) (vz fwd) 0
-                                        (vx pos) (vy pos) (vz pos) 1)))))
+                                        (vx cam-pos) (vy cam-pos) (vz cam-pos) 1)))))
     
     (super-new)))

plant-eyes/scripts/logic.ss

@@ -143,7 +143,8 @@
      (twigs '())      ; children are stored with the point number they are connected to.
      (ornaments '())  ; the things attached to this twig, an assoc list with point index
      (w 0)                ; the width of this segment
-     (curl (vmul (crndvec) curl-amount))) ; the angles to turn each point, if curly  
+     (curl (vmul (crndvec) curl-amount)) ; the angles to turn each point, if curly  
+	 (pickedups '())) ; the pickups we've collected
     
     (inherit send-message)
     
@@ -282,6 +283,19 @@
     (define/public (get-ornament point-index)
       (cadr (assq point-index ornaments)))
 	  
+	(define/public (deal-with-pickups)
+	  (for-each
+	    (lambda (pu)
+		  (let ((pickup (car pu))
+		        (point (cadr pu)))
+		  (send plant add-property (send pickup get-type))
+          (send-message 'pick-up-pickup 
+                       (list 
+                        (list 'pickup-id (send pickup get-id))
+						(list 'point point)))))
+		 pickedups)
+		(set! pickedups '()))
+    
     ; adds the ornament if it's close, and checks sub-twigs
     ; returns true if it's succeded
     (define/public (check-pickup pickup) 
@@ -293,11 +307,10 @@
                       (cond ((and (not found) (< (vdist (vadd (send plant get-pos) point) 
                                                   (send pickup get-pos))
                                                  10 #;(+ width (send pickup get-size))))
-                             (send plant add-property (send pickup get-type))
+							 (set! pickedups (cons (list pickup i) pickedups))
                              (send pickup pick-up) ; this will remove the pickup for us
-                             (send-message 'pick-up-pickup 
+							 (send-message 'pick-up-highlight 
-                                           (list 
+                       			(list (list 'pickup-id (send pickup get-id))))                       
-                                            (list 'pickup-id (send pickup get-id))))
                              #t)
                             (else #f)))
                     #f
@@ -314,6 +327,8 @@
           found)))
      
     (define/augment (update t d)	
+	  (when (and (not (null? pickedups)) (not (growing?)))
+	    (deal-with-pickups))
       (append
        (map
         (lambda (ornament)

plant-eyes/scripts/view.ss

@@ -271,6 +271,7 @@
          
         (define/override (update t d)
                     (let ((nt (/ time tick))) ; normalise time
+					    (when (< nt 1)
                         (with-primitive root
                             (pdata-index-map!
                                 (lambda (i p)
@@ -278,7 +279,7 @@
                                         (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")))
+                            "p"))))
         
         (set! time (+ time d)))
     
@@ -287,10 +288,15 @@
 ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
     (define (build-squiggle x y)
-      (let ((p (build-ribbon 30))
+      (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))))
@@ -303,6 +309,7 @@
                 (lambda (c)
                     (vector 1 1 1))
                 "c")
+		    (pdata-copy "p" "pref")
 			(recalc-bb))  
         p))
 
@@ -311,7 +318,8 @@
     (init-field
      (id -1)
      (type 'none)
-     (pos (vector 0 0 0)))
+     (pos (vector 0 0 0))
+	 (highlit #f))
     
     (field
      (rot (vmul (rndvec) 360))
@@ -333,10 +341,19 @@
      (from pos)
      (destination (vector 0 0 0))
      (speed 0.05)
-     (t -1))
+     (t -1)
+	 (destroy-time -99)
+	 (dissolve-time -99)
+	 (delme #f))
 		
-    (define/public (pick-up)
+    (define/public (pick-up point)
-      (destroy root))
+      (set! destroy-time point))
+	  
+	(define/public (delme?)
+		delme)
+		
+	(define/public (highlight)
+	  (set! highlit #t))
 	  
 	(define/public (get-root)
 		root)
@@ -347,15 +364,33 @@
       (set! destination s))
     
     (define/public (update t d)
+	
       (with-primitive root
-                      (rotate (vector (* d 10) 0 0)))
+                      (rotate (vector (* d (if highlit 50 10)) 0 0)))
-      #;(when (and (>= t 0) (< t 1))
+					  
-        (set! pos (vadd pos (vmul (vsub destination from) speed)))
+	  (when (and highlit (eq? dissolve-time -99))
-        (with-primitive root
+	  	(with-primitive root
-                        (identity)
+	  		(pdata-map!
-                        (translate pos)
+				(lambda (p pref)
-                        (rotate rot))
+					(vadd pref (vmul (srndvec) 0.1)))
-        (set! t (+ t speed))))
+				"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)))
 
@@ -836,7 +871,7 @@
 	(dust (if is-player (with-state
 		(parent root)
 		(make-object dust%)) #f))
-    (nutrients (let ((p (with-state
+    (nutrients (if is-player (let ((p (with-state
                             (hint-depth-sort)
                             (hint-unlit)
                             (parent root)
@@ -872,7 +907,7 @@
                                 (lambda (s)
                                     (vmul (vector 1 1 1) (+ 0.1 (rndf))))
                                 "s"))
-                        p)))
+                        p) #f)))
         
       (define/public (get-id)
         id)
@@ -948,16 +983,17 @@
          twigs))
       
 	  (define/public (nutrient-absorb twig-id twig-point)
-	    (with-primitive nutrients
+	    (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))))))
+		     send (get-twig twig-id) get-width twig-point)))))))
 			 
       (define/public (update-nutrients t d)
- 		 (when (not (null? twigs))
+ 		 (when (and is-player (not (null? twigs)))
  			(with-primitive nutrients
  							(pdata-index-map!
  							 (lambda (i p twig-id point offset speed)
@@ -1079,6 +1115,20 @@
      (env-root (with-state (scale 1000) (build-locator)))
      (root-camera-t 0)
      (num-msgs 0)
+	 (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)
+		 (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)
 	 (floor (let ((p (with-state
 	 	(hint-unlit)
 		(colour 0.2)
@@ -1153,6 +1203,11 @@
                   p))
               (list-ref world-list 2))))
 
+	(define/public (set-cam s)
+		(set! cam s)
+		(with-primitive hud
+			(parent cam)))
+
 	(define/public (above-ground)
 		(printf "above-ground~n")
 	  (for-each
@@ -1184,7 +1239,7 @@
 			(set! ground-change-t (- ground-change-t d))
 			(let* ((t (/ ground-change-t ground-change-duration))
 			      (anim-t (if going-up t (- 1 t))))
-			 (clip 1 (lerp 100 500 anim-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))))
 	
@@ -1237,11 +1292,15 @@
     (define/public (get-insect insect-id)
       (cadr (assq insect-id insects)))
      
-    (define/public (pick-up-pickup pickup-id)
+    (define/public (pick-up-pickup pickup-id point)
 	  (let ((pu (get-pickup pickup-id)))
 	  (when pu
-        (send (get-pickup pickup-id) pick-up)
+        (send (get-pickup pickup-id) pick-up point))))
-        (set! pickups (assoc-remove pickup-id pickups)))))
+
+    (define/public (highlight-pickup pickup-id)
+	  (let ((pu (get-pickup pickup-id)))
+	  (when pu
+        (send (get-pickup pickup-id) highlight))))
     	
     (define/public (add-ornament plant-id twig-id point-index property)
       (when (get-plant plant-id)
@@ -1257,9 +1316,31 @@
          (send (cadr plant) set-excitations! a b))
        plants))	
 	   
+	(define/public (set-grow-mode s)
+		(when s (with-primitive grow-mode-hud (hide 0) (opacity 0)))
+		(set! grow-mode-hud-state s)
+		(set! grow-mode-hud-t 0))
+		
+	(define/public (update-grow-mode-hud 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)))
+					
+				
+	(define/public (update-hud t d)	
+		(update-grow-mode-hud t d))
+		        
     (define/public (update t d messages)                     
 	   
 	  (update-ground-change t d)
+	  (update-hud t d)
 	  
 	  (for-each 
        (lambda (plant)
@@ -1281,6 +1362,12 @@
          (lambda (msg)
            (send msg print))
          messages))    
+	
+	 (set! pickups (filter 
+                     (lambda (pickup)
+                       (not (send (cadr pickup) delme?)))
+                     pickups))  
+					  
       (for-each
        (lambda (msg)
          (cond
@@ -1353,6 +1440,11 @@
 			            
            ((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 'pickup-id)))
 
            ((eq? (send msg get-name) 'shrink-twig)