This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

Recipes

The examples assume this package:

(asdf:load-system :cl-wl/xdg-shell)

(defpackage #:recipes
  (:use #:cl #:cl-wl/wayland #:cl-wl/xdg-shell)
  (:local-nicknames (#:wl #:cl-wl)))
(in-package #:recipes)

and make-shm-buffer from Getting Started. Functions such as redraw and handle-pointer-frame stand for your own code.

Shared-memory buffers

A shared-memory is a block of memory both the client and the compositor map. Pools are cut from it, and buffers from pools:

(wl:with-shared-memory (memory (* 4 width height))
  (wl:write-shared-memory memory pixels)   ; (simple-array (unsigned-byte 32) (*))
  (let* ((pool (wl-shm-create-pool shm (wl:shared-memory-fd memory)
                                   (wl:shared-memory-size memory)))
         (buffer (wl-shm-pool-create-buffer pool 0 width height (* 4 width) :xrgb8888)))
    (wl-shm-pool-destroy pool)
    (wl:set-event-handlers buffer :release #'wl:destroy-proxy)
    (wl-surface-attach surface buffer 0 0)
    (wl-surface-damage-buffer surface 0 0 width height)
    (wl-surface-commit surface)))

• write-shared-memory copies a simple vector of octets or of 32-bit pixels, at an :offset in bytes. Pixels are written in the machine's byte order, which is what :xrgb8888 and :argb8888 expect. It allocates nothing, so it may run every frame.
• shared-memory-pointer is the escape hatch for drawing straight into the memory.
• resize-shared-memory grows the memory for wl-shm-pool-resize.
• The compositor keeps its own mapping, so the memory may be destroyed once the pool and buffers exist. To draw again into the same memory, keep it, and wait for each buffer's :release before writing to the part that buffer uses.
• Every compositor supports :argb8888 and :xrgb8888.

Frame callbacks

wl-surface-frame asks the compositor to say when it is a good time to draw the next frame. The :done event arrives at most once per display refresh, and not at all while the surface is hidden. Drawing from the callback paces the program to the display and stops it drawing while it cannot be seen.

(defun draw (surface shm)
  (let ((buffer (make-shm-buffer shm 200 200)))
    (wl:set-event-handlers buffer :release #'wl:destroy-proxy)
    ;; Ask for the next frame before committing this one.  :done ends the
    ;; callback, so cl-wl destroys it after the handler.
    (wl:set-event-handlers (wl-surface-frame surface)
      :done (lambda (callback time)
              (declare (ignore callback time))   ; TIME is in milliseconds
              (draw surface shm)))
    (wl-surface-attach surface buffer 0 0)
    (wl-surface-damage-buffer surface 0 0 200 200)
    (wl-surface-commit surface)))

Start the chain once, from the first xdg_surface :configure. A compositor may configure several times before the first frame, so keep a flag:

(let ((drawing nil))
  (wl:set-event-handlers xdg-surface
    :configure (lambda (xdg-surface serial)
                 (xdg-surface-ack-configure xdg-surface serial)
                 (unless drawing
                   (setf drawing t)
                   (draw surface shm)))))

Then run (wl:dispatch display) in a loop. Each :done draws the next frame.

Seats and their devices

A seat's capabilities say which devices it has, and they can change while the program runs, as when a keyboard is plugged in. Get the devices when a capability appears and destroy them when it disappears:

(defun watch-seat (display)
  (let ((seat (wl:bind display 'wl-seat :version 7))
        (pointer nil)
        (keyboard nil))
    (wl:set-event-handlers seat
      :capabilities
      (lambda (seat capabilities)
        (cond ((and (member :pointer capabilities) (null pointer))
               (setf pointer (wl-seat-get-pointer seat))
               (watch-pointer pointer))
              ((and pointer (not (member :pointer capabilities)))
               (wl:destroy-proxy pointer)
               (setf pointer nil)))
        (cond ((and (member :keyboard capabilities) (null keyboard))
               (setf keyboard (wl-seat-get-keyboard seat))
               (watch-keyboard keyboard *xkb-context*))
              ((and keyboard (not (member :keyboard capabilities)))
               (wl:destroy-proxy keyboard)
               (setf keyboard nil)))))
    (wl:roundtrip display)
    seat))

destroy-proxy sends wl_pointer.release and wl_keyboard.release where the device's version has them (3 and later), and destroys older ones on the client side only.

Pointer input

From version 5, pointer events come in groups ended by :frame. Collect them, then act once per frame:

(defvar *pointer* (list :x 0.0 :y 0.0 :buttons '() :scroll 0.0))

(defun watch-pointer (pointer)
  (wl:set-event-handlers pointer
    :enter (lambda (pointer serial surface x y)
             (declare (ignore surface))
             ;; Hide the cursor over our surface.  A null surface is allowed here.
             (wl-pointer-set-cursor pointer serial nil 0 0)
             (setf (getf *pointer* :x) x (getf *pointer* :y) y))
    :motion (lambda (pointer time x y)
              (declare (ignore pointer time))
              (setf (getf *pointer* :x) x (getf *pointer* :y) y))
    :button (lambda (pointer serial time button state)
              (declare (ignore pointer serial time))
              ;; BUTTON is a Linux input code: #x110 is BTN_LEFT.
              (if (eq state :pressed)
                  (pushnew button (getf *pointer* :buttons))
                  (setf (getf *pointer* :buttons)
                        (remove button (getf *pointer* :buttons)))))
    :axis (lambda (pointer time axis value)
            (declare (ignore pointer time))
            (when (eq axis :vertical-scroll)
              (incf (getf *pointer* :scroll) value)))
    :frame (lambda (pointer)
             (declare (ignore pointer))
             (handle-pointer-frame *pointer*))))

Coordinates are surface-local single-floats. The serial of :enter and :button events is what wl-pointer-set-cursor, xdg-toplevel-move and xdg-toplevel-resize ask for.

Interactive move and resize:

(xdg-toplevel-move toplevel seat serial)                    ; drag the window
(xdg-toplevel-resize toplevel seat serial :bottom-right)    ; resize from a corner

Keyboard input with cl-xkbcommon

The compositor sends the keymap as an fd and keys as evdev codes. read-keymap turns the fd into the keymap's text and closes it, and cl-xkbcommon turns keys into text:

(asdf:load-system :cl-xkbcommon)

(defvar *xkb-context* (cl-xkbcommon:make-context))
(defvar *repeat* nil "The compositor's key repeat (RATE DELAY), or NIL.")

(defun watch-keyboard (keyboard context)
  (let ((keymap nil)
        (state nil))
    (wl:set-event-handlers keyboard
      :keymap (lambda (keyboard format fd size)
                (declare (ignore keyboard))
                (if (eq format :xkb-v1)
                    (setf keymap (cl-xkbcommon:make-keymap-from-string
                                  context (wl:read-keymap fd size))
                          state (cl-xkbcommon:make-keyboard-state keymap))
                    ;; No keymap: the fd is ours to close all the same.
                    (wl:close-fd fd)))
      :modifiers (lambda (keyboard serial depressed latched locked group)
                   (declare (ignore keyboard serial))
                   (cl-xkbcommon:update-modifiers state depressed latched locked group))
      :key (lambda (keyboard serial time key key-state)
             (declare (ignore keyboard serial time))
             ;; Wayland keycodes are evdev codes; XKB's are 8 higher.
             (when (eq key-state :pressed)
               (let ((text (cl-xkbcommon:key-text state (+ key 8))))
                 (when text (format t "~A" text)))))
      :repeat-info (lambda (keyboard rate delay)   ; version 4 and later
                     (declare (ignore keyboard))
                     (setf *repeat* (list rate delay))))))

Key repeat is the client's job. The compositor sends one :pressed, and :repeat-info gives the rate (keys per second) and delay (milliseconds). For compose sequences and dead keys, use cl-xkbcommon's key-press-text with a compose state. Since cl-xkbcommon's keyboard state follows the compositor's modifiers, do not call update-key as well. Destroy the keymap and state when the keyboard goes.

Outputs and scale

On a high-density display the compositor wants buffers drawn at a scale. A wl_surface of version 6 or newer says which scale it prefers:

(defvar *scale* 1)

(let ((surface (wl-compositor-create-surface compositor)))   ; compositor bound at version ≥ 6
  (wl:set-event-handlers surface
    :preferred-buffer-scale (lambda (surface factor)
                              (setf *scale* factor)
                              (wl-surface-set-buffer-scale surface factor)
                              (redraw))))

Draw the buffer at factor times the logical size and call wl-surface-set-buffer-scale before committing it.

With older compositors you have to follow the outputs. Take the largest :scale among the outputs the surface has :entered. Bind the outputs with follow-globals so that monitors plugged in later are seen too:

(defvar *output-scales* (make-hash-table))

(wl:follow-globals display 'wl-output
  :version 4
  :added (lambda (output)
           (let ((scale 1))
             (wl:set-event-handlers output
               :scale (lambda (output factor)
                        (declare (ignore output))
                        (setf scale factor))
               ;; Changes to an output's properties end with :done.
               :done (lambda (output)
                       (setf (gethash output *output-scales*) scale)))))
  :removed (lambda (output)
             (remhash output *output-scales*)
             (wl:destroy-proxy output)))

Fractional scale

When the compositor offers wp_fractional_scale_manager_v1 and wp_viewporter, it can ask for scales such as 1.25 or 1.5. You draw at the scaled size and tell the viewport the logical size:

(asdf:load-system :cl-wl/viewporter)
(asdf:load-system :cl-wl/fractional-scale)

(let* ((viewporter (wl:bind display 'cl-wl/viewporter:wp-viewporter :errorp nil))
       (manager (wl:bind display 'cl-wl/fractional-scale:wp-fractional-scale-manager-v1
                         :errorp nil)))
  (when (and viewporter manager)
    (let ((viewport (cl-wl/viewporter:wp-viewporter-get-viewport viewporter surface))
          (scale (cl-wl/fractional-scale:wp-fractional-scale-manager-v1-get-fractional-scale
                  manager surface)))
      (wl:set-event-handlers scale
        :preferred-scale (lambda (scale numerator)
                           (declare (ignore scale))
                           ;; In 120ths: 180 is 1.5.
                           (setf *scale* (/ numerator 120))
                           (redraw)))
      ;; For each frame: a buffer of (ceiling (* width *scale*)) × (ceiling (* height *scale*)),
      ;; buffer scale left at 1, and
      (cl-wl/viewporter:wp-viewport-set-destination viewport width height))))

Server-side decorations

xdg-shell windows have no title bar unless someone draws one. Many compositors will draw it for you if you ask:

(asdf:load-system :cl-wl/xdg-decoration)

(defvar *decorations* nil)

(let ((manager (wl:bind display 'cl-wl/xdg-decoration:zxdg-decoration-manager-v1
                        :errorp nil)))
  (when manager
    (let ((decoration (cl-wl/xdg-decoration:zxdg-decoration-manager-v1-get-toplevel-decoration
                       manager toplevel)))
      (wl:set-event-handlers decoration
        :configure (lambda (decoration mode)
                     (declare (ignore decoration))
                     ;; :SERVER-SIDE, or :CLIENT-SIDE if we must draw it ourselves.
                     (setf *decorations* mode)))
      (cl-wl/xdg-decoration:zxdg-toplevel-decoration-v1-set-mode decoration :server-side))))

Create the decoration object before the toplevel's first commit. The compositor has the final word, and its answer arrives as :configure. Some compositors offer no decoration manager, among them GNOME and WSLg's Weston, so :errorp nil returns NIL there.

The clipboard

The clipboard is a seat's: its wl_data_device says what is on it. The compositor announces each offer of data with :data-offer, then the offer's MIME types with the offer's :offer events, then which offer is on the clipboard with :selection, which is nil when the clipboard is empty:

(defun follow-clipboard (manager seat)
  "Follow the clipboard of SEAT.  Return the seat's data device, and a
function of no arguments that returns the offer on the clipboard and its
MIME types, or NIL."
  (let ((device (wl-data-device-manager-get-data-device manager seat))
        (types (make-hash-table))       ; offer -> its MIME types
        (selection nil))
    (wl:set-event-handlers
     device
     :data-offer (lambda (device offer)
                   (declare (ignore device))
                   (setf (gethash offer types) '())
                   (wl:set-event-handlers offer
                                          :offer (lambda (offer type)
                                                   (push type (gethash offer types)))))
     :selection (lambda (device offer)
                  (declare (ignore device))
                  (when (and selection (not (eq selection offer)))
                    (remhash selection types)
                    (wl:destroy-proxy selection))
                  (setf selection offer)))
    (values device
            (lambda () (and selection (values selection (gethash selection types)))))))

Drag and drop announces its offers with :data-offer too, then with :enter; a program that takes drops follows those as well.

To read the clipboard's text, pass the write end of a pipe to the offer, and read the text from the read end. The other client writes it while it dispatches its events:

(defun clipboard-text (display offer &key (timeout 1))
  "Return the text OFFER holds, or NIL if it gives none within TIMEOUT."
  (multiple-value-bind (in out) (wl:make-pipe)
    (wl-data-offer-receive offer "text/plain;charset=utf-8" out)
    (wl:flush display)
    (wl:close-fd out)                    ; the other client has its own copy
    (wl:receive-text in :timeout timeout)))

Ask only for a MIME type the offer has. Do not read an offer of your own client this way: it is sent only while your client dispatches events, so keep the text you offered and return that.

To put text on the clipboard, offer it from a data source, and write it into the pipe each :send event brings:

(defun offer-text (manager device text serial)
  "Put TEXT on the clipboard of DEVICE's seat.  SERIAL is that of the input
event the user asked with, such as the key press of Control+C."
  (let ((source (wl-data-device-manager-create-data-source manager)))
    (wl-data-source-offer source "text/plain;charset=utf-8")
    (wl:set-event-handlers source
                           :send (lambda (source type fd)
                                   (declare (ignore source type))
                                   (wl:send-text fd text :timeout 1))
                           ;; Something else is on the clipboard now.
                           :cancelled (lambda (source)
                                        (wl:destroy-proxy source)))
    (wl-data-device-set-selection device source serial)
    source))

The compositor takes a selection only in answer to the user: from a client whose surface has the keyboard focus, with the serial of a recent input event. Offer "text/plain" and "UTF8_STRING" too, for older clients. A reader that never reads cannot hold up the :send handler: send-text gives up after its timeout. cl-windowing's Wayland backend does all of this for its clipboard.

Cursors

See Cursors: by name through cursor-shape-v1, or from the user's cursor theme.

A Vulkan surface

vkCreateWaylandSurfaceKHR needs the raw wl_display and wl_surface. proxy-pointer is the escape hatch for that:

(let ((display-pointer (wl:proxy-pointer display))   ; struct wl_display *
      (surface-pointer (wl:proxy-pointer surface)))  ; struct wl_proxy *, a wl_surface
  ;; Fill VkWaylandSurfaceCreateInfoKHR's display and surface with them.
  …)

The pointers stay valid until the proxy is destroyed or the display is disconnected. Destroy the Vulkan surface first.

With Vulkan, you still handle xdg_surface :configure and frame callbacks as above, but you do not attach buffers yourself.

Shutting down cleanly

Destroy objects children first, then disconnect:

(dolist (object (list toplevel xdg-surface surface wm-base))
  (wl:destroy-proxy object))
(wl:disconnect display)          ; or leave WITH-DISPLAY

destroy-proxy sends each object's destructor request where its version has one. disconnect destroys every proxy that is still alive on the client side. Explicit destruction is still better, because it tells the compositor at once. If the connection has failed, destruction still destroys the proxies, and nothing is sent. See Errors.

An event thread

See Event Loops.