Skip to content
Permalink
Browse files

Rewrite the gamepad system to not need a dedicated thread (instead pi…

…ggy-back off the main thread)
  • Loading branch information...
Shinmera committed Jul 20, 2019
1 parent bb52af6 commit a133cffaf93f99bffa8506910c070e50dd6687eb
Showing with 106 additions and 108 deletions.
  1. +1 −0 backends/glfw/context.lisp
  2. +2 −1 backends/glop/context.lisp
  3. +2 −0 backends/qt/context.lisp
  4. +68 −65 backends/sdl2/context.lisp
  5. +0 −2 deploy.lisp
  6. +4 −2 display.lisp
  7. +27 −37 gamepad.lisp
  8. +1 −1 main.lisp
  9. +1 −0 package.lisp
@@ -193,6 +193,7 @@
(loop with window = (window (trial:context main))
until (cl-glfw3:window-should-close-p window)
do (cl-glfw3:poll-events)
(poll-input main)
;; Apparently bt:thread-yield is a no-op sometimes,
;; making this loop consume the core. Sleep instead.
(sleep 0.001))
@@ -176,7 +176,8 @@
(unwind-protect
(catch 'escape
(start main)
(loop (glop:dispatch-events context :blocking T :on-foo NIL)))
(loop (glop:dispatch-events context :blocking T :on-foo NIL)
(poll-input main)))
(finalize main))))
#+darwin
(tmt:with-body-in-main-thread (:blocking T)
@@ -230,3 +230,5 @@
(qtools::with-traps-masked (thunk)))))
#-darwin
(qtools::with-traps-masked (thunk))))

;; FIXME: Call (poll-input main) frequently!
@@ -182,7 +182,7 @@
(unwind-protect
(progn
(start main)
(sdl2-event-loop (trial:context main)))
(sdl2-event-loop main))
(finalize main))))
(sdl2-ffi.functions:sdl-quit))))
#+darwin
@@ -191,73 +191,76 @@
#-darwin
(thunk)))

