Update a couple of examples to use new sprite batch API.
[chickadee.git] / examples / game-controller.scm
CommitLineData
4607a0bc
DT
1(use-modules (chickadee)
2 (chickadee math vector)
6b4f2d5e 3 (chickadee render color)
4607a0bc
DT
4 (chickadee render font)
5 (chickadee render sprite)
6 (chickadee render texture)
7 (ice-9 match))
8
12ac60e9 9(define batch #f)
4607a0bc
DT
10(define controller #f)
11(define atlas #f)
12(define button-icons
13 `((dpad-down ,(vec2 110.0 140.0) 7 25)
14 (dpad-right ,(vec2 170.0 210.0) 9 27)
15 (dpad-left ,(vec2 50.0 210.0) 8 26)
16 (dpad-up ,(vec2 110.0 280.0) 6 24)
17 (a ,(vec2 450.0 140.0) 0 18)
18 (b ,(vec2 510.0 210.0) 1 19)
19 (x ,(vec2 390.0 210.0) 2 20)
20 (y ,(vec2 450.0 280.0) 3 21)
21 (back ,(vec2 190.0 330.0) 11 29)
22 (guide ,(vec2 280.0 330.0) 12 30)
23 (start ,(vec2 370.0 330.0) 10 28)
24 (left-stick ,(vec2 110.0 20.0) 13 31)
25 (right-stick ,(vec2 450.0 20.0) 13 31)
26 (left-shoulder ,(vec2 110.0 390.0) 4 22)
27 (right-shoulder ,(vec2 450.0 390.0) 5 23)))
6b4f2d5e
DT
28(define trigger-icons
29 `((trigger-left ,(vec2 10.0 390.0) 22)
30 (trigger-right ,(vec2 550.0 390.0) 23)))
4607a0bc
DT
31(define no-controller-msg "no controller detected :'(")
32(define no-controller-msg-pos #f)
33(define controller-name-pos #f)
34
35(define (center-text text)
36 (/ (- 640.0 (font-line-width (default-font) text)) 2.0))
37
38(define (load)
39 (set! no-controller-msg-pos (vec2 (center-text no-controller-msg) 240.0))
12ac60e9
AM
40 (let ((texture (load-image "images/controller-buttons.png")))
41 (set! atlas (split-texture texture 80 80))
42 (set! batch (make-sprite-batch texture))))
4607a0bc
DT
43
44(define (controller-add new-controller)
45 (set! controller (or controller new-controller))
46 (set! controller-name-pos
47 (vec2 (center-text (controller-name controller)) 440.0)))
4607a0bc
DT
48(define (draw alpha)
49 (if controller
12ac60e9
AM
50 (begin
51 (sprite-batch-clear! batch)
52 (draw-text (controller-name controller) controller-name-pos)
53 (for-each (match-lambda
6b4f2d5e
DT
54 ((axis p tile)
55 (let ((alpha (controller-axis controller axis)))
12ac60e9
AM
56 (sprite-batch-add!
57 batch p
58 #:texture-region (texture-atlas-ref atlas tile)
59 #:tint (color 1.0 1.0 1.0 alpha)))))
6b4f2d5e
DT
60 trigger-icons)
61 (for-each (match-lambda
62 (((and (or 'left-stick 'right-stick) button)
63 p released pressed)
64 (let ((pressed? (controller-button-pressed? controller
65 button))
66 (x (controller-axis controller
67 (if (eq? button 'left-stick)
68 'left-x
69 'right-x)))
70 (y (controller-axis controller
71 (if (eq? button 'left-stick)
72 'left-y
73 'right-y))))
12ac60e9
AM
74 (sprite-batch-add! batch p
75 #:texture-region (texture-atlas-ref atlas released))
6b4f2d5e 76 (when (or pressed? (not (zero? x)) (not (zero? y)))
12ac60e9
AM
77 (sprite-batch-add!
78 batch
79 (vec2+ p (vec2 (* x 16.0) (* y -16.0)))
80 #:texture-region (texture-atlas-ref atlas pressed)))))
6b4f2d5e
DT
81 ((button p released pressed)
82 (let ((pressed? (controller-button-pressed? controller
83 button)))
12ac60e9
AM
84 (sprite-batch-add!
85 batch p
86 #:texture-region
87 (texture-atlas-ref atlas
88 (if pressed? pressed released))))))
89 button-icons)
90 (draw-sprite-batch batch))
4607a0bc
DT
91 (draw-text no-controller-msg no-controller-msg-pos)))
92
93(run-game #:load load #:draw draw #:controller-add controller-add)