changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > core / lisp/lib/io/kbd.lisp

changeset 685: ebe3315b7add
parent: 29fe829a7ac3
author: Richard Westhaver <ellis@rwest.io>
date: Sun, 29 Sep 2024 22:44:52 -0400
permissions: -rw-r--r--
description: evdev/kbd fully operational, rustls and blake3 cleanups 
     1 ;;; kbd.lisp --- Keyboard-based IO
     2 
     3 ;; Keyboard-like devices and input
     4 
     5 ;;; Commentary:
     6 
     7 ;; refs:
     8 
     9 ;; - https://www.kernel.org/doc/Documentation/input/event-codes.txt
    10 
    11 ;; - https://github.com/xkbcommon/libxkbcommon/blob/master/tools/interactive-evdev.c
    12 
    13 ;; - https://gitlab.freedesktop.org/libevdev/libevdev/-/tree/master/tools
    14 
    15 ;;; Code:
    16 (in-package :io/kbd)
    17 (load-xkbcommon)
    18 
    19 (deferror kbd-error () ())
    20 
    21 (defstruct keyboard path state compose-state)
    22 
    23 (defconstant +evdev-offset+ 8)
    24 
    25 (defconstant +long-bit+ (sb-alien:alien-size sb-alien:unsigned-long))
    26 
    27 (defun evdev-bit-p (array bit)
    28   "Array elements should be unsigned-long."
    29   (let ((idx (/ bit +long-bit+)))
    30     ;; the literal 1 here is 1LL in C - there is potential to overflow a
    31     ;; singled long.
    32     (logand (aref array idx) (ash 1 (mod bit +long-bit+)))))
    33 
    34 (defun new-device-from-path (path)
    35   (with-fd (fd path :flags sb-posix:o-rdonly :close nil)
    36     (sb-alien:with-alien ((dev (* evdev::libevdev)))
    37       (let ((ret (evdev:libevdev-new-from-fd fd (sb-alien:addr dev))))
    38         (if (minusp ret)
    39             (sb-unix::strerror (abs ret))
    40             dev)))))
    41 
    42 ;; evdev::+ev-cnt+ evdev::+key-cnt+
    43 (defun keyboard-device-p (path)
    44   (with-open-file (st path :element-type 'octet)
    45     (let ((evbits (make-array evdev::+ev-cnt+))
    46           (keybits (make-array evdev::+key-cnt+)))
    47       ;; (sb-posix:ioctl (fd path)
    48       (read-sequence evbits st)
    49       (read-sequence keybits st)
    50       ;; (cons evbits keybits)
    51       (loop for i from evdev::+key-reserved+ upto evdev::+key-min-interesting+
    52             if (not (evdev-bit-p keybits i))
    53             do (break)
    54             else return t))))
    55       
    56 (defun make-keyboard-from-dev (dev keymap compose-table))
    57 
    58 (defun get-keyboards (keymap compose-table &optional (dir "/dev/input"))
    59   (let ((devices (directory dir)))
    60     (dolist (dev devices)
    61       (let ((ret (make-keyboard-from-dev dev keymap compose-table)))
    62         ret))))
    63 
    64 ;; (with-open-file (file "/dev/input/event4")
    65 ;;   (let ((fd (sb-sys:fd-stream-fd file))
    66 ;;         (evbits))))
    67 
    68 ;; (xkb::xkb-consumed-mode :xkb)
    69 
    70 ;; (let ((dev (new-device-from-path "/dev/input/event4")))
    71 ;;   (unless (evdev::libevdev-has-event-code dev evdev::+ev-key+ evdev::+key-scrollup+)
    72 ;;     (println "probably not a mouse:"))
    73 ;;   (println
    74 ;;    (list 
    75 ;;     (evdev::libevdev-get-name dev) 
    76 ;;     (evdev::libevdev-get-id-bustype dev) 
    77 ;;     (evdev::libevdev-get-id-vendor dev)))
    78 ;;   (with-alien ((ev evdev/input:input-event))
    79 ;;     (when (evdev::libevdev-has-event-pending dev)
    80 ;;       (println "has event pending"))
    81 ;;     (assert (zerop (evdev::libevdev-next-event dev (evdev::libevdev-read-flag :normal) (addr ev))))
    82 ;;     (with-alien-slots ((* time) type (code evdev/input::code) (value evdev/input::value)) ev
    83 ;;       (println (obj/time:unix-to-timestamp (sb-posix::alien-timeval-sec time)))
    84 ;;       (println (evdev::libevdev-event-type-get-name type))
    85 ;;       (println (evdev::libevdev-event-code-get-name type code))
    86 ;;       (println (evdev::libevdev-event-value-get-name type code value)))))
    87