summaryrefslogtreecommitdiff
path: root/examples/game-controller.scm
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2019-01-06 00:08:13 -0500
committerDavid Thompson <dthompson2@worcester.edu>2019-01-06 00:09:32 -0500
commit4607a0bc3021a0d12ed792de91857d5fd86e1833 (patch)
tree6ab0249be570783b186f6f926d337911ab7d5a14 /examples/game-controller.scm
parent7e2a8ddc7753b2c93d36e94090cc74145b860f01 (diff)
examples: Add game controller test.
* examples/game-controller.scm: New file. * examples/images/controller-buttons.png: New file. * Makefile.am (EXTRA_DIST): Add them.
Diffstat (limited to 'examples/game-controller.scm')
-rw-r--r--examples/game-controller.scm77
1 files changed, 77 insertions, 0 deletions
diff --git a/examples/game-controller.scm b/examples/game-controller.scm
new file mode 100644
index 0000000..fe1a681
--- /dev/null
+++ b/examples/game-controller.scm
@@ -0,0 +1,77 @@
+(use-modules (chickadee)
+ (chickadee math vector)
+ (chickadee render font)
+ (chickadee render sprite)
+ (chickadee render texture)
+ (ice-9 match))
+
+(define controller #f)
+(define atlas #f)
+(define button-icons
+ `((dpad-down ,(vec2 110.0 140.0) 7 25)
+ (dpad-right ,(vec2 170.0 210.0) 9 27)
+ (dpad-left ,(vec2 50.0 210.0) 8 26)
+ (dpad-up ,(vec2 110.0 280.0) 6 24)
+ (a ,(vec2 450.0 140.0) 0 18)
+ (b ,(vec2 510.0 210.0) 1 19)
+ (x ,(vec2 390.0 210.0) 2 20)
+ (y ,(vec2 450.0 280.0) 3 21)
+ (back ,(vec2 190.0 330.0) 11 29)
+ (guide ,(vec2 280.0 330.0) 12 30)
+ (start ,(vec2 370.0 330.0) 10 28)
+ (left-stick ,(vec2 110.0 20.0) 13 31)
+ (right-stick ,(vec2 450.0 20.0) 13 31)
+ (left-shoulder ,(vec2 110.0 390.0) 4 22)
+ (right-shoulder ,(vec2 450.0 390.0) 5 23)))
+(define no-controller-msg "no controller detected :'(")
+(define no-controller-msg-pos #f)
+(define controller-name-pos #f)
+
+(define (center-text text)
+ (/ (- 640.0 (font-line-width (default-font) text)) 2.0))
+
+(define (load)
+ (set! no-controller-msg-pos (vec2 (center-text no-controller-msg) 240.0))
+ (set! atlas (split-texture (load-image "images/controller-buttons.png")
+ 80 80)))
+
+(define (controller-add new-controller)
+ (set! controller (or controller new-controller))
+ (set! controller-name-pos
+ (vec2 (center-text (controller-name controller)) 440.0)))
+
+;; FIXME: I couldn't think of a decent way to display the analog
+;; left/right trigger buttons, so they are omitted.
+(define (draw alpha)
+ (if controller
+ (begin
+ (draw-text (controller-name controller) controller-name-pos)
+ (for-each (match-lambda
+ (((and (or 'left-stick 'right-stick) button)
+ p released pressed)
+ (let ((pressed? (controller-button-pressed? controller
+ button))
+ (x (controller-axis controller
+ (if (eq? button 'left-stick)
+ 'left-x
+ 'right-x)))
+ (y (controller-axis controller
+ (if (eq? button 'left-stick)
+ 'left-y
+ 'right-y))))
+ (draw-sprite (texture-atlas-ref atlas released)
+ p)
+ (when (or pressed? (not (zero? x)) (not (zero? y)))
+ (draw-sprite (texture-atlas-ref atlas pressed)
+ (vec2+ p (vec2 (* x 16.0) (* y -16.0)))))))
+ ((button p released pressed)
+ (let ((pressed? (controller-button-pressed? controller
+ button)))
+ (draw-sprite (texture-atlas-ref
+ atlas
+ (if pressed? pressed released))
+ p))))
+ button-icons))
+ (draw-text no-controller-msg no-controller-msg-pos)))
+
+(run-game #:load load #:draw draw #:controller-add controller-add)