joypad + optimisations
This commit is contained in:
parent
3f9dfe95ab
commit
1aa0d8f83b
3 changed files with 61 additions and 19 deletions
|
@ -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 "hold down space to grow" 4)
|
||||
(send game-view display "look around with the left stick" 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 "use your cursor keys to steer" 4)
|
||||
(send game-view display "keep holding button 1 to go forward" 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 "hold space to grow a new branch" 4)
|
||||
(send game-view display "look around with the left stick" 4)
|
||||
(send game-view display "press button 1 to grow a new branch" 4)
|
||||
(set! sent-return-text #t))
|
||||
|
||||
(cond ((< current-point 2)
|
||||
|
|
|
@ -30,9 +30,9 @@
|
|||
(define num-spiders 10)
|
||||
(define num-butterflies 10)
|
||||
(define auto-twig-var 5)
|
||||
(define auto-time 1)
|
||||
(define pickup-check-prob 200)
|
||||
(define max-pickups 150)
|
||||
(define auto-time 10)
|
||||
(define pickup-check-prob 10)
|
||||
(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 (not (list-contains (send pickup get-type) properties))
|
||||
(send leader-twig check-pickup pickup)))
|
||||
pickups))))
|
||||
(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))))
|
||||
pickups)))
|
||||
|
||||
(define/public (destroy-twig twig)
|
||||
(send-message 'shrink-twig
|
||||
|
|
|
@ -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))))
|
||||
|
|
Loading…
Reference in a new issue