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

(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
                              (:struct libinput::libinput-interface))
      (setf libinput::open-restricted (cffi:callback open-restricted))
      (setf libinput::close-restricted (cffi:callback close-restricted)))

;; 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)
    ;; 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
        (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))
    ;; 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:~%")
      do (libinput:dispatch context)
         ;; loop over all available events
           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
                        ;; 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))))
                        (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)
                          (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
                                   ev2 800)
                                   ev2 480))))
                         ;; touch-frame event is used to group
                         ;; multiple events when there are multiple
                         ;; touches at once.
                        (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)
                        ;; 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)