joypad + optimisations

plant-eyes/scripts/controller.ss

@@ -6,9 +6,28 @@
   "logic.ss" 
   "view.ss"
   "sound.ss")
+(require fluxus-016/joylisten)
  
 (provide (all-defined-out))
 
+; mapping for saitek p2600 joypad
+(define joymap-a 0)
+(define joymap-b 1)
+(define joymap-c 2)
+(define joymap-d 3)
+(define joymap-e 8)
+(define joymap-f 9)
+(define joymap-l1 4)
+(define joymap-l2 6)
+(define joymap-r1 5)
+(define joymap-r2 7)
+(define joymap-select 11)
+(define joymap-dpad 2)
+(define joymap-lstick 0)
+(define joymap-rstick 1)
+
+(osc-source "4444")
+
 ; reads input events and tells the logic side what to do
 
 (define controller%
@@ -42,7 +61,8 @@
 	 (sent-return-text #f)   
 	 (sent-growing-text #f)
 	 (iso-view #f)  
- 	 (debounce-i #t))
+ 	 (debounce-i #t)
+     (joylisten (make-object joylisten%)))
    
     (define/public (set-player-plant s)
       (set! pos (send s get-pos))
@@ -68,13 +88,21 @@
 	  (send game-view set-cam cam)
       (set-camera-transform (mtranslate (vector 0 0 -4))))
 	
+	(define (any-joybutton)
+	   (or (> (send joylisten get-button joymap-a) 0)
+		   (> (send joylisten get-button joymap-b) 0)
+		   (> (send joylisten get-button joymap-c) 0)
+		   (> (send joylisten get-button joymap-d) 0)))
+	
     (define/public (update t d)
       
+	  (send joylisten update)
+	
 	  (when (not sent-welcome-text)
 	  	(send game-view display "going to your seed" 4)
 	  	(send game-view display "you are now inside your seed" 4)
-	  	(send game-view display "look around with your cursor keys" 4)
+	  	(send game-view display "look around with the left stick" 4)
-	  	(send game-view display "hold down space to grow" 4)
+	  	(send game-view display "press button 1 to grow" 4)
 	  	(set! sent-welcome-text #t))
 
 	  (if (or (key-pressed "i") (key-pressed "I"))
@@ -95,7 +123,7 @@
 	  (when (key-pressed "c") 
 	  	(send game-logic clear))
 	
-      (when (and (key-pressed " ") debounce-space (not current-twig-growing)
+      (when (and (or (key-pressed " ") (any-joybutton)) debounce-space (not current-twig-growing)
 	  			; don't want the branch to be too small 
 		      (if current-twig (> (send current-twig get-width-at-point current-point) 1) #t))
 	      (set! seed-return #f)
@@ -121,13 +149,13 @@
 		  
 		  (when (not sent-growing-text)
 	  		(send game-view display "growing..." 4)
-	  		(send game-view display "keep holding space to go forward" 4)
+	  		(send game-view display "keep holding button 1 to go forward" 4)
-	  		(send game-view display "use your cursor keys to steer" 4)
+	  		(send game-view display "use the left stick to steer" 4)
 	  		(send game-view display "look for nutrients in the soil" 4)
 	  		(send game-view display "nutrients allow you to grow further" 4)
 	  		(set! sent-growing-text #t)))
 			   
-	  (when (and (key-pressed " ") current-twig-growing)	  
+	  (when (and (or (key-pressed " ") (any-joybutton)) current-twig-growing)	  
 	    (let ((vel (vmul fwd (* d -3))))
 		  (cond ((not (collide? (list pos (vadd pos vel)) (send game-view get-stones)))
   	  	    (set! pos (vadd pos vel))
@@ -139,7 +167,7 @@
 				(play-sound 'growth-collide-with-stone pos)))))
 
 				
-	  (when (and (not current-twig-growing) (not (key-pressed " ")))
+	  (when (and (not current-twig-growing) (not (or (key-pressed " ") (any-joybutton))))
 	     (set! debounce-space #t))
       
       (when (or (key-pressed "a") (key-pressed "A") (key-special-pressed 100)) (set! yaw (+ yaw 2)))
@@ -147,6 +175,20 @@
       (when (or (key-pressed "w") (key-pressed "W") (key-special-pressed 101)) (set! tilt (- tilt 2)))
       (when (or (key-pressed "s") (key-pressed "S") (key-special-pressed 103)) (set! tilt (+ tilt 2)))  
             
+	  (let ((x (vector-ref (send joylisten get-axis joymap-lstick) 1))
+	        (y (vector-ref (send joylisten get-axis joymap-lstick) 0)))
+		(when (or (< x -0.1) (> x 0.1))
+			(set! yaw (- yaw x)))
+		(when (or (< y -0.1) (> y 0.1))
+			(set! tilt (+ tilt y))))
+
+	  (let ((x (vector-ref (send joylisten get-axis joymap-rstick) 0))
+	        (y (vector-ref (send joylisten get-axis joymap-rstick) 1)))
+		(when (or (< x -0.1) (> x 0.1))
+			(set! yaw (- yaw x)))
+		(when (or (< y -0.1) (> y 0.1))
+			(set! tilt (+ tilt y))))
+			
       ; clamp tilt to prevent gimbal lock
       (when (> tilt 88) (set! tilt 88))
       (when (< tilt -88) (set! tilt -88))
@@ -154,8 +196,8 @@
 	  (when seed-return
 		  (when (not sent-return-text)
 	  		(send game-view display "returning to your seed..." 4)
-	  		(send game-view display "look around with your cursor keys" 4)
+	  		(send game-view display "look around with the left stick" 4)
-	  		(send game-view display "hold space to grow a new branch" 4)
+	  		(send game-view display "press button 1 to grow a new branch" 4)
 	  		(set! sent-return-text #t))
 			
 	  	  (cond ((< current-point 2)

plant-eyes/scripts/logic.ss

@@ -30,9 +30,9 @@
 (define num-spiders 10)
 (define num-butterflies 10)
 (define auto-twig-var 5)
-(define auto-time 1)
+(define auto-time 10)
-(define pickup-check-prob 200)
+(define pickup-check-prob 10)
-(define max-pickups 150)
+(define max-pickups 120)
 (define insect-send-prob 3)
 
 (define update-count 0)
@@ -571,13 +571,13 @@
         next-ornament-id))
     
     (define/public (check-pickup pickups) 
-	  (when (or is-player (random pickup-check-prob)) ; reduce the frequency for non-player plants
 		  (when leader-twig 
 		  	(for-each
 				(lambda (pickup)
+					(when (or is-player (zero? (random pickup-check-prob))) ; reduce the frequency for non-player plants
 						(when (not (list-contains (send pickup get-type) properties))
-					    (send leader-twig check-pickup pickup)))
+					    	(send leader-twig check-pickup pickup))))
-				pickups))))
+				pickups)))
 	   
     (define/public (destroy-twig twig)
 	   (send-message 'shrink-twig

plant-eyes/scripts/view.ss

@@ -1294,7 +1294,7 @@
 			  (hint-unlit)
 			  (colour 1)
 			  (scale 0.04)
-			  (translate (vector 0 10 0))
+			  (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))))