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
|
(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)
|