aboutsummaryrefslogtreecommitdiff
path: root/input.scm
diff options
context:
space:
mode:
Diffstat (limited to 'input.scm')
-rw-r--r--input.scm78
1 files changed, 39 insertions, 39 deletions
diff --git a/input.scm b/input.scm
index eaaade4..0ef02b7 100644
--- a/input.scm
+++ b/input.scm
@@ -1,5 +1,5 @@
(module downstroke-input
- *
+*
(import scheme
(chicken base)
@@ -8,9 +8,9 @@
(only srfi-13 string-join)
(only srfi-197 chain)
(prefix sdl2 sdl2:)
- simple-logger
- downstroke-entity
- defstruct)
+ simple-logger
+ downstroke-entity
+ defstruct)
;; Input configuration record
(defstruct input-config
@@ -25,22 +25,22 @@
;; Default input configuration (capture current hardcoded values)
(define *default-input-config*
(make-input-config
- actions: '(up down left right a b start select quit)
- keyboard-map: '((w . up) (up . up)
- (s . down) (down . down)
- (a . left) (left . left)
- (d . right) (right . right)
- (j . a) (z . a)
- (k . b) (x . b)
- (return . start)
- (escape . quit))
- joy-button-map: '((0 . a) (1 . b) (7 . start) (6 . select))
- controller-button-map: '((a . a) (b . b) (start . start) (back . select)
- (dpad-up . up) (dpad-down . down)
- (dpad-left . left) (dpad-right . right))
- joy-axis-bindings: '((0 right left) (1 down up))
- controller-axis-bindings: '((left-x right left) (left-y down up))
- deadzone: 8000))
+ actions: '(up down left right a b start select quit)
+ keyboard-map: '((w . up) (up . up)
+ (s . down) (down . down)
+ (a . left) (left . left)
+ (d . right) (right . right)
+ (j . a) (z . a)
+ (k . b) (x . b)
+ (return . start)
+ (escape . quit))
+ joy-button-map: '((0 . a) (1 . b) (7 . start) (6 . select))
+ controller-button-map: '((a . a) (b . b) (start . start) (back . select)
+ (dpad-up . up) (dpad-down . down)
+ (dpad-left . left) (dpad-right . right))
+ joy-axis-bindings: '((0 right left) (1 down up))
+ controller-axis-bindings: '((left-x right left) (left-y down up))
+ deadzone: 8000))
(define-record input-state
current ; Alist: (action . bool)
@@ -60,10 +60,10 @@
(define (input-state-diff state)
"Retrieve the difference between current and previous input state maps"
(fold (lambda (item agg)
- (unless (eq? (alist-ref item (input-state-previous state)) item)
- (cons item agg)))
- '()
- (input-state-current state)))
+ (unless (eq? (alist-ref item (input-state-previous state)) item)
+ (cons item agg)))
+ '()
+ (input-state-current state)))
(define (handle-noop state event type config)
state)
@@ -116,25 +116,25 @@
(define (handle-event state event config)
(let* ((type (sdl2:event-type event))
- (handler (case type
- ((key-down key-up) handle-keyboard)
- ((joy-button-down joy-button-up) handle-joy-button)
- ((joy-axis-motion) handle-joy-axis)
- ((controller-button-down
- controller-button-up) handle-controller-button)
- ((controller-axis-motion) handle-controller-axis)
- ((controller-device-added
- controller-device-removed) handle-controller-device)
- (else handle-noop))))
+ (handler (case type
+ ((key-down key-up) handle-keyboard)
+ ((joy-button-down joy-button-up) handle-joy-button)
+ ((joy-axis-motion) handle-joy-axis)
+ ((controller-button-down
+ controller-button-up) handle-controller-button)
+ ((controller-axis-motion) handle-controller-axis)
+ ((controller-device-added
+ controller-device-removed) handle-controller-device)
+ (else handle-noop))))
(handler state event type config)))
(define (input-state-update state events config)
(let ((rolled (make-input-state (input-state-current state)
(input-state-current state))))
(let* ((new-state (fold (lambda (ev st) (handle-event st ev config)) rolled events))
- (state-diff (input-state-diff new-state)))
+ (state-diff (input-state-diff new-state)))
(unless (eq? state-diff '())
- (log-debug "input-state change: ~a" state-diff))
+ (log-debug "input-state change: ~a" state-diff))
new-state)))
;; 5. Simple Getters
@@ -158,9 +158,9 @@
(define (set-facing-from-vx entity vx)
(cond
- ((> vx 0) (entity-set entity #:facing 1))
- ((< vx 0) (entity-set entity #:facing -1))
- (else entity)))
+ ((> vx 0) (entity-set entity #:facing 1))
+ ((< vx 0) (entity-set entity #:facing -1))
+ (else entity)))
(define (compute-input-delta input-map held?)
(fold (lambda (entry acc)