Linux Console Graphics with, DRM, GBM, EGL, GLES, logind, libinput, etc. in CL
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)