summaryrefslogtreecommitdiff
path: root/examples/game-controller.scm
blob: 44070acfed58ad26c358a73887c5689ee8d62612 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
(use-modules (chickadee)
             (chickadee math vector)
             (chickadee graphics color)
             (chickadee graphics font)
             (chickadee graphics sprite)
             (chickadee graphics texture)
             (ice-9 match))

(define batch #f)
(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 trigger-icons
  `((trigger-left ,(vec2 10.0 390.0) 22)
    (trigger-right ,(vec2 550.0 390.0) 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))
  (let ((texture (load-image "images/controller-buttons.png")))
    (set! atlas (split-texture texture 80 80))
    (set! batch (make-sprite-batch texture))))

(define (controller-add new-controller)
  (set! controller (or controller new-controller))
  (set! controller-name-pos
        (vec2 (center-text (controller-name controller)) 440.0)))
(define (draw alpha)
  (if controller
      (begin
        (sprite-batch-clear! batch)
        (draw-text (controller-name controller) controller-name-pos)
        (for-each (match-lambda
                   ((axis p tile)
                    (let ((alpha (controller-axis controller axis)))
                      (sprite-batch-add!
                       batch p
                       #:texture-region (texture-atlas-ref atlas tile)
                       #:tint (color 1.0 1.0 1.0 alpha)))))
                 trigger-icons)
       (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))))
                      (sprite-batch-add! batch p
                                         #:texture-region (texture-atlas-ref atlas released))
                      (when (or pressed? (not (zero? x)) (not (zero? y)))
                        (sprite-batch-add!
                         batch
                         (vec2+ p (vec2 (* x 16.0) (* y -16.0)))
                         #:texture-region (texture-atlas-ref atlas pressed)))))
                   ((button p released pressed)
                    (let ((pressed? (controller-button-pressed? controller
                                                                button)))
                      (sprite-batch-add!
                       batch p
                       #:texture-region
                       (texture-atlas-ref atlas
                                          (if pressed? pressed released))))))
                 button-icons)
       (draw-sprite-batch batch))
      (draw-text no-controller-msg no-controller-msg-pos)))

(run-game #:load load #:draw draw #:controller-add controller-add)