Continuing from Part 1, the next step is input.
Just commented code this time...
;; osicat wants pointers, but some of the ioctls we use want ints, so ;; add a wrapper (defun ioctl/p (fd req arg) (nix:ioctl fd req (cffi:make-pointer arg))) ;; some ioctl constants i couldn't find in osicat (defconstant +KDGKBMODE+ #x4B44) (defconstant +KDSKBMODE+ #x4B45) (defconstant +K-OFF+ #x04) (defconstant +KDSKBMUTE+ #x4B51) (defconstant +KDSETMODE+ #x4B3A) (defconstant +KD-TEXT+ #x00) (defconstant +KD-GRAPHICS+ #x01) ;; minimal udev bindings to use libinput udev backend (cffi:define-foreign-library libudev (:unix (:or "libudev.so.1" "libudev.so")) (t (:default "libudev"))) (cffi:use-foreign-library libudev) (cffi:defcfun ("udev_new" udev-new) :pointer) (cffi:defcfun ("udev_ref" udev-ref) :pointer (udev :pointer)) (cffi:defcfun ("udev_unref" udev-unref) :pointer (udev :pointer)) ;; store some closure to let us open/close devices from outside ;; lexical scope of the WITH-DBUS* macro (defvar *take-device*) (defvar *release-device*) ;; callbacks that let us handle opening devices for libinput (cffi:defcallback open-restricted :int ((path :string) (flags :int) (user-data :pointer)) (declare (ignorable flags user-data)) (format t "Called open-restricted path = ~s = ~s~%" path (path-device path)) (let ((fd (funcall *take-device* path))) (format t "File descriptor ~A~%" fd) (when (< fd 0) (warn "Failed to open ~A" path)) fd)) (cffi:defcallback close-restricted :void ((fd :int) (user-data :pointer)) (declare (ignorable user-data)) (funcall *release-device* fd)) ;; allocate struct used to pass our callbacks to libinput (defun make-libinput-interface () (let ((interface (cffi:foreign-alloc '(:struct libinput::libinput-interface)))) (cffi:with-foreign-slots ((libinput::open-restricted libinput::close-restricted) interface (:struct libinput::libinput-interface)) (setf libinput::open-restricted (cffi:callback open-restricted)) (setf libinput::close-restricted (cffi:callback close-restricted))) interface)) ;; variable to tell it to exit event loop (defparameter *stop* t) ;; we need major/minor for an open FD to use in close callback (defun fd-device (fd) ;; return device major/minor for a given fd (let ((rdev (nix:stat-rdev (nix:fstat fd)))) (list (ldb (byte 8 8) rdev) (ldb (byte 8 0) rdev)))) (with-dbus* (l lc lp s sc sp) ;; we need to be in control of the session (sc "TakeControl" nil) ;; set our callbacks to open/close files using logind (setf *take-device* (lambda (path) (apply #'sc "TakeDevice" (path-device path)))) (setf *release-device* (lambda (fd) (format t "release device ~s = ~s~%" fd (fd-device fd)) ;; apparently we should close the fd before ;; releasing it? (let ((dev (fd-device fd))) (nix:close fd) (apply #'sc "ReleaseDevice" dev)))) (let* ((tty (sp "TTY")) (tty-path (format nil "/dev/~a" tty)) (seat (car (sp "Seat"))) ;; o-noctty since we don't care about the state of the ;; terminal itself. TakeControl gives us permissions to open ;; the tty, so normal nix:open works for this. (tty-fd (nix:open tty-path (logior nix:o-rdwr nix:o-noctty))) ;; state we will initialize below (old-keyboard-mode nil) (udev nil) (context nil) (libinput-fd nil) (interface)) ;; next we try to mute the tty, or otherwise set mode to off. ;; Handler-case is needed since osicat negative return to errors, ;; and here failure of the first ioctl is OK (handler-case (ioctl/p tty-fd +kdskbmute+ 1) (nix:posix-error () (cffi:with-foreign-object (old-mode :int) (nix:ioctl tty-fd +kdgkbmode+ old-mode) (setf old-keyboard-mode (cffi:mem-ref old-mode :int))))) ;; set terminal to graphics mode to avoid it trying to draw any ;; text or cursor over our graphics (ioctl/p tty-fd +kdsetmode+ +kd-graphics+) ;; we will use the udev backend of libinput, so we don't need to ;; manually find devices and track hotplug ;; first get a udev device (setf udev (udev-new)) ;; create a libinput context, passing it our custom open/close functions (setf context (libinput:udev-create-context (setf interface (make-libinput-interface)) (cffi:null-pointer) udev)) ;; optional: set libinput to send verbose log info to ;; console. Getting log output from CL would require callbacks ;; with support for variadic arguments, which isn't supported by ;; cffi or libffi, so would need a C wrapper lib or ABI specific ;; hacks. (libinput:log-set-priority context :debug) ;; tell libinput to use devices from our seat (will find all ;; usable devices and call our callbacks to open them) (libinput:udev-assign-seat context seat) ;; grab the FD from libinput so we can poll it for events (setf libinput-fd (libinput:get-fd context)) (format t "got fd ~s from libinput~%" libinput-fd) ;; run initial event dispatch. Does some internal state ;; processing and adds `device-notify` events to libinput's ;; internal event queue (libinput:dispatch context) ;; now we are ready to do some input: ;; again, we should be using select/poll/epoll/etc to watch ;; LIBINPUT-FD for events, but will just busy wait. In particular, ;; while events can sit in the queue for a bit without any ;; problem, LIBINPUT:DISPATCH needs to be called immediately after ;; FD is readable for its internal state processing to work ;; correctly. (setf *stop* nil) (format t "waiting for input:~%") (loop do (libinput:dispatch context) ;; loop over all available events (loop for ev = (libinput:get-event context) until (or *stop* ;; get-event returns null pointer if no events ;; available, at which point we go back to outer ;; loop and call dispatch again (cffi:null-pointer-p ev)) do (unwind-protect ;; get some info common to all events (let* ((et (libinput:event-get-type ev)) (dev (libinput:event-get-device ev))) ;; handle some of the events I will see on my device (case et (#.libinput:device-added ;; we get one of these for every input device ;; connected to the seat when we created ;; context, and any that are added later (format t "added device ~s ~s (~s)~%" (libinput:device-get-name dev) (libinput:device-get-output-name dev) (libinput:device-get-sysname dev)) ;; print out what ssort events the new device ;; can generate (loop with caps = '(0 :keyboard 1 :pointer 2 :touch 3 :tablet-tool 4 :tablet-pad 5 :gesture 6 :switch) for i below 8 when (plusp (libinput:device-has-capability dev i)) do (format t " has capability ~s~%" (getf caps i)))) (#.libinput:device-removed (format t "removed device ~s ~s (~s)~%" (libinput:device-get-name dev) (libinput:device-get-output-name dev) (libinput:device-get-sysname dev))) ;; I don't have a keyboard or mouse on this ;; system, so just handling touch events see ;; libinput docs for full list of events ((#.libinput:touch-down #.libinput:touch-motion) ;; for most events, we need to get ;; device-specific event data from generic ;; event to get details (let ((ev2 (libinput:event-get-touch-event ev))) (format t "~%touch ~s @ ~5,3f~%" (if (= et libinput:touch-down) "down" "motion") ;; most input events have timestamps ;; in usec, not guaranteed to always ;; be increasing though (* (libinput:event-touch-get-time-usec ev2) 1.0d-6)) (format t "~& ~s, ~s @ ~5,3f,~5,3f || ~5,3f,~5,3f~%" (libinput:event-touch-get-slot ev2) (libinput:event-touch-get-seat-slot ev2) ;; this is supposedly in mm, but i get ;; device coords from 0 to 4096 from my ;; touchscreen (libinput:event-touch-get-x ev2) (libinput:event-touch-get-y ev2) ;; to get screen coordinates, we need to ;; pass screen size to these, 800x480 in ;; my case (libinput:event-touch-get-x-tranformed ev2 800) (libinput:event-touch-get-y-transformed ev2 480)))) ((#.libinput:touch-up ;; touch-frame event is used to group ;; multiple events when there are multiple ;; touches at once. #.libinput:touch-frame) (let ((ev2 (libinput:event-get-touch-event ev))) (format t "~%touch ~a @ ~5,3f~%" (if (eql et libinput:touch-up) "up" "frame") ;; most input events have timestamps ;; in usec, not guaranteed to always ;; be increasing though (* (libinput:event-touch-get-time-usec ev2) 1.0d-6)))) (otherwise ;; there are also keyboard, pointer, switch, ;; tablet and gesture (for things like ;; multitouch pinch/rotate etc) which are ;; similar. (format t "got event type ~s from device ~s~%" et dev)))) ;; clean up the event when we are done with it (libinput:event-destroy ev))) until *stop*) ;; finally, clean everything up ;; reset TTY state (if old-keyboard-mode (ioctl/p tty-fd +kdskbmode+ old-keyboard-mode) (ioctl/p tty-fd +kdskbmute+ 0)) (ioctl/p tty-fd +kdsetmode+ +kd-text+) ;; and close fd (nix:close tty-fd) ;;(apply #'sc "ReleaseDevice" (fd-device tty-fd)) ;; close libinput context (will call our callbacks to close devices) (libinput:unref context) ;; close udev device (udev-unref udev) ;; delete foreign mem for callback struct (cffi:foreign-free interface) ;; stop keeping bus/etc vars live with closures in global variables (setf *take-device* nil) (setf *release-device* nil) (sc "ReleaseControl")))
gives output like
Called open-restricted path = "/dev/input/event0" = (13 64) File descriptor 15 Called open-restricted path = "/dev/input/event2" = (13 66) File descriptor 16 Called open-restricted path = "/dev/input/event3" = (13 67) File descriptor 17 Called open-restricted path = "/dev/input/event1" = (13 65) File descriptor 18 got fd 12 from libinput waiting for input: added device "gpio_keys" NIL ("event0") has capability :KEYBOARD added device "WaveShare WS170120" NIL ("event2") has capability :TOUCH added device "RC for dw_hdmi" NIL ("event3") has capability :KEYBOARD added device "sunxi-ir" NIL ("event1") has capability :KEYBOARD touch "down" @ 160006.352 0, 0 @ 1658.000,1725.000 || 323.828,202.148 touch frame @ 160006.352 touch "motion" @ 160006.362 0, 0 @ 1626.000,1755.000 || 317.578,205.664 touch frame @ 160006.362 touch "motion" @ 160006.372 0, 0 @ 1623.000,1775.000 || 316.992,208.008 touch frame @ 160006.372 <more motion events skipped> touch "motion" @ 160006.420 0, 0 @ 1613.000,1810.000 || 315.039,212.109 touch frame @ 160006.420 touch up @ 160006.424 touch frame @ 160006.424 release device 15 = (13 64) release device 16 = (13 66) release device 17 = (13 67) release device 18 = (13 65)