(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 (apply-input-to-entity entity held?)
  (let ((input-map (entity-ref entity #:input-map #f)))
    (if (not input-map)
        entity
        (let* ((delta (fold (lambda (entry acc)
                              (let* ((action (car entry))
                                     (d      (cdr entry))
                                     (dvx    (car d))
                                     (dvy    (cdr d)))
                                (if (held? action)
                                    (cons (+ (car acc) dvx)
                                          (+ (cdr acc) dvy))
                                    acc)))
                            '(0 . 0)
                            input-map))
               (speed (entity-ref entity #:move-speed 1))
               (vx    (* speed (car delta))))
          (set-facing-from-vx (entity-set entity #:vx vx) vx)))))

) ;; end module