(use-modules (chickadee) (chickadee math vector) (chickadee graphics color) (chickadee graphics sprite) (chickadee graphics text) (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 (make-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)