;;; 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 events for each available joystick on this computer.

(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!
   "Joystick Events"
   'undefined 'undefined
   320 240))


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

(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))))

    ((joy-device-added)
     (let* ((i (sdl2:joy-device-event-which ev))
            (joy (sdl2:joystick-open! i)))
       (printf "Joystick ~A added:~N" i)
       (printf "  Name: ~A~N" (sdl2:joystick-name joy))
       (printf "  GUID: ~A~N" (sdl2:joystick-get-guid-string
                               (sdl2:joystick-get-guid joy)))
       (printf "  Power Level: ~A~N" (sdl2:joystick-current-power-level joy))
       (printf "  Axes: ~A~N" (sdl2:joystick-num-axes joy))
       (printf "  Balls: ~A~N" (sdl2:joystick-num-balls joy))
       (printf "  Buttons: ~A~N" (sdl2:joystick-num-buttons joy))
       (printf "  Hats: ~A~N" (sdl2:joystick-num-hats joy))))

    ((joy-device-removed)
     (printf "Joystick ~A removed~N"
             (sdl2:joy-device-event-which ev)))

    ((joy-axis-motion)
     (printf "Joystick ~A axis ~A changed: ~A~N"
             (sdl2:joy-axis-event-which ev)
             (sdl2:joy-axis-event-axis ev)
             (sdl2:joy-axis-event-value ev)))

    ((joy-ball-motion)
     (printf "Joystick ~A ball ~A changed: (~A, ~A)~N"
             (sdl2:joy-ball-event-which ev)
             (sdl2:joy-ball-event-ball ev)
             (sdl2:joy-ball-event-xrel ev)
             (sdl2:joy-ball-event-yrel ev)))

    ((joy-button-down joy-button-up)
     (printf "Joystick ~A button ~A changed: ~A~N"
             (sdl2:joy-button-event-which ev)
             (sdl2:joy-button-event-button ev)
             (sdl2:joy-button-event-state ev)))

    ((joy-hat-motion)
     (printf "Joystick ~A hat ~A changed: ~A~N"
             (sdl2:joy-hat-event-which ev)
             (sdl2:joy-hat-event-hat ev)
             (sdl2:joy-hat-event-value ev)))))

(main)