(defun sdl2-event-loop (context)
(let ((quit NIL))
(defun sdl2-event-loop (main)
(let ((context (trial:context main))
(quit NIL))
(sdl2:with-sdl-event (ev)
(loop until quit
for event = (sdl2:next-event ev :wait)
for type = (sdl2:get-event-type ev)
do (with-simple-restart (abort "Don't handle the event.")
(case type
(:keydown
(let* ((keysym (plus-c:c-ref ev sdl2-ffi:sdl-event :key :keysym))
(sym (sdl2:scancode-value keysym))
(mod (sdl2:mod-keywords (sdl2:mod-value keysym))))
(handle (make-instance 'key-press
:key (sdl2-key->key sym)
:modifiers (mapcar #'sdl2-mod->mod mod))
(handler context))))
(:keyup
(let* ((keysym (plus-c:c-ref ev sdl2-ffi:sdl-event :key :keysym))
(sym (sdl2:scancode-value keysym))
(mod (sdl2:mod-keywords (sdl2:mod-value keysym))))
(handle (make-instance 'key-release
:key (sdl2-key->key sym)
:modifiers (mapcar #'sdl2-mod->mod mod))
(handler context))))
(:mousebuttondown
(let ((button (plus-c:c-ref ev sdl2-ffi:sdl-event :button :button))
(x (plus-c:c-ref ev sdl2-ffi:sdl-event :button :x))
(y (plus-c:c-ref ev sdl2-ffi:sdl-event :button :y)))
(vsetf (mouse-pos context) x y)
(handle (make-instance 'mouse-press
for event = (sdl2:next-event ev)
do (poll-input main)
(when event
(with-simple-restart (abort "Don't handle the event.")
(case (sdl2:get-event-type ev)
(:keydown
(let* ((keysym (plus-c:c-ref ev sdl2-ffi:sdl-event :key :keysym))
(sym (sdl2:scancode-value keysym))
(mod (sdl2:mod-keywords (sdl2:mod-value keysym))))
(handle (make-instance 'key-press
:key (sdl2-key->key sym)
:modifiers (mapcar #'sdl2-mod->mod mod))
(handler context))))
(:keyup
(let* ((keysym (plus-c:c-ref ev sdl2-ffi:sdl-event :key :keysym))
(sym (sdl2:scancode-value keysym))
(mod (sdl2:mod-keywords (sdl2:mod-value keysym))))
(handle (make-instance 'key-release
:key (sdl2-key->key sym)
:modifiers (mapcar #'sdl2-mod->mod mod))
(handler context))))
(:mousebuttondown
(let ((button (plus-c:c-ref ev sdl2-ffi:sdl-event :button :button))
(x (plus-c:c-ref ev sdl2-ffi:sdl-event :button :x))
(y (plus-c:c-ref ev sdl2-ffi:sdl-event :button :y)))
(vsetf (mouse-pos context) x y)
(handle (make-instance 'mouse-press
:pos (mouse-pos context)
:button (sdl2-button->button button))
(handler context))))
(:mousebuttonup
(let ((button (plus-c:c-ref ev sdl2-ffi:sdl-event :button :button))
(x (plus-c:c-ref ev sdl2-ffi:sdl-event :button :x))
(y (plus-c:c-ref ev sdl2-ffi:sdl-event :button :y)))
(vsetf (mouse-pos context) x y)
(handle (make-instance 'mouse-release
:pos (mouse-pos context)
:button (sdl2-button->button button))
(handler context))))
(:mousemotion
(let* ((new (vec2 (plus-c:c-ref ev sdl2-ffi:sdl-event :motion :x)
(plus-c:c-ref ev sdl2-ffi:sdl-event :motion :y)))
(old (shiftf (mouse-pos context) new)))
(handle (make-instance 'mouse-move
:pos new
:old-pos old)
(handler context))))
(:mousewheel
(handle (make-instance 'mouse-scroll
:pos (mouse-pos context)
:button (sdl2-button->button button))
(handler context))))
(:mousebuttonup
(let ((button (plus-c:c-ref ev sdl2-ffi:sdl-event :button :button))
(x (plus-c:c-ref ev sdl2-ffi:sdl-event :button :x))
(y (plus-c:c-ref ev sdl2-ffi:sdl-event :button :y)))
(vsetf (mouse-pos context) x y)
(handle (make-instance 'mouse-release
:pos (mouse-pos context)
:button (sdl2-button->button button))
(handler context))))
(:mousemotion
(let* ((new (vec2 (plus-c:c-ref ev sdl2-ffi:sdl-event :motion :x)
(plus-c:c-ref ev sdl2-ffi:sdl-event :motion :y)))
(old (shiftf (mouse-pos context) new)))
(handle (make-instance 'mouse-move
:pos new
:old-pos old)
(handler context))))
(:mousewheel
(handle (make-instance 'mouse-scroll
:pos (mouse-pos context)
:delta (plus-c:c-ref ev sdl2-ffi:sdl-event :wheel :y))
(handler context)))
(:textediting
;; FIXME: Don't know what to do with this, yet.
)
(:textinput
(let ((text (cffi:foreign-string-to-lisp
(plus-c:c-ref ev sdl2-ffi:sdl-event :text :text plus-c:&)
:encoding :utf-8)))
(handle (make-instance 'text-entered
:text text)
(handler context))))
(:quit
(setf quit T))))))))
:delta (plus-c:c-ref ev sdl2-ffi:sdl-event :wheel :y))
(handler context)))
(:textediting
;; FIXME: Don't know what to do with this, yet.
)
(:textinput
(let ((text (cffi:foreign-string-to-lisp
(plus-c:c-ref ev sdl2-ffi:sdl-event :text :text plus-c:&)
:encoding :utf-8)))
(handle (make-instance 'text-entered
:text text)
(handler context))))
(:quit
(setf quit T)))))
(sleep 0.001)))))

(defun sdl2-button->button (button)
button)
@@ -17,13 +17,11 @@

(deploy:define-hook (:build trial) ()
(cl-monitors:deinit)
(shutdown-gamepad-system)
(v:remove-global-controller))

(deploy:define-hook (:boot trial) ()
(v:restart-global-controller)
(cl-monitors:init)
(init-gamepad-system)
(setf *random-state* (make-random-state T)))

(deploy:define-library cl-opengl-bindings::opengl
@@ -20,12 +20,10 @@
when keep collect k when keep collect v)))
(setf context (setf (context display) (apply #'make-context NIL args)))))
(setf (handler context) display)
(add-gamepad-handler display)
(with-context ((context display))
(setup-rendering display)))

(defmethod finalize :after ((display display))
(remove-gamepad-handler display)
(finalize (context display)))

(defmethod handle (event (display display)))
@@ -49,6 +47,10 @@

(defmethod paint (source (target display)))

(defgeneric poll-input (target))

(defmethod poll-input ((target display)))

(defmethod render (source (target display))
(paint source target))

@@ -6,66 +6,56 @@

(in-package #:org.shirakumo.fraf.trial)

(defvar *gamepad-handlers* ())
(defvar *gamepad-handlers-lock* (bt:make-lock))
(defvar *gamepad-input-thread* ())
(defvar *gamepad-handler*)

(defun add-gamepad-handler (handler)
(bt:with-lock-held (*gamepad-handlers-lock*)
(pushnew handler *gamepad-handlers*)))
(defclass gamepad-input-handler ()
((last-device-probe :initform 0 :accessor last-device-probe)))

(defun remove-gamepad-handler (handler)
(bt:with-lock-held (*gamepad-handlers-lock*)
(setf *gamepad-handlers* (remove handler *gamepad-handlers*))))
(defmethod start :after ((handler gamepad-input-handler))
(let ((*gamepad-handler* handler))
(cl-gamepad:init)))

(defun init-gamepad-system ()
(or *gamepad-input-thread*
(setf *gamepad-input-thread*
(with-thread ("gamepad event thread")
(cl-gamepad:init)
(unwind-protect
(loop for i = 0 then (1+ i)
while *gamepad-input-thread*
do (when (= 0 (mod i 60))
(cl-gamepad:detect-devices))
(cl-gamepad:process-events)
(sleep 1/60))
(cl-gamepad:shutdown))))))
(defmethod stop :after ((handler gamepad-input-handler))
(let ((*gamepad-handler* handler))
(cl-gamepad:shutdown)))

(defun shutdown-gamepad-system ()
(with-thread-exit (*gamepad-input-thread*)
(setf *gamepad-input-thread* NIL)))

(init-gamepad-system)
(defmethod poll-input :after ((handler gamepad-input-handler))
(let ((*gamepad-handler* handler))
(cl-gamepad:process-events)
(when (< internal-time-units-per-second
(- (get-internal-real-time) (last-device-probe handler)))
(setf (last-device-probe handler) (get-internal-real-time))
(cl-gamepad:detect-devices))))

(setf (v:repl-level) :trace)
(defun cl-gamepad:device-attached (device)
(v:info :trial.input.gamepad "Attached ~s"
(cl-gamepad:print-device device NIL))
(dolist (handler *gamepad-handlers*)
(handle (make-instance 'gamepad-attach :device device) handler)))
(handle (make-instance 'gamepad-attach :device device)
*gamepad-handler*))

(defun cl-gamepad:device-removed (device)
(v:info :trial.input.gamepad "Removed ~s" (cl-gamepad:print-device device NIL))
(dolist (handler *gamepad-handlers*)
(handle (make-instance 'gamepad-remove :device device) handler)))
(handle (make-instance 'gamepad-remove :device device)
*gamepad-handler*))

(defun cl-gamepad:button-pressed (button time device)
(declare (ignore time))
(let ((button (cl-gamepad:button-label device button)))
(v:trace :trial.input.gamepad "~a pressed ~a" (cl-gamepad:id device) button)
(dolist (handler *gamepad-handlers*)
(handle (make-instance 'gamepad-press :button button :device device) handler))))
(handle (make-instance 'gamepad-press :button button :device device)
*gamepad-handler*)))

(defun cl-gamepad:button-released (button time device)
(declare (ignore time))
(let ((button (cl-gamepad:button-label device button)))
(v:trace :trial.input.gamepad "~a released ~a" (cl-gamepad:id device) button)
(dolist (handler *gamepad-handlers*)
(handle (make-instance 'gamepad-release :button button :device device) handler))))
(handle (make-instance 'gamepad-release :button button :device device)
*gamepad-handler*)))

(defun cl-gamepad:axis-moved (axis last-value value time device)
(declare (ignore time))
(let ((axis (cl-gamepad:axis-label device axis))
(mult (cl-gamepad:axis-multiplier device axis)))
(dolist (handler *gamepad-handlers*)
(handle (make-instance 'gamepad-move :axis axis :old-pos (* mult last-value) :pos (* mult value) :device device) handler))))
(handle (make-instance 'gamepad-move :axis axis :old-pos (* mult last-value) :pos (* mult value) :device device)
*gamepad-handler*)))
@@ -7,7 +7,7 @@
(in-package #:org.shirakumo.fraf.trial)

;; FIXME: Fullscreenable seems to cause really bad behaviour, idk
(defclass main (display window)
(defclass main (display window gamepad-input-handler)
((scene :initform (make-instance 'pipelined-scene) :accessor scene)
(controller :initform (make-instance 'controller) :accessor controller)))

@@ -236,6 +236,7 @@
;; display.lisp
(:export
#:display
#:poll-input
#:context
#:clear-color
#:setup-rendering

0 comments on commit a133cff

Please sign in to comment.
You can’t perform that action at this time.