;;; The contents of this demo file are made available under the CC0 1.0
;;; Universal Public Domain Dedication. See LICENSE-CC0.txt or visit
;;; http://creativecommons.org/publicdomain/zero/1.0/

;;; Outputs info and events for available game controllers.

(cond-expand
 (chicken-4
  (use (prefix sdl2 sdl2:)
       miscmacros))
 (else
  (import (chicken condition)
          (chicken format)
          (prefix sdl2 sdl2:)
          miscmacros)))

(sdl2:set-main-ready!)
(sdl2:init!)
(on-exit sdl2:quit!)
(current-exception-handler
 (let ((original-handler (current-exception-handler)))
   (lambda (exception)
     (sdl2:quit!)
     (original-handler exception))))

(define window
  (sdl2:create-window!
   "Game Controller Events"
   'undefined 'undefined
   320 240))


(define (main)
  (scan-joysticks)
  (let/cc exit-main-loop!
    (while #t
      (handle-event! (sdl2:wait-event!) exit-main-loop!))))


(define (scan-joysticks)
  (sdl2:joystick-update!)
  (printf "Scanning joysticks for controllers...~N")
  (let loop ((n (sdl2:num-joysticks))
             (i 0))
    (cond
     ((zero? n)
      (printf "No joysticks found.~N"))
     ((< i n)
      (if (sdl2:is-game-controller? i)
          (printf "Joystick ~A ~S is a controller.~N"
                  i
                  (sdl2:game-controller-name-for-index i))
          (printf "Joystick ~A is NOT a controller.~N"
                  i))
      (loop n (+ i 1))))))


(define (bind-info bind)
  (case (sdl2:game-controller-button-bind-type bind)
    ((axis)
     (sprintf "joy axis ~A"
              (sdl2:game-controller-button-bind-axis bind)))
    ((button)
     (sprintf "joy button ~A"
              (sdl2:game-controller-button-bind-button bind)))
    ((hat)
     (sprintf "joy axis ~A"
              (sdl2:game-controller-button-bind-hat bind)))
    (else
     "unknown bind")))


(define (handle-event! ev exit-main-loop!)
  (case (sdl2:event-type ev)
    ((quit)
     (exit-main-loop! #t))

    ((key-down)
     (case (sdl2:keyboard-event-sym ev)
       ((escape)
        (exit-main-loop! #t))))

    ((controller-device-added)
     (let* ((index (sdl2:controller-device-event-which ev))
            (con (sdl2:game-controller-open! index))
            (joy (sdl2:game-controller-get-joystick con)))
       (printf "Controller ~A added: ~A~N~!"
               index (sdl2:game-controller-name con))))

    ((controller-device-removed)
     (printf "Controller ~A removed~N~!"
             (sdl2:controller-device-event-which ev)))

    ((controller-device-remapped)
     (printf "Controller ~A remapped~N~!"
             (sdl2:controller-device-event-which ev)))

    ((controller-axis-motion)
     (let* ((index (sdl2:controller-axis-event-which ev))
            (axis (sdl2:controller-axis-event-axis ev))
            (con (sdl2:game-controller-open! index))
            (bind (sdl2:game-controller-get-bind-for-axis con axis)))
       (printf "Controller ~A axis ~A ~S (~A) changed: ~A~N~!"
               index
               axis
               (sdl2:game-controller-get-string-for-axis axis)
               (bind-info bind)
               (sdl2:controller-axis-event-value ev))))

    ((controller-button-down controller-button-up)
     (let* ((index (sdl2:controller-button-event-which ev))
            (button (sdl2:controller-button-event-button ev))
            (con (sdl2:game-controller-open! index))
            (bind (sdl2:game-controller-get-bind-for-button con button)))
       (printf "Controller ~A button ~A ~S (~A) changed: ~A~N~!"
               index
               button
               (sdl2:game-controller-get-string-for-button button)
               (bind-info bind)
               (sdl2:controller-button-event-state ev))))))

(main)