Re-format

1 files changed, 181 insertions, 181 deletions

diff --git a/input.scm b/input.scm
index dd5a93c..ea860ae 100644
--- a/input.scm
+++ b/input.scm
@@ -1,182 +1,182 @@
 (module (downstroke input)
-*
-
-(import scheme
-        (chicken base)
-        (chicken format)
-        (only srfi-1 any filter fold alist-delete)
-        (only srfi-13 string-join)
-        (only srfi-197 chain)
-        (prefix sdl2 sdl2:)
-	    simple-logger
-	    (downstroke entity)
-	    defstruct)
-
-;; Input configuration record
-(defstruct input-config
-  actions                    ; list of action symbols
-  keyboard-map               ; alist: (sdl2-key-sym . action)
-  joy-button-map             ; alist: (button-id . action)
-  controller-button-map      ; alist: (button-sym . action)
-  joy-axis-bindings          ; list of (axis-id positive-action negative-action)
-  controller-axis-bindings   ; list of (axis-sym positive-action negative-action)
-  deadzone)                  ; integer threshold for analog sticks
-
-;; 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))
-
-(define-record input-state
-  current   ; Alist: (action . bool)
-  previous) ; Alist: (action . bool)
-
-;; Create empty input state from config
-(define (create-input-state config)
-  (let ((initial (map (lambda (a) (cons a #f)) (input-config-actions config))))
-    (make-input-state initial initial)))
-
-;; Helper to update the Alist
-(define (set-action state action value)
-  (let* ((curr (input-state-current state))
-         (new-curr (cons (cons action value) (alist-delete action curr eq?))))
-    (make-input-state new-curr (input-state-previous state))))
-
-(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)))
-
-(define (handle-noop state event type config)
-  state)
-
-(define (handle-keyboard state event type config)
-  (let* ((pressed? (eq? type 'key-down))
-         (sym (sdl2:keyboard-event-sym event))
-         (action (alist-ref sym (input-config-keyboard-map config) eq? #f)))
-    (if action (set-action state action pressed?) state)))
-
-(define (apply-axis-to-state state val positive-action negative-action deadzone)
-  (chain state
-         (set-action _ positive-action (> val deadzone))
-         (set-action _ negative-action (< val (- deadzone)))))
-
-(define (handle-joy-button state event type config)
-  (let* ((pressed? (eq? type 'joy-button-down))
-         (btn (sdl2:joy-button-event-button event))
-         (action (alist-ref btn (input-config-joy-button-map config) eqv? #f)))
-    (if action (set-action state action pressed?) state)))
-
-(define (handle-joy-axis state event type config)
-  (let ((axis (sdl2:joy-axis-event-axis event))
-        (val  (sdl2:joy-axis-event-value event))
-        (dz   (input-config-deadzone config)))
-    (let ((binding (assv axis (input-config-joy-axis-bindings config))))
-      (if binding
-          (apply-axis-to-state state val (cadr binding) (caddr binding) dz)
-          state))))
-
-(define (handle-controller-button state event type config)
-  (let* ((pressed? (eq? type 'controller-button-down))
-         (btn (sdl2:controller-button-event-button event))
-         (action (alist-ref btn (input-config-controller-button-map config) eq? #f)))
-    (if action (set-action state action pressed?) state)))
-
-(define (handle-controller-axis state event type config)
-  (let ((axis (sdl2:controller-axis-event-axis event))
-        (val  (sdl2:controller-axis-event-value event))
-        (dz   (input-config-deadzone config)))
-    (let ((binding (assv axis (input-config-controller-axis-bindings config))))
-      (if binding
-          (apply-axis-to-state state val (cadr binding) (caddr binding) dz)
-          state))))
-
-(define (handle-controller-device state event type config)
-  (when (eq? type 'controller-device-added)
-    (sdl2:game-controller-open! (sdl2:controller-device-event-which event)))
-  state)
-
-(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 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)))
-      (unless (eq? state-diff '())
-	    (log-debug "input-state change: ~a" state-diff))
-      new-state)))
-
-;; 5. Simple Getters
-(define (input-held? state action)
-  (alist-ref action (input-state-current state) eq? #f))
-
-(define (input-pressed? state action)
-  (and (input-held? state action)
-       (not (alist-ref action (input-state-previous state) eq? #f))))
-
-(define (input-released? state action)
-  (and (not (input-held? state action))
-       (alist-ref action (input-state-previous state) eq? #f)))
-
-(define (input-any-pressed? state config)
-  (any (lambda (a) (input-pressed? state a)) (input-config-actions config)))
-
-(define (input-state->string state config)
-  (let ((active (filter (lambda (a) (input-held? state a)) (input-config-actions config))))
-    (format #f "[Input: ~a]" (string-join (map symbol->string active) " "))))
-
-(define (set-facing-from-vx entity vx)
-  (cond
-   ((> 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)
-          (if (held? (car entry))
-              (cons (+ (car acc) (cadr entry))
-                    (+ (cdr acc) (cddr entry)))
-              acc))
-        '(0 . 0)
-        input-map))
-
-(define (apply-input-to-entity entity held?)
-  (let ((input-map (entity-ref entity #:input-map #f)))
-    (if (not input-map)
-        entity
-        (let* ((delta (compute-input-delta input-map held?))
-               (vx    (* (entity-ref entity #:move-speed 1) (car delta))))
-          (set-facing-from-vx (entity-set entity #:vx vx) vx)))))
-
-) ;; end module
+    *
+
+  (import scheme
+          (chicken base)
+          (chicken format)
+          (only srfi-1 any filter fold alist-delete)
+          (only srfi-13 string-join)
+          (only srfi-197 chain)
+          (prefix sdl2 sdl2:)
+	      simple-logger
+	      (downstroke entity)
+	      defstruct)
+
+  ;; Input configuration record
+  (defstruct input-config
+    actions                    ; list of action symbols
+    keyboard-map               ; alist: (sdl2-key-sym . action)
+    joy-button-map             ; alist: (button-id . action)
+    controller-button-map      ; alist: (button-sym . action)
+    joy-axis-bindings          ; list of (axis-id positive-action negative-action)
+    controller-axis-bindings   ; list of (axis-sym positive-action negative-action)
+    deadzone)                  ; integer threshold for analog sticks
+
+  ;; 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))
+
+  (define-record input-state
+    current   ; Alist: (action . bool)
+    previous) ; Alist: (action . bool)
+
+  ;; Create empty input state from config
+  (define (create-input-state config)
+    (let ((initial (map (lambda (a) (cons a #f)) (input-config-actions config))))
+      (make-input-state initial initial)))
+
+  ;; Helper to update the Alist
+  (define (set-action state action value)
+    (let* ((curr (input-state-current state))
+           (new-curr (cons (cons action value) (alist-delete action curr eq?))))
+      (make-input-state new-curr (input-state-previous state))))
+
+  (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)))
+
+  (define (handle-noop state event type config)
+    state)
+
+  (define (handle-keyboard state event type config)
+    (let* ((pressed? (eq? type 'key-down))
+           (sym (sdl2:keyboard-event-sym event))
+           (action (alist-ref sym (input-config-keyboard-map config) eq? #f)))
+      (if action (set-action state action pressed?) state)))
+
+  (define (apply-axis-to-state state val positive-action negative-action deadzone)
+    (chain state
+           (set-action _ positive-action (> val deadzone))
+           (set-action _ negative-action (< val (- deadzone)))))
+
+  (define (handle-joy-button state event type config)
+    (let* ((pressed? (eq? type 'joy-button-down))
+           (btn (sdl2:joy-button-event-button event))
+           (action (alist-ref btn (input-config-joy-button-map config) eqv? #f)))
+      (if action (set-action state action pressed?) state)))
+
+  (define (handle-joy-axis state event type config)
+    (let ((axis (sdl2:joy-axis-event-axis event))
+          (val  (sdl2:joy-axis-event-value event))
+          (dz   (input-config-deadzone config)))
+      (let ((binding (assv axis (input-config-joy-axis-bindings config))))
+        (if binding
+            (apply-axis-to-state state val (cadr binding) (caddr binding) dz)
+            state))))
+
+  (define (handle-controller-button state event type config)
+    (let* ((pressed? (eq? type 'controller-button-down))
+           (btn (sdl2:controller-button-event-button event))
+           (action (alist-ref btn (input-config-controller-button-map config) eq? #f)))
+      (if action (set-action state action pressed?) state)))
+
+  (define (handle-controller-axis state event type config)
+    (let ((axis (sdl2:controller-axis-event-axis event))
+          (val  (sdl2:controller-axis-event-value event))
+          (dz   (input-config-deadzone config)))
+      (let ((binding (assv axis (input-config-controller-axis-bindings config))))
+        (if binding
+            (apply-axis-to-state state val (cadr binding) (caddr binding) dz)
+            state))))
+
+  (define (handle-controller-device state event type config)
+    (when (eq? type 'controller-device-added)
+      (sdl2:game-controller-open! (sdl2:controller-device-event-which event)))
+    state)
+
+  (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 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)))
+        (unless (eq? state-diff '())
+	      (log-debug "input-state change: ~a" state-diff))
+        new-state)))
+
+  ;; 5. Simple Getters
+  (define (input-held? state action)
+    (alist-ref action (input-state-current state) eq? #f))
+
+  (define (input-pressed? state action)
+    (and (input-held? state action)
+         (not (alist-ref action (input-state-previous state) eq? #f))))
+
+  (define (input-released? state action)
+    (and (not (input-held? state action))
+         (alist-ref action (input-state-previous state) eq? #f)))
+
+  (define (input-any-pressed? state config)
+    (any (lambda (a) (input-pressed? state a)) (input-config-actions config)))
+
+  (define (input-state->string state config)
+    (let ((active (filter (lambda (a) (input-held? state a)) (input-config-actions config))))
+      (format #f "[Input: ~a]" (string-join (map symbol->string active) " "))))
+
+  (define (set-facing-from-vx entity vx)
+    (cond
+     ((> 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)
+            (if (held? (car entry))
+                (cons (+ (car acc) (cadr entry))
+                      (+ (cdr acc) (cddr entry)))
+                acc))
+          '(0 . 0)
+          input-map))
+
+  (define (apply-input-to-entity entity held?)
+    (let ((input-map (entity-ref entity #:input-map #f)))
+      (if (not input-map)
+          entity
+          (let* ((delta (compute-input-delta input-map held?))
+                 (vx    (* (entity-ref entity #:move-speed 1) (car delta))))
+            (set-facing-from-vx (entity-set entity #:vx vx) vx)))))
+
+  ) ;; end module