-
-
Notifications
You must be signed in to change notification settings - Fork 46
/
gamepad.lisp
66 lines (60 loc) · 3.46 KB
/
gamepad.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
(in-package #:org.shirakumo.fraf.trial)
(defclass gamepad-input-handler ()
((last-device-probe :initform 0 :accessor last-device-probe)))
(defmacro with-gamepad-failure-handling ((&key (ignore-error T)) &body body)
`(catch 'bail-input
(handler-bind ((gamepad:gamepad-error
(lambda (e)
(declare (ignore e))
(when (find-restart 'gamepad:drop-device)
(invoke-restart 'gamepad:drop-device))
,(when ignore-error
`(throw 'bail-input NIL)))))
,@body)))
(defun describe-gamepad (dev)
(format NIL "Vendor: ~a Product: ~a Version: ~a Driver: ~a Name: ~a"
(gamepad:vendor dev) (gamepad:product dev) (gamepad:version dev)
(gamepad:driver dev) (gamepad:name dev)))
(defmethod start :before ((handler gamepad-input-handler))
(with-gamepad-failure-handling (:ignore-error #-trial-release NIL #+trial-release T)
(v:info :trial.input "~:[No controllers detected.~;Detected the following controllers:~:*~{~% ~a~}~]"
(mapcar #'describe-gamepad (gamepad:init)))))
(defmethod stop :before ((handler gamepad-input-handler))
(with-gamepad-failure-handling ()
(gamepad:shutdown)))
(defmethod poll-input :after ((handler gamepad-input-handler))
(with-gamepad-failure-handling ()
(labels ((process (event)
(typecase event
(gamepad:button-down
(handle (make-event 'gamepad-press
:button (or (gamepad:event-label event)
(gamepad:event-code event))
:device (gamepad:event-device event))
handler))
(gamepad:button-up
(handle (make-event 'gamepad-release
:button (or (gamepad:event-label event)
(gamepad:event-code event))
:device (gamepad:event-device event))
handler))
(gamepad:axis-move
(handle (make-event 'gamepad-move
:pos (gamepad:event-value event)
:old-pos (gamepad:event-old-value event)
:axis (or (gamepad:event-label event)
(gamepad:event-code event))
:device (gamepad:event-device event))
handler))))
(poll (device)
(gamepad:poll-events device #'process)))
(gamepad:call-with-devices #'poll))
(when (< internal-time-units-per-second
(- (get-internal-real-time) (last-device-probe handler)))
(setf (last-device-probe handler) (get-internal-real-time))
(gamepad:poll-devices :function (lambda (action device)
(ecase action
(:add (v:info :trial.input "New controller:~% ~a" (describe-gamepad device))
(handle (make-instance 'gamepad-added :device device) handler))
(:remove (v:info :trial.input "Lost controller:~% ~a" (describe-gamepad device))
(handle (make-instance 'gamepad-removed :device device) handler))))))))