Linux Console Graphics with, [DRM], [GBM], [EGL], [GLES], [logind], [libinput], etc. in CL
I want glop2 to support running directly on Linux console without X or Wayland or whatever, and happened to want to run some code on an arm board with flaky X drivers, so spent some time trying to figure out how to get that running. This post is my notes on what I've figure out so far, for when I get around to actually implementing glop2.
The image I had on the arm board is Ubuntu, using systemd, so I use
logind to manage devices instead of opening them directly. This
simplifies some aspects of permissions, since if you are running on a
seat, you can automatically access any devices associated
seat. In other ways, it is more complicated, since if you
connect over ssh you don't have a
seat and can't access anything.
On other systems, would probably want to add the user to whatever
groups have access to the
devices, and open them manually.
Since I was too lazy to go find a keyboard to plug into the device to
control a seat, and also because I wanted to boot directly into the
program when it was done, I ended up configuring the
to login automatically (and tell systemd not to start X as well).
$ sudo systemctl disable lightdm $ sudo systemctl edit getty@tty1
[Service] ExecStart= ExecStart=-/sbin/agetty --autologin username --noclear %I
~/.profile to automatically run a lisp image running a
swank swank server when run on
tty1. Also send all output to a file
since we can't see console while running graphics, and can't scroll up
in console output without a keyboard.
tty=`ps -p $$ -o tty=` if [ "$tty" = tty1 ]; then ~/bin/foo > ~/debug-log 2>&1 fi
Then it boots I can just restart the
getty to restart the image when
I get things in a bad state, or want to see if my program works
correctly when started directly.
$ sudo systemctl restart getty@tty1
Getting access to the seat
Once the system is set up, the next step is talking to
logind to get
access to the seat, activate it, etc. For that, we need to use
used the dbus library. We'll also
need a few other libraries, so load all of those as well (or add them
to dependencies in an
.asd file and load that).
(ql:quickload '(:alexandria :cffi :osicat :dbus :cl-drm :cl-gbm :cl-egl :cl-libinput :cl-opengl/es2)) ;; Might need to manually download cl-libinput from ;; https://github.com/malcolmstill/cl-libinput if it isn't in QL yet. ;; Parts of this might also need my forks from https://github.com/3b/ ;; if I haven't gotten them cleaned up enuogh to submit upstream yet, or ;; from upstream sources if I have but they haven't hit QL yet. ;; Substitute normal :cl-opengl if desired if it is available on your ;; system.
For real use, would want to store a single
dbus connection, and
reuse the objects, but for interactive examples, lets define some
(defvar *bus*) (defmacro with-dbus (() &body body) `(dbus:with-open-bus (*bus* (dbus:system-server-addresses)) ,@body)) (defmacro with-object ((object call path destination) &body forms) `(let ((,object (dbus:make-object-from-introspection (dbus:bus-connection *bus*) ,path ,destination))) (flet ((,call (interface-name method-name &rest args) (apply #'dbus:object-invoke ,object interface-name method-name args))) ,@forms)))
Now we can make some calls and see if things are working:
(with-dbus () (with-object (o call "/org/freedesktop/login1" "org.freedesktop.login1") (call "org.freedesktop.login1.Manager" "ListSessions"))) ;; Here I have 2 SSH sessions open, with seat = "", and one console ;; session, "seat0" ;; session id, uid, username, seat name, session name (("4" 1001 "3b" "" "/org/freedesktop/login1/session/_34") ("14" 1001 "3b" "seat0" "/org/freedesktop/login1/session/_314") ("3" 1001 "3b" "" "/org/freedesktop/login1/session/_33")) (with-dbus () (with-object (o call "/org/freedesktop/login1" "org.freedesktop.login1") (call "org.freedesktop.login1.Manager" "ListSeats"))) ;; There is one seat (("seat0" "/org/freedesktop/login1/seat/seat0")) ;; but what we really want to know is which one we are currently using: (with-dbus () (with-introspected-object (o call "/org/freedesktop/login1" "org.freedesktop.login1") (call "org.freedesktop.login1.Manager" "GetSessionByPID" (nix:getpid)))) ;; -> "/org/freedesktop/login1/session/_314"
See https://www.freedesktop.org/software/systemd/man/org.freedesktop.login1.html for the full list of APIs available from logind.
Most of the rest will be using the
Session interfaces, so lets wrap that up into another macro.
(defmacro with-dbus* ((login lcall lprop session scall sprop) &body body) (alexandria:with-gensyms (session-name) `(dbus:with-open-bus (*bus* (dbus:system-server-addresses)) (let ((,login (dbus:make-object-from-introspection (dbus:bus-connection *bus*) "/org/freedesktop/login1" "org.freedesktop.login1"))) (flet ((,lcall (interface-name method-name &rest args) (apply #'dbus:object-invoke ,login interface-name method-name args)) (,lprop (property) (dbus:get-property *bus* "org.freedesktop.login1" "/org/freedesktop/login1" "org.freedesktop.login1.Manager" property))) (declare (ignorable #',lcall #',lprop)) (let* ((,session-name (,lcall "org.freedesktop.login1.Manager" "GetSessionByPID" (nix:getpid))) (,session (dbus:make-object-from-introspection (dbus:bus-connection *bus*) ,session-name "org.freedesktop.login1"))) (flet ((,scall (method-name &rest args) (apply #'dbus:object-invoke ,session "org.freedesktop.login1.Session" method-name args)) (,sprop (property) (dbus:get-property *bus* "org.freedesktop.login1" ,session-name "org.freedesktop.login1.Session" property))) (declare (ignorable #',scall #',sprop)) ,@body)))))))
Add one more helper to translate paths to the major + minor device numbers logind wants, and we are ready to start doing graphics.
(defun path-device (path) ;; return device major/minor for a given path (let ((rdev (nix:stat-rdev (nix:stat path)))) (assert (not (zerop rdev))) (list (ldb (byte 8 8) rdev) (ldb (byte 8 0) rdev)))) (defmacro with-card ((fd) &body body) ;; not bothering with gensyms here since we might want access to the ;; various bindings created here, and real code would probably be ;; factored out differently instead of using a macro like this `(with-dbus* (l lc lp s sc sp) ;; first we need to take control of the session (sc "TakeControl" nil) ;; then open the DRI device. Currently I just hard-code ;; "/dev/dri/card0", not sure what the "correct" way to find it is ;; yet. Possibly looking for "/run/udev/tags/<seat>/+drm*" and ;; parsing the name? (where <seat> is "seat" for seat0, otherwise ;; name of seat?) Maybe something with libudev? (unwind-protect (multiple-value-bind (,fd paused) (apply #'sc "TakeDevice" (path-device "/dev/dri/card0")) (when ,fd (unwind-protect (progn ;; if the session is paused, we can try activating it (when paused (sc "Activate")) ,@body)) ;; Releasing the session below implicitly releases ;; devices, but we can do it manually too (apply #'sc "ReleaseDevice" (path-device "/dev/dri/card0")) ;; but apparently we still need to close the FD ;; ourselves (don't see it mentioned in logind docs, ;; aside from needing to close old fd after Resume ;; events, but FDs stay open without it) (nix:close fd))) ;; when we are done, we need to release the session (sc "ReleaseControl")))) (with-card (fd) (format t "got FD ~s for DRM device~%" fd))
For real code we should also watch for DBUS events indicating devices have been Paused/Resumed, screen has been Locked/Unlocked, changes in session Active or Idle state, or if the system is shutting down or sleeping.
Once we have a DRM fd open, we can use it to switch to graphics mode and set up OpenGL ES (or normal GL if you have it).
We can query some capabilities with
(cffi:defcenum (drm-caps :uint64) (:dumb-buffer #x1) (:vblank-high-crtc #x2) (:dumb-preferred-depth #x3) (:dumb-prefer-shadow #x4) (:prime #x5) (:timestamp-monotonic #x6) (:async-page-flip #x7) ;;;; on my machine: ;;caps: ;; :DUMB-BUFFER = 1 ;; :VBLANK-HIGH-CRTC = 1 ;; :DUMB-PREFERRED-DEPTH = 0 ;; :DUMB-PREFER-SHADOW = 0 ;; :PRIME = 3 ;; :TIMESTAMP-MONOTONIC = 1 ;; :ASYNC-PAGE-FLIP = 0 ;; :CURSOR-WIDTH = 64 ;; :CURSOR-HEIGHT = 64 ;; :ADDFB2-MODIFIERS = 0 ;; :PAGE-FLIP-TARGET = 0 ;;
In particular the
:async-page-flip = 0 here means we need to use
event-based page flipping rather than asynchronous.
Now we set up the various graphics libraries (drm, gbm, egl), handle page flipping, and then we can do some simple drawing.
;;; for double-buffered display wwith vsync, we need to set up some ;;; handlers for drm events (cffi:defcallback vblank-handler :void ((fd :int) (seq :unsigned-int) (sec :unsigned-int) (usec :unsigned-int) (user-data (:pointer :void))) (declare (ignorable fd seq sec usec user-data)) ;; vblank event seems not be sent by default, not sure how to enable ;; them ) (defparameter *flipping* nil) (cffi:defcallback page-flip-handler :void ((fd :int) (seq :unsigned-int) (sec :unsigned-int) (usec :unsigned-int) (user-data (:pointer :void))) (declare (ignorable fd seq sec usec user-data)) (setf *flipping* nil)) (defun make-drm-event-context () (let ((p (cffi:foreign-alloc '(:struct drm:event-context)))) (cffi:with-foreign-slots ((drm:version drm:vblank-handler drm:page-flip-handler) p (:struct drm:event-context)) (setf drm:version 2) (setf drm:vblank-handler (cffi:callback vblank-handler)) (setf drm:page-flip-handler (cffi:callback page-flip-handler))) p)) (with-card (fd) ;; drm:find-display-configuration picks a connector and mode for us, ;; which is good enough for my current needs. If you want to support ;; multiple monitors or change modes you might need to do it ;; yourself. (let* ((display-config (drm:find-display-configuration fd)) ;; some slots from the display-config we will need later (mode-info (drm:mode-info display-config)) (crtc (drm:crtc display-config)) ;; To do any output, we need buffers in which to store it, ;; and from which the card can display them. libgbm (Generic ;; Buffer Management) is responsible for managing those ;; buffers, so we need to initialize it as well. (gbm (gbm:create-device fd)) ;; get an EGL display from the GBM device ;; (get-platform-display is in egl 1.5, but my board only has ;; 1.4. Should query versions and check extensions before ;; doing this...) (display (egl:get-platform-display-ext :platform-gbm-khr gbm (cffi:null-pointer)))) ;; initialize EGL on the display (returns major / minor version ;; numbers as 2 values) (format t "egl init ~s~%" (multiple-value-list (egl:initialize display))) ;; tell EGL which API we want to use, :opengl-api for desktop GL (egl:bind-api :opengl-es-api) ;; and verify we got it (format t "egl api ~s~%" (egl:query-api)) ;; print out some information on available APIs, driver being ;; used, and available extensions (loop for i in '(:client-apis :vendor :version :extensions) do (format t "~s: ~s~%" i (egl:query-string display i))) ;; set up a gles context (let* ((configs (egl::choose-config* display :buffer-size 32 :depth-size :dont-care :stencil-size :dont-care :surface-type :window-bit :renderable-type :opengl-es2-bit :none)) ;; we'll just use the first one here (config (car configs)) ;; create a context, ask for GLES2 (context (egl:create-context display config (cffi:null-pointer) :context-major-version 2 :none)) ;; get dimensions of the mode (width (drm:mode-width mode-info)) (height (drm:mode-height mode-info)) ;; create a GBM surface we can draw into (gbm-surface (gbm:surface-create gbm width height 875713112 ;; xrgb8888 5)) ;; scanout | rendering ;; create an egl surface from the gbm surface (egl-surface (egl:create-window-surface display config gbm-surface :none)) ;; configuration for drm event handler (event-context (make-drm-event-context)) ;; page flipping code is a bit verbose, so we'll store some ;; state in a list to pass to it. Should all be in proper ;; classes or whatever for real code (flip-state (list nil nil ;; some state variables event-context fd display egl-surface gbm-surface crtc width height))) ;; see what configs are available (loop for i from 0 for c in configs do (format t "~%egl config ~s:~% ~s~%" i (egl:get-config-attribs display c))) ;; print some info about the EGL surface we created (format t "~%~%EGL surface properties:~%") (loop for i in '(:width :height :horizontal-resolution :vertical-resolution :render-buffer :swap-behavior) do (format t " ~s = ~s~%" i (egl:query-surface display egl-surface i))) ;; make the egl context current (unless (zerop (egl:make-current display ;; we will read from and draw ;; to same surface egl-surface egl-surface context))) ;; reset the page flip flag (setf *flipping* nil) ;; now we should be able to start drawing. Since gles2 requires ;; VBOs and shaders, we'll just clear the screen to random ;; colors for a few second... (loop repeat 3000 do (gl:clear-color (random 1.0) (random 1.0) (random 1.0) 1) (gl:clear :color-buffer) (swap-buffers flip-state)) ;; when we are done, clean everything up (should probably use a ;; few unwind-protects here) (when crtc ;; restore the original crtc settings (cffi:with-foreign-object (connector-id :uint32) (setf (cffi:mem-ref connector-id :uint32) (drm::connector-id display-config)) (cffi:with-foreign-slots ((drm:crtc-id drm:buffer-id drm:x drm:y) crtc (:struct drm:mode-crtc)) (drm:mode-set-crtc fd drm:crtc-id drm:buffer-id drm:x drm:y connector-id 1 (cffi:foreign-slot-pointer crtc '(:struct drm:mode-crtc) 'drm:mode)) (drm:mode-free-crtc crtc)))) ;; clean up buffers used for page flipping (when (car flip-state) (drm:mode-remove-framebuffer fd (first flip-state)) (gbm:surface-release-buffer gbm-surface (second flip-state))) ;; destroy surfaces (egl:destroy-surface display egl-surface) (gbm:surface-destroy gbm-surface) ;; destroy context (egl:destroy-context display context) ;; close display (egl:terminate display) ;; close gbm device (gbm:device-destroy gbm) ;; free event-context (cffi:foreign-free event-context)))) (defun swap-buffers (flip-state) (destructuring-bind (old-fb old-bo event-context fd display egl-surface gbm-surface crtc width height) flip-state ;; if we have scheduled a page flip, wait for the completion ;; event. Real code should use select/poll/epoll/etc to wait for ;; the FD to be readable instead of busy-waiting like this. (loop do (drm:handle-event fd event-context) while *flipping* do (sleep 0.001)) ;; first swap the EGL buffers (egl:swap-buffers display egl-surface) ;; call surface-lock-front-buffer once per egl:swap-buffers to get ;; a gbm `bo` (buffer object) for the front buffer (let* ((bo (gbm:surface-lock-front-buffer gbm-surface)) ;; get some slots from the BO we will be using later (handle (gbm:bo-get-handle bo)) (stride (gbm:bo-get-stride bo))) (cffi:with-foreign-objects ((fb :uint32)) ;; create a framebuffer using the bo associated with HANDLE for ;; storage (drm:mode-add-framebuffer fd width height 24 32 stride handle fb) ;; set flag indicating we scheduled a page flip (setf *flipping* t) ;; schedule a page flip for next vblank to display the new ;; framebuffer, and request and event when the flip completes ;; if we wanted double-buffer without vsync, we could use ;; drm:mode-set-crtc instead to swap immediately. Probably can ;; also configure it to draw directly to a single framebuffer ;; for single-buffered display. (drm:mode-page-flip fd (drm:crtc-crtc-id crtc) (cffi:mem-aref fb :uint32) 1 ;; 1 = event, 2 = async (cffi:null-pointer)) ;; after the first frame, we need to clean up the previous ;; frame (when old-bo (drm:mode-remove-framebuffer fd old-fb) (gbm:surface-release-buffer gbm-surface old-bo)) ;; write state back into input list for next call (setf (first flip-state) (cffi:mem-ref fb :uint32) (second flip-state) bo)))))
Similar to the
logind events, we should also be watching for lost
contexts, etc in the graphics code.