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)