rickub
Sign in Get started
nandi/jolt-nativepublic⑂ Fork 0
⑂ 1d16366
Branches
main View all branches → View all tags →
Commits
⬇ Clone ▾
git clone https://git.rickub.com/nandi/jolt-native.git
git clone ssh://git@rickub.com/nandi/jolt-native.git

Host key fingerprint (ed25519): SHA256:iycHnxEyq0Q7uyVpB7JlznP0G7JrTPXLYRcAU5CSLhc — verify it before your first connect.

wayland-bar-compositor: a wlroots compositor in jolt, for panels on X11

Moved from wayland-bar. It hosts layer-shell and xdg-shell clients on one
wlroots X11 output, forwards input, shapes its own window to the bar strip
plus the traced outline of mapped popups, and closes popups on X11 clicks.
Struct offsets come from offsets.edn, generated by ./build from the
installed wlroots headers.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
nandi committed 2026-09-10T20:47:41-07:00 Browse files
1d16366 parent: b48e404
modified README.md +1 -0
@@ -18,6 +18,7 @@ crates/jolt-moq freeq's AV media plane → libjoltmoq.so
1818 glimmer-backends/glimmer-vidya the jolt side of libvidya: glimmer's backend
1919 jvui no .so at all: dvui's shape, in jolt, on SDL3
2020 glimmer-backends/glimmer-jvui glimmer's backend over jvui
21+wayland-bar-compositor no .so either: a wlroots compositor in jolt, for panels on X11
2122 ```
2223
2324 All three objects land in one `target/release`, so a consumer points
@@ -18,6 +18,7 @@ crates/jolt-moq freeq's AV media plane → libjoltmoq.so
18 glimmer-backends/glimmer-vidya the jolt side of libvidya: glimmer's backend18 glimmer-backends/glimmer-vidya the jolt side of libvidya: glimmer's backend
19 jvui no .so at all: dvui's shape, in jolt, on SDL319 jvui no .so at all: dvui's shape, in jolt, on SDL3
20 glimmer-backends/glimmer-jvui glimmer's backend over jvui20 glimmer-backends/glimmer-jvui glimmer's backend over jvui
21+wayland-bar-compositor no .so either: a wlroots compositor in jolt, for panels on X11
21 ```22 ```
22 23
23 All three objects land in one `target/release`, so a consumer points24 All three objects land in one `target/release`, so a consumer points
added wayland-bar-compositor/README.md +46 -0
new file mode 100644
@@ -0,0 +1,46 @@
1+# wayland-bar-compositor
2+
3+A Wayland compositor written in jolt directly on wlroots, for putting a Wayland
4+panel (such as `cosmic-panel`) onto an X11 desktop.
5+
6+There is no shared object here: `jolt.ffi` binds libwlroots, libwayland-server,
7+libxkbcommon, libX11, libXext and libXi directly. The compositor opens one
8+wlroots X11 output, draws layer-shell and xdg-shell clients through the wlroots
9+scene graph, and forwards pointer and keyboard input to them.
10+
11+Because it owns the scene, it shapes its own X11 window: the bar strip plus
12+the outline of whatever popups are mapped, traced from the rendered frame so
13+rounded corners show the desktop behind them. XInput2 raw button presses on the
14+root window let a click on an X11 app close open popups.
15+
16+ wayland-bar-compositor the compositor
17+ build generates offsets.edn from the installed headers
18+ gen-offsets.c the offsetof dump build compiles
19+ offsets.edn wlroots struct layout facts, read at startup
20+ protocol/ wlr-layer-shell XML for the header wlroots omits
21+
22+## Running
23+
24+```bash
25+./build # after any wlroots update
26+WLR_BACKENDS=x11 WLR_RENDERER=pixman \
27+ ./wayland-bar-compositor --size 1920x640 --strip 0,0,1920,40 --title my-bar -- cosmic-panel
28+```
29+
30+`--size` is the whole output, bar plus room for popups; `--strip` is the part
31+always shown; `--title` names the X11 window so a launcher can find it and dock
32+it (`_NET_WM_WINDOW_TYPE_DOCK` plus a strut). Set `WBC_DEBUG=1` to log input,
33+popups and shape changes.
34+
35+## Why a compositor in jolt works
36+
37+Every wlroots listener shares one native callback that dispatches on the
38+listener's address, and listeners come from a free list, so surfaces that come
39+and go don't leak callbacks. The event loop is `wl_event_loop_dispatch` called
40+from jolt's own thread, so every callback arrives on that thread — nothing
41+blocks the collector. wlroots changes struct layouts between minor versions,
42+which is why the offsets are generated from the headers rather than written by
43+hand.
44+
45+Written for wlroots 0.20 on x86_64. On a native Wayland desktop — COSMIC with
46+cosmic-comp, for one — none of this is needed: the panel runs directly.
new file mode 100644
@@ -0,0 +1,46 @@
1+# wayland-bar-compositor
2+
3+A Wayland compositor written in jolt directly on wlroots, for putting a Wayland
4+panel (such as `cosmic-panel`) onto an X11 desktop.
5+
6+There is no shared object here: `jolt.ffi` binds libwlroots, libwayland-server,
7+libxkbcommon, libX11, libXext and libXi directly. The compositor opens one
8+wlroots X11 output, draws layer-shell and xdg-shell clients through the wlroots
9+scene graph, and forwards pointer and keyboard input to them.
10+
11+Because it owns the scene, it shapes its own X11 window: the bar strip plus
12+the outline of whatever popups are mapped, traced from the rendered frame so
13+rounded corners show the desktop behind them. XInput2 raw button presses on the
14+root window let a click on an X11 app close open popups.
15+
16+ wayland-bar-compositor the compositor
17+ build generates offsets.edn from the installed headers
18+ gen-offsets.c the offsetof dump build compiles
19+ offsets.edn wlroots struct layout facts, read at startup
20+ protocol/ wlr-layer-shell XML for the header wlroots omits
21+
22+## Running
23+
24+```bash
25+./build # after any wlroots update
26+WLR_BACKENDS=x11 WLR_RENDERER=pixman \
27+ ./wayland-bar-compositor --size 1920x640 --strip 0,0,1920,40 --title my-bar -- cosmic-panel
28+```
29+
30+`--size` is the whole output, bar plus room for popups; `--strip` is the part
31+always shown; `--title` names the X11 window so a launcher can find it and dock
32+it (`_NET_WM_WINDOW_TYPE_DOCK` plus a strut). Set `WBC_DEBUG=1` to log input,
33+popups and shape changes.
34+
35+## Why a compositor in jolt works
36+
37+Every wlroots listener shares one native callback that dispatches on the
38+listener's address, and listeners come from a free list, so surfaces that come
39+and go don't leak callbacks. The event loop is `wl_event_loop_dispatch` called
40+from jolt's own thread, so every callback arrives on that thread — nothing
41+blocks the collector. wlroots changes struct layouts between minor versions,
42+which is why the offsets are generated from the headers rather than written by
43+hand.
44+
45+Written for wlroots 0.20 on x86_64. On a native Wayland desktop — COSMIC with
46+cosmic-comp, for one — none of this is needed: the panel runs directly.
added wayland-bar-compositor/build +27 -0
new file mode 100755
@@ -0,0 +1,27 @@
1+#!/usr/bin/env jolt
2+;; Generate offsets.edn: the wlroots struct layout facts wayland-bar-compositor
3+;; reads at startup. Rerun after a wlroots update.
4+
5+(require '[babashka.process :as p]
6+ '[babashka.fs :as fs]
7+ '[clojure.string :as str])
8+
9+(def here (str (fs/parent (fs/canonicalize *file*))))
10+(def out (str here "/build-out"))
11+(fs/create-dirs out)
12+
13+(defn run [& cmd]
14+ (apply p/shell {:out :inherit :err :inherit} cmd))
15+
16+;; wlroots' public layer-shell header includes a protocol header it doesn't install.
17+(run "wayland-scanner" "server-header"
18+ (str here "/protocol/wlr-layer-shell-unstable-v1.xml")
19+ (str out "/wlr-layer-shell-unstable-v1-protocol.h"))
20+
21+(def cflags (-> (p/sh "pkg-config" "--cflags" "wlroots-0.20" "wayland-server" "pixman-1" "xkbcommon") :out str/trim))
22+
23+(apply run (concat ["cc" "-o" (str out "/gen-offsets") (str here "/gen-offsets.c") (str "-I" out)]
24+ (str/split cflags #"\s+")))
25+
26+(spit (str here "/offsets.edn") (:out (p/sh (str out "/gen-offsets"))))
27+(println "wrote" (str here "/offsets.edn"))
new file mode 100755
@@ -0,0 +1,27 @@
1+#!/usr/bin/env jolt
2+;; Generate offsets.edn: the wlroots struct layout facts wayland-bar-compositor
3+;; reads at startup. Rerun after a wlroots update.
4+
5+(require '[babashka.process :as p]
6+ '[babashka.fs :as fs]
7+ '[clojure.string :as str])
8+
9+(def here (str (fs/parent (fs/canonicalize *file*))))
10+(def out (str here "/build-out"))
11+(fs/create-dirs out)
12+
13+(defn run [& cmd]
14+ (apply p/shell {:out :inherit :err :inherit} cmd))
15+
16+;; wlroots' public layer-shell header includes a protocol header it doesn't install.
17+(run "wayland-scanner" "server-header"
18+ (str here "/protocol/wlr-layer-shell-unstable-v1.xml")
19+ (str out "/wlr-layer-shell-unstable-v1-protocol.h"))
20+
21+(def cflags (-> (p/sh "pkg-config" "--cflags" "wlroots-0.20" "wayland-server" "pixman-1" "xkbcommon") :out str/trim))
22+
23+(apply run (concat ["cc" "-o" (str out "/gen-offsets") (str here "/gen-offsets.c") (str "-I" out)]
24+ (str/split cflags #"\s+")))
25+
26+(spit (str here "/offsets.edn") (:out (p/sh (str out "/gen-offsets"))))
27+(println "wrote" (str here "/offsets.edn"))
added wayland-bar-compositor/gen-offsets.c +115 -0
new file mode 100644
@@ -0,0 +1,115 @@
1+/*
2+ * Prints the wlroots struct layout facts the jolt compositor needs, as EDN.
3+ * wlroots changes struct layouts between minor versions, so these are read
4+ * from the installed headers rather than written down by hand.
5+ *
6+ * cc -o gen-offsets gen-offsets.c $(pkg-config --cflags wlroots-0.20 wayland-server pixman-1 xkbcommon)
7+ * ./gen-offsets > offsets.edn
8+ */
9+#define WLR_USE_UNSTABLE
10+#include <stdio.h>
11+#include <stddef.h>
12+#include <time.h>
13+#include <wayland-server-core.h>
14+#include <wlr/backend.h>
15+#include <wlr/types/wlr_buffer.h>
16+#include <wlr/types/wlr_cursor.h>
17+#include <wlr/types/wlr_input_device.h>
18+#include <wlr/types/wlr_keyboard.h>
19+#include <wlr/types/wlr_layer_shell_v1.h>
20+#include <wlr/types/wlr_output.h>
21+#include <wlr/types/wlr_pointer.h>
22+#include <wlr/types/wlr_scene.h>
23+#include <wlr/types/wlr_seat.h>
24+#include <wlr/types/wlr_xdg_shell.h>
25+#include <wlr/render/pass.h>
26+#include <wlr/util/box.h>
27+
28+#define O(t, f) printf(" :%s/%s %zu\n", #t, name(#f), offsetof(struct t, f))
29+#define Z(t) printf(" :%s/sizeof %zu\n", #t, sizeof(struct t))
30+#define E(k, v) printf(" :enum/%s %d\n", k, (int)(v))
31+
32+/* "events.new_output" -> "events.new_output" is a valid keyword name already;
33+ * keep dots, they read as paths. */
34+static const char *name(const char *f) { return f; }
35+
36+int main(void) {
37+ printf("{\n");
38+ Z(wl_listener); O(wl_listener, link); O(wl_listener, notify);
39+ Z(wl_signal); Z(wl_list);
40+ Z(timespec);
41+
42+ O(wlr_backend, events.new_input); O(wlr_backend, events.new_output);
43+
44+ O(wlr_output, name); O(wlr_output, width); O(wlr_output, height);
45+ O(wlr_output, events.frame); O(wlr_output, events.request_state); O(wlr_output, events.destroy);
46+ Z(wlr_output_state);
47+ O(wlr_output_state, committed); O(wlr_output_state, buffer);
48+ E("output-state-buffer", WLR_OUTPUT_STATE_BUFFER);
49+ E("buffer-data-ptr-access-read", WLR_BUFFER_DATA_PTR_ACCESS_READ);
50+ O(wlr_output_event_request_state, state);
51+
52+ O(wlr_scene, tree);
53+ O(wlr_scene_tree, node);
54+ O(wlr_scene_node, type); O(wlr_scene_node, parent); O(wlr_scene_node, enabled);
55+ O(wlr_scene_node, x); O(wlr_scene_node, y); O(wlr_scene_node, data);
56+ O(wlr_scene_surface, surface);
57+ O(wlr_scene_layer_surface_v1, tree);
58+ E("scene-node-tree", WLR_SCENE_NODE_TREE);
59+ E("scene-node-rect", WLR_SCENE_NODE_RECT);
60+ E("scene-node-buffer", WLR_SCENE_NODE_BUFFER);
61+
62+ O(wlr_xdg_shell, events.new_toplevel); O(wlr_xdg_shell, events.new_popup);
63+ O(wlr_xdg_toplevel, base); O(wlr_xdg_toplevel, events.destroy);
64+ O(wlr_xdg_surface, surface); O(wlr_xdg_surface, role); O(wlr_xdg_surface, data);
65+ O(wlr_xdg_surface, initialized); O(wlr_xdg_surface, initial_commit); O(wlr_xdg_surface, geometry);
66+ O(wlr_xdg_popup, base); O(wlr_xdg_popup, parent); O(wlr_xdg_popup, events.destroy);
67+ O(wlr_xdg_popup, current.geometry);
68+
69+ O(wlr_surface, mapped);
70+ O(wlr_surface, events.commit); O(wlr_surface, events.map); O(wlr_surface, events.unmap);
71+ O(wlr_surface, events.destroy);
72+
73+ O(wlr_layer_shell_v1, events.new_surface);
74+ O(wlr_layer_surface_v1, surface); O(wlr_layer_surface_v1, output); O(wlr_layer_surface_v1, namespace);
75+ O(wlr_layer_surface_v1, current.keyboard_interactive); O(wlr_layer_surface_v1, current.layer);
76+ O(wlr_layer_surface_v1, initialized); O(wlr_layer_surface_v1, initial_commit);
77+ O(wlr_layer_surface_v1, events.destroy); O(wlr_layer_surface_v1, events.new_popup);
78+ O(wlr_layer_surface_v1, data);
79+
80+ O(wlr_cursor, x); O(wlr_cursor, y);
81+ O(wlr_cursor, events.motion); O(wlr_cursor, events.motion_absolute); O(wlr_cursor, events.button);
82+ O(wlr_cursor, events.axis); O(wlr_cursor, events.frame);
83+ O(wlr_pointer, base);
84+ O(wlr_pointer_motion_event, pointer); O(wlr_pointer_motion_event, time_msec);
85+ O(wlr_pointer_motion_event, delta_x); O(wlr_pointer_motion_event, delta_y);
86+ O(wlr_pointer_motion_absolute_event, pointer); O(wlr_pointer_motion_absolute_event, time_msec);
87+ O(wlr_pointer_motion_absolute_event, x); O(wlr_pointer_motion_absolute_event, y);
88+ O(wlr_pointer_button_event, time_msec); O(wlr_pointer_button_event, button); O(wlr_pointer_button_event, state);
89+ O(wlr_pointer_axis_event, time_msec); O(wlr_pointer_axis_event, source); O(wlr_pointer_axis_event, orientation);
90+ O(wlr_pointer_axis_event, relative_direction); O(wlr_pointer_axis_event, delta); O(wlr_pointer_axis_event, delta_discrete);
91+
92+ O(wlr_input_device, type); O(wlr_input_device, events.destroy);
93+ E("input-device-keyboard", WLR_INPUT_DEVICE_KEYBOARD);
94+ E("input-device-pointer", WLR_INPUT_DEVICE_POINTER);
95+
96+ O(wlr_keyboard, keycodes); O(wlr_keyboard, num_keycodes); O(wlr_keyboard, modifiers);
97+ O(wlr_keyboard, events.key); O(wlr_keyboard, events.modifiers);
98+ O(wlr_keyboard_key_event, time_msec); O(wlr_keyboard_key_event, keycode); O(wlr_keyboard_key_event, state);
99+
100+ O(wlr_seat, pointer_state.focused_client); O(wlr_seat, pointer_state.focused_surface);
101+ O(wlr_seat, keyboard_state.focused_surface);
102+ O(wlr_seat, events.request_set_cursor); O(wlr_seat, events.request_set_selection);
103+ O(wlr_seat, events.request_set_primary_selection);
104+ O(wlr_seat_pointer_request_set_cursor_event, seat_client); O(wlr_seat_pointer_request_set_cursor_event, surface);
105+ O(wlr_seat_pointer_request_set_cursor_event, hotspot_x); O(wlr_seat_pointer_request_set_cursor_event, hotspot_y);
106+ O(wlr_seat_request_set_selection_event, source); O(wlr_seat_request_set_selection_event, serial);
107+ O(wlr_seat_request_set_primary_selection_event, source); O(wlr_seat_request_set_primary_selection_event, serial);
108+
109+ Z(wlr_box); O(wlr_box, x); O(wlr_box, y); O(wlr_box, width); O(wlr_box, height);
110+ E("seat-capability-pointer", WL_SEAT_CAPABILITY_POINTER);
111+ E("seat-capability-keyboard", WL_SEAT_CAPABILITY_KEYBOARD);
112+ E("button-pressed", WL_POINTER_BUTTON_STATE_PRESSED);
113+ printf("}\n");
114+ return 0;
115+}
new file mode 100644
@@ -0,0 +1,115 @@
1+/*
2+ * Prints the wlroots struct layout facts the jolt compositor needs, as EDN.
3+ * wlroots changes struct layouts between minor versions, so these are read
4+ * from the installed headers rather than written down by hand.
5+ *
6+ * cc -o gen-offsets gen-offsets.c $(pkg-config --cflags wlroots-0.20 wayland-server pixman-1 xkbcommon)
7+ * ./gen-offsets > offsets.edn
8+ */
9+#define WLR_USE_UNSTABLE
10+#include <stdio.h>
11+#include <stddef.h>
12+#include <time.h>
13+#include <wayland-server-core.h>
14+#include <wlr/backend.h>
15+#include <wlr/types/wlr_buffer.h>
16+#include <wlr/types/wlr_cursor.h>
17+#include <wlr/types/wlr_input_device.h>
18+#include <wlr/types/wlr_keyboard.h>
19+#include <wlr/types/wlr_layer_shell_v1.h>
20+#include <wlr/types/wlr_output.h>
21+#include <wlr/types/wlr_pointer.h>
22+#include <wlr/types/wlr_scene.h>
23+#include <wlr/types/wlr_seat.h>
24+#include <wlr/types/wlr_xdg_shell.h>
25+#include <wlr/render/pass.h>
26+#include <wlr/util/box.h>
27+
28+#define O(t, f) printf(" :%s/%s %zu\n", #t, name(#f), offsetof(struct t, f))
29+#define Z(t) printf(" :%s/sizeof %zu\n", #t, sizeof(struct t))
30+#define E(k, v) printf(" :enum/%s %d\n", k, (int)(v))
31+
32+/* "events.new_output" -> "events.new_output" is a valid keyword name already;
33+ * keep dots, they read as paths. */
34+static const char *name(const char *f) { return f; }
35+
36+int main(void) {
37+ printf("{\n");
38+ Z(wl_listener); O(wl_listener, link); O(wl_listener, notify);
39+ Z(wl_signal); Z(wl_list);
40+ Z(timespec);
41+
42+ O(wlr_backend, events.new_input); O(wlr_backend, events.new_output);
43+
44+ O(wlr_output, name); O(wlr_output, width); O(wlr_output, height);
45+ O(wlr_output, events.frame); O(wlr_output, events.request_state); O(wlr_output, events.destroy);
46+ Z(wlr_output_state);
47+ O(wlr_output_state, committed); O(wlr_output_state, buffer);
48+ E("output-state-buffer", WLR_OUTPUT_STATE_BUFFER);
49+ E("buffer-data-ptr-access-read", WLR_BUFFER_DATA_PTR_ACCESS_READ);
50+ O(wlr_output_event_request_state, state);
51+
52+ O(wlr_scene, tree);
53+ O(wlr_scene_tree, node);
54+ O(wlr_scene_node, type); O(wlr_scene_node, parent); O(wlr_scene_node, enabled);
55+ O(wlr_scene_node, x); O(wlr_scene_node, y); O(wlr_scene_node, data);
56+ O(wlr_scene_surface, surface);
57+ O(wlr_scene_layer_surface_v1, tree);
58+ E("scene-node-tree", WLR_SCENE_NODE_TREE);
59+ E("scene-node-rect", WLR_SCENE_NODE_RECT);
60+ E("scene-node-buffer", WLR_SCENE_NODE_BUFFER);
61+
62+ O(wlr_xdg_shell, events.new_toplevel); O(wlr_xdg_shell, events.new_popup);
63+ O(wlr_xdg_toplevel, base); O(wlr_xdg_toplevel, events.destroy);
64+ O(wlr_xdg_surface, surface); O(wlr_xdg_surface, role); O(wlr_xdg_surface, data);
65+ O(wlr_xdg_surface, initialized); O(wlr_xdg_surface, initial_commit); O(wlr_xdg_surface, geometry);
66+ O(wlr_xdg_popup, base); O(wlr_xdg_popup, parent); O(wlr_xdg_popup, events.destroy);
67+ O(wlr_xdg_popup, current.geometry);
68+
69+ O(wlr_surface, mapped);
70+ O(wlr_surface, events.commit); O(wlr_surface, events.map); O(wlr_surface, events.unmap);
71+ O(wlr_surface, events.destroy);
72+
73+ O(wlr_layer_shell_v1, events.new_surface);
74+ O(wlr_layer_surface_v1, surface); O(wlr_layer_surface_v1, output); O(wlr_layer_surface_v1, namespace);
75+ O(wlr_layer_surface_v1, current.keyboard_interactive); O(wlr_layer_surface_v1, current.layer);
76+ O(wlr_layer_surface_v1, initialized); O(wlr_layer_surface_v1, initial_commit);
77+ O(wlr_layer_surface_v1, events.destroy); O(wlr_layer_surface_v1, events.new_popup);
78+ O(wlr_layer_surface_v1, data);
79+
80+ O(wlr_cursor, x); O(wlr_cursor, y);
81+ O(wlr_cursor, events.motion); O(wlr_cursor, events.motion_absolute); O(wlr_cursor, events.button);
82+ O(wlr_cursor, events.axis); O(wlr_cursor, events.frame);
83+ O(wlr_pointer, base);
84+ O(wlr_pointer_motion_event, pointer); O(wlr_pointer_motion_event, time_msec);
85+ O(wlr_pointer_motion_event, delta_x); O(wlr_pointer_motion_event, delta_y);
86+ O(wlr_pointer_motion_absolute_event, pointer); O(wlr_pointer_motion_absolute_event, time_msec);
87+ O(wlr_pointer_motion_absolute_event, x); O(wlr_pointer_motion_absolute_event, y);
88+ O(wlr_pointer_button_event, time_msec); O(wlr_pointer_button_event, button); O(wlr_pointer_button_event, state);
89+ O(wlr_pointer_axis_event, time_msec); O(wlr_pointer_axis_event, source); O(wlr_pointer_axis_event, orientation);
90+ O(wlr_pointer_axis_event, relative_direction); O(wlr_pointer_axis_event, delta); O(wlr_pointer_axis_event, delta_discrete);
91+
92+ O(wlr_input_device, type); O(wlr_input_device, events.destroy);
93+ E("input-device-keyboard", WLR_INPUT_DEVICE_KEYBOARD);
94+ E("input-device-pointer", WLR_INPUT_DEVICE_POINTER);
95+
96+ O(wlr_keyboard, keycodes); O(wlr_keyboard, num_keycodes); O(wlr_keyboard, modifiers);
97+ O(wlr_keyboard, events.key); O(wlr_keyboard, events.modifiers);
98+ O(wlr_keyboard_key_event, time_msec); O(wlr_keyboard_key_event, keycode); O(wlr_keyboard_key_event, state);
99+
100+ O(wlr_seat, pointer_state.focused_client); O(wlr_seat, pointer_state.focused_surface);
101+ O(wlr_seat, keyboard_state.focused_surface);
102+ O(wlr_seat, events.request_set_cursor); O(wlr_seat, events.request_set_selection);
103+ O(wlr_seat, events.request_set_primary_selection);
104+ O(wlr_seat_pointer_request_set_cursor_event, seat_client); O(wlr_seat_pointer_request_set_cursor_event, surface);
105+ O(wlr_seat_pointer_request_set_cursor_event, hotspot_x); O(wlr_seat_pointer_request_set_cursor_event, hotspot_y);
106+ O(wlr_seat_request_set_selection_event, source); O(wlr_seat_request_set_selection_event, serial);
107+ O(wlr_seat_request_set_primary_selection_event, source); O(wlr_seat_request_set_primary_selection_event, serial);
108+
109+ Z(wlr_box); O(wlr_box, x); O(wlr_box, y); O(wlr_box, width); O(wlr_box, height);
110+ E("seat-capability-pointer", WL_SEAT_CAPABILITY_POINTER);
111+ E("seat-capability-keyboard", WL_SEAT_CAPABILITY_KEYBOARD);
112+ E("button-pressed", WL_POINTER_BUTTON_STATE_PRESSED);
113+ printf("}\n");
114+ return 0;
115+}
added wayland-bar-compositor/offsets.edn +124 -0
new file mode 100644
@@ -0,0 +1,124 @@
1+{
2+ :wl_listener/sizeof 24
3+ :wl_listener/link 0
4+ :wl_listener/notify 16
5+ :wl_signal/sizeof 16
6+ :wl_list/sizeof 16
7+ :timespec/sizeof 16
8+ :wlr_backend/events.new_input 32
9+ :wlr_backend/events.new_output 48
10+ :wlr_output/name 48
11+ :wlr_output/width 128
12+ :wlr_output/height 132
13+ :wlr_output/events.frame 192
14+ :wlr_output/events.request_state 320
15+ :wlr_output/events.destroy 336
16+ :wlr_output_state/sizeof 208
17+ :wlr_output_state/committed 0
18+ :wlr_output_state/buffer 56
19+ :enum/output-state-buffer 1
20+ :enum/buffer-data-ptr-access-read 1
21+ :wlr_output_event_request_state/state 8
22+ :wlr_scene/tree 0
23+ :wlr_scene_tree/node 0
24+ :wlr_scene_node/type 0
25+ :wlr_scene_node/parent 8
26+ :wlr_scene_node/enabled 32
27+ :wlr_scene_node/x 36
28+ :wlr_scene_node/y 40
29+ :wlr_scene_node/data 64
30+ :wlr_scene_surface/surface 8
31+ :wlr_scene_layer_surface_v1/tree 0
32+ :enum/scene-node-tree 0
33+ :enum/scene-node-rect 1
34+ :enum/scene-node-buffer 2
35+ :wlr_xdg_shell/events.new_toplevel 72
36+ :wlr_xdg_shell/events.new_popup 88
37+ :wlr_xdg_toplevel/base 8
38+ :wlr_xdg_toplevel/events.destroy 200
39+ :wlr_xdg_surface/surface 16
40+ :wlr_xdg_surface/role 40
41+ :wlr_xdg_surface/data 272
42+ :wlr_xdg_surface/initialized 168
43+ :wlr_xdg_surface/initial_commit 169
44+ :wlr_xdg_surface/geometry 172
45+ :wlr_xdg_popup/base 0
46+ :wlr_xdg_popup/parent 32
47+ :wlr_xdg_popup/events.destroy 176
48+ :wlr_xdg_popup/current.geometry 132
49+ :wlr_surface/mapped 688
50+ :wlr_surface/events.commit 728
51+ :wlr_surface/events.map 744
52+ :wlr_surface/events.unmap 760
53+ :wlr_surface/events.destroy 792
54+ :wlr_layer_shell_v1/events.new_surface 8
55+ :wlr_layer_surface_v1/surface 0
56+ :wlr_layer_surface_v1/output 8
57+ :wlr_layer_surface_v1/namespace 48
58+ :wlr_layer_surface_v1/current.keyboard_interactive 108
59+ :wlr_layer_surface_v1/current.layer 120
60+ :wlr_layer_surface_v1/initialized 200
61+ :wlr_layer_surface_v1/initial_commit 201
62+ :wlr_layer_surface_v1/events.destroy 208
63+ :wlr_layer_surface_v1/events.new_popup 224
64+ :wlr_layer_surface_v1/data 240
65+ :wlr_cursor/x 8
66+ :wlr_cursor/y 16
67+ :wlr_cursor/events.motion 24
68+ :wlr_cursor/events.motion_absolute 40
69+ :wlr_cursor/events.button 56
70+ :wlr_cursor/events.axis 72
71+ :wlr_cursor/events.frame 88
72+ :wlr_pointer/base 0
73+ :wlr_pointer_motion_event/pointer 0
74+ :wlr_pointer_motion_event/time_msec 8
75+ :wlr_pointer_motion_event/delta_x 16
76+ :wlr_pointer_motion_event/delta_y 24
77+ :wlr_pointer_motion_absolute_event/pointer 0
78+ :wlr_pointer_motion_absolute_event/time_msec 8
79+ :wlr_pointer_motion_absolute_event/x 16
80+ :wlr_pointer_motion_absolute_event/y 24
81+ :wlr_pointer_button_event/time_msec 8
82+ :wlr_pointer_button_event/button 12
83+ :wlr_pointer_button_event/state 16
84+ :wlr_pointer_axis_event/time_msec 8
85+ :wlr_pointer_axis_event/source 12
86+ :wlr_pointer_axis_event/orientation 16
87+ :wlr_pointer_axis_event/relative_direction 20
88+ :wlr_pointer_axis_event/delta 24
89+ :wlr_pointer_axis_event/delta_discrete 32
90+ :wlr_input_device/type 0
91+ :wlr_input_device/events.destroy 16
92+ :enum/input-device-keyboard 0
93+ :enum/input-device-pointer 1
94+ :wlr_keyboard/keycodes 152
95+ :wlr_keyboard/num_keycodes 280
96+ :wlr_keyboard/modifiers 288
97+ :wlr_keyboard/events.key 312
98+ :wlr_keyboard/events.modifiers 328
99+ :wlr_keyboard_key_event/time_msec 0
100+ :wlr_keyboard_key_event/keycode 4
101+ :wlr_keyboard_key_event/state 12
102+ :wlr_seat/pointer_state.focused_client 144
103+ :wlr_seat/pointer_state.focused_surface 152
104+ :wlr_seat/keyboard_state.focused_surface 544
105+ :wlr_seat/events.request_set_cursor 824
106+ :wlr_seat/events.request_set_selection 840
107+ :wlr_seat/events.request_set_primary_selection 872
108+ :wlr_seat_pointer_request_set_cursor_event/seat_client 0
109+ :wlr_seat_pointer_request_set_cursor_event/surface 8
110+ :wlr_seat_pointer_request_set_cursor_event/hotspot_x 20
111+ :wlr_seat_pointer_request_set_cursor_event/hotspot_y 24
112+ :wlr_seat_request_set_selection_event/source 0
113+ :wlr_seat_request_set_selection_event/serial 8
114+ :wlr_seat_request_set_primary_selection_event/source 0
115+ :wlr_seat_request_set_primary_selection_event/serial 8
116+ :wlr_box/sizeof 16
117+ :wlr_box/x 0
118+ :wlr_box/y 4
119+ :wlr_box/width 8
120+ :wlr_box/height 12
121+ :enum/seat-capability-pointer 1
122+ :enum/seat-capability-keyboard 2
123+ :enum/button-pressed 1
124+}
new file mode 100644
@@ -0,0 +1,124 @@
1+{
2+ :wl_listener/sizeof 24
3+ :wl_listener/link 0
4+ :wl_listener/notify 16
5+ :wl_signal/sizeof 16
6+ :wl_list/sizeof 16
7+ :timespec/sizeof 16
8+ :wlr_backend/events.new_input 32
9+ :wlr_backend/events.new_output 48
10+ :wlr_output/name 48
11+ :wlr_output/width 128
12+ :wlr_output/height 132
13+ :wlr_output/events.frame 192
14+ :wlr_output/events.request_state 320
15+ :wlr_output/events.destroy 336
16+ :wlr_output_state/sizeof 208
17+ :wlr_output_state/committed 0
18+ :wlr_output_state/buffer 56
19+ :enum/output-state-buffer 1
20+ :enum/buffer-data-ptr-access-read 1
21+ :wlr_output_event_request_state/state 8
22+ :wlr_scene/tree 0
23+ :wlr_scene_tree/node 0
24+ :wlr_scene_node/type 0
25+ :wlr_scene_node/parent 8
26+ :wlr_scene_node/enabled 32
27+ :wlr_scene_node/x 36
28+ :wlr_scene_node/y 40
29+ :wlr_scene_node/data 64
30+ :wlr_scene_surface/surface 8
31+ :wlr_scene_layer_surface_v1/tree 0
32+ :enum/scene-node-tree 0
33+ :enum/scene-node-rect 1
34+ :enum/scene-node-buffer 2
35+ :wlr_xdg_shell/events.new_toplevel 72
36+ :wlr_xdg_shell/events.new_popup 88
37+ :wlr_xdg_toplevel/base 8
38+ :wlr_xdg_toplevel/events.destroy 200
39+ :wlr_xdg_surface/surface 16
40+ :wlr_xdg_surface/role 40
41+ :wlr_xdg_surface/data 272
42+ :wlr_xdg_surface/initialized 168
43+ :wlr_xdg_surface/initial_commit 169
44+ :wlr_xdg_surface/geometry 172
45+ :wlr_xdg_popup/base 0
46+ :wlr_xdg_popup/parent 32
47+ :wlr_xdg_popup/events.destroy 176
48+ :wlr_xdg_popup/current.geometry 132
49+ :wlr_surface/mapped 688
50+ :wlr_surface/events.commit 728
51+ :wlr_surface/events.map 744
52+ :wlr_surface/events.unmap 760
53+ :wlr_surface/events.destroy 792
54+ :wlr_layer_shell_v1/events.new_surface 8
55+ :wlr_layer_surface_v1/surface 0
56+ :wlr_layer_surface_v1/output 8
57+ :wlr_layer_surface_v1/namespace 48
58+ :wlr_layer_surface_v1/current.keyboard_interactive 108
59+ :wlr_layer_surface_v1/current.layer 120
60+ :wlr_layer_surface_v1/initialized 200
61+ :wlr_layer_surface_v1/initial_commit 201
62+ :wlr_layer_surface_v1/events.destroy 208
63+ :wlr_layer_surface_v1/events.new_popup 224
64+ :wlr_layer_surface_v1/data 240
65+ :wlr_cursor/x 8
66+ :wlr_cursor/y 16
67+ :wlr_cursor/events.motion 24
68+ :wlr_cursor/events.motion_absolute 40
69+ :wlr_cursor/events.button 56
70+ :wlr_cursor/events.axis 72
71+ :wlr_cursor/events.frame 88
72+ :wlr_pointer/base 0
73+ :wlr_pointer_motion_event/pointer 0
74+ :wlr_pointer_motion_event/time_msec 8
75+ :wlr_pointer_motion_event/delta_x 16
76+ :wlr_pointer_motion_event/delta_y 24
77+ :wlr_pointer_motion_absolute_event/pointer 0
78+ :wlr_pointer_motion_absolute_event/time_msec 8
79+ :wlr_pointer_motion_absolute_event/x 16
80+ :wlr_pointer_motion_absolute_event/y 24
81+ :wlr_pointer_button_event/time_msec 8
82+ :wlr_pointer_button_event/button 12
83+ :wlr_pointer_button_event/state 16
84+ :wlr_pointer_axis_event/time_msec 8
85+ :wlr_pointer_axis_event/source 12
86+ :wlr_pointer_axis_event/orientation 16
87+ :wlr_pointer_axis_event/relative_direction 20
88+ :wlr_pointer_axis_event/delta 24
89+ :wlr_pointer_axis_event/delta_discrete 32
90+ :wlr_input_device/type 0
91+ :wlr_input_device/events.destroy 16
92+ :enum/input-device-keyboard 0
93+ :enum/input-device-pointer 1
94+ :wlr_keyboard/keycodes 152
95+ :wlr_keyboard/num_keycodes 280
96+ :wlr_keyboard/modifiers 288
97+ :wlr_keyboard/events.key 312
98+ :wlr_keyboard/events.modifiers 328
99+ :wlr_keyboard_key_event/time_msec 0
100+ :wlr_keyboard_key_event/keycode 4
101+ :wlr_keyboard_key_event/state 12
102+ :wlr_seat/pointer_state.focused_client 144
103+ :wlr_seat/pointer_state.focused_surface 152
104+ :wlr_seat/keyboard_state.focused_surface 544
105+ :wlr_seat/events.request_set_cursor 824
106+ :wlr_seat/events.request_set_selection 840
107+ :wlr_seat/events.request_set_primary_selection 872
108+ :wlr_seat_pointer_request_set_cursor_event/seat_client 0
109+ :wlr_seat_pointer_request_set_cursor_event/surface 8
110+ :wlr_seat_pointer_request_set_cursor_event/hotspot_x 20
111+ :wlr_seat_pointer_request_set_cursor_event/hotspot_y 24
112+ :wlr_seat_request_set_selection_event/source 0
113+ :wlr_seat_request_set_selection_event/serial 8
114+ :wlr_seat_request_set_primary_selection_event/source 0
115+ :wlr_seat_request_set_primary_selection_event/serial 8
116+ :wlr_box/sizeof 16
117+ :wlr_box/x 0
118+ :wlr_box/y 4
119+ :wlr_box/width 8
120+ :wlr_box/height 12
121+ :enum/seat-capability-pointer 1
122+ :enum/seat-capability-keyboard 2
123+ :enum/button-pressed 1
124+}
added wayland-bar-compositor/protocol/wlr-layer-shell-unstable-v1.xml +407 -0
new file mode 100644
@@ -0,0 +1,407 @@
1+<?xml version="1.0" encoding="UTF-8"?>
2+<protocol name="wlr_layer_shell_unstable_v1">
3+ <copyright>
4+ Copyright © 2017 Drew DeVault
5+
6+ Permission to use, copy, modify, distribute, and sell this
7+ software and its documentation for any purpose is hereby granted
8+ without fee, provided that the above copyright notice appear in
9+ all copies and that both that copyright notice and this permission
10+ notice appear in supporting documentation, and that the name of
11+ the copyright holders not be used in advertising or publicity
12+ pertaining to distribution of the software without specific,
13+ written prior permission. The copyright holders make no
14+ representations about the suitability of this software for any
15+ purpose. It is provided "as is" without express or implied
16+ warranty.
17+
18+ THE COPYRIGHT HOLDERS DISCLAIM ALL WARRANTIES WITH REGARD TO THIS
19+ SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
20+ FITNESS, IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY
21+ SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
22+ WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN
23+ AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
24+ ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
25+ THIS SOFTWARE.
26+ </copyright>
27+
28+ <interface name="zwlr_layer_shell_v1" version="5">
29+ <description summary="create surfaces that are layers of the desktop">
30+ Clients can use this interface to assign the surface_layer role to
31+ wl_surfaces. Such surfaces are assigned to a "layer" of the output and
32+ rendered with a defined z-depth respective to each other. They may also be
33+ anchored to the edges and corners of a screen and specify input handling
34+ semantics. This interface should be suitable for the implementation of
35+ many desktop shell components, and a broad number of other applications
36+ that interact with the desktop.
37+ </description>
38+
39+ <request name="get_layer_surface">
40+ <description summary="create a layer_surface from a surface">
41+ Create a layer surface for an existing surface. This assigns the role of
42+ layer_surface, or raises a protocol error if another role is already
43+ assigned.
44+
45+ Creating a layer surface from a wl_surface which has a buffer attached
46+ or committed is a client error, and any attempts by a client to attach
47+ or manipulate a buffer prior to the first layer_surface.configure call
48+ must also be treated as errors.
49+
50+ After creating a layer_surface object and setting it up, the client
51+ must perform an initial commit without any buffer attached.
52+ The compositor will reply with a layer_surface.configure event.
53+ The client must acknowledge it and is then allowed to attach a buffer
54+ to map the surface.
55+
56+ You may pass NULL for output to allow the compositor to decide which
57+ output to use. Generally this will be the one that the user most
58+ recently interacted with.
59+
60+ Clients can specify a namespace that defines the purpose of the layer
61+ surface.
62+ </description>
63+ <arg name="id" type="new_id" interface="zwlr_layer_surface_v1"/>
64+ <arg name="surface" type="object" interface="wl_surface"/>
65+ <arg name="output" type="object" interface="wl_output" allow-null="true"/>
66+ <arg name="layer" type="uint" enum="layer" summary="layer to add this surface to"/>
67+ <arg name="namespace" type="string" summary="namespace for the layer surface"/>
68+ </request>
69+
70+ <enum name="error">
71+ <entry name="role" value="0" summary="wl_surface has another role"/>
72+ <entry name="invalid_layer" value="1" summary="layer value is invalid"/>
73+ <entry name="already_constructed" value="2" summary="wl_surface has a buffer attached or committed"/>
74+ </enum>
75+
76+ <enum name="layer">
77+ <description summary="available layers for surfaces">
78+ These values indicate which layers a surface can be rendered in. They
79+ are ordered by z depth, bottom-most first. Traditional shell surfaces
80+ will typically be rendered between the bottom and top layers.
81+ Fullscreen shell surfaces are typically rendered at the top layer.
82+ Multiple surfaces can share a single layer, and ordering within a
83+ single layer is undefined.
84+ </description>
85+
86+ <entry name="background" value="0"/>
87+ <entry name="bottom" value="1"/>
88+ <entry name="top" value="2"/>
89+ <entry name="overlay" value="3"/>
90+ </enum>
91+
92+ <!-- Version 3 additions -->
93+
94+ <request name="destroy" type="destructor" since="3">
95+ <description summary="destroy the layer_shell object">
96+ This request indicates that the client will not use the layer_shell
97+ object any more. Objects that have been created through this instance
98+ are not affected.
99+ </description>
100+ </request>
101+ </interface>
102+
103+ <interface name="zwlr_layer_surface_v1" version="5">
104+ <description summary="layer metadata interface">
105+ An interface that may be implemented by a wl_surface, for surfaces that
106+ are designed to be rendered as a layer of a stacked desktop-like
107+ environment.
108+
109+ Layer surface state (layer, size, anchor, exclusive zone,
110+ margin, interactivity) is double-buffered, and will be applied at the
111+ time wl_surface.commit of the corresponding wl_surface is called.
112+
113+ Attaching a null buffer to a layer surface unmaps it.
114+
115+ Unmapping a layer_surface means that the surface cannot be shown by the
116+ compositor until it is explicitly mapped again. The layer_surface
117+ returns to the state it had right after layer_shell.get_layer_surface.
118+ The client can re-map the surface by performing a commit without any
119+ buffer attached, waiting for a configure event and handling it as usual.
120+ </description>
121+
122+ <request name="set_size">
123+ <description summary="sets the size of the surface">
124+ Sets the size of the surface in surface-local coordinates. The
125+ compositor will display the surface centered with respect to its
126+ anchors.
127+
128+ If you pass 0 for either value, the compositor will assign it and
129+ inform you of the assignment in the configure event. You must set your
130+ anchor to opposite edges in the dimensions you omit; not doing so is a
131+ protocol error. Both values are 0 by default.
132+
133+ Size is double-buffered, see wl_surface.commit.
134+ </description>
135+ <arg name="width" type="uint"/>
136+ <arg name="height" type="uint"/>
137+ </request>
138+
139+ <request name="set_anchor">
140+ <description summary="configures the anchor point of the surface">
141+ Requests that the compositor anchor the surface to the specified edges
142+ and corners. If two orthogonal edges are specified (e.g. 'top' and
143+ 'left'), then the anchor point will be the intersection of the edges
144+ (e.g. the top left corner of the output); otherwise the anchor point
145+ will be centered on that edge, or in the center if none is specified.
146+
147+ Anchor is double-buffered, see wl_surface.commit.
148+ </description>
149+ <arg name="anchor" type="uint" enum="anchor"/>
150+ </request>
151+
152+ <request name="set_exclusive_zone">
153+ <description summary="configures the exclusive geometry of this surface">
154+ Requests that the compositor avoids occluding an area with other
155+ surfaces. The compositor's use of this information is
156+ implementation-dependent - do not assume that this region will not
157+ actually be occluded.
158+
159+ A positive value is only meaningful if the surface is anchored to one
160+ edge or an edge and both perpendicular edges. If the surface is not
161+ anchored, anchored to only two perpendicular edges (a corner), anchored
162+ to only two parallel edges or anchored to all edges, a positive value
163+ will be treated the same as zero.
164+
165+ A positive zone is the distance from the edge in surface-local
166+ coordinates to consider exclusive.
167+
168+ Surfaces that do not wish to have an exclusive zone may instead specify
169+ how they should interact with surfaces that do. If set to zero, the
170+ surface indicates that it would like to be moved to avoid occluding
171+ surfaces with a positive exclusive zone. If set to -1, the surface
172+ indicates that it would not like to be moved to accommodate for other
173+ surfaces, and the compositor should extend it all the way to the edges
174+ it is anchored to.
175+
176+ For example, a panel might set its exclusive zone to 10, so that
177+ maximized shell surfaces are not shown on top of it. A notification
178+ might set its exclusive zone to 0, so that it is moved to avoid
179+ occluding the panel, but shell surfaces are shown underneath it. A
180+ wallpaper or lock screen might set their exclusive zone to -1, so that
181+ they stretch below or over the panel.
182+
183+ The default value is 0.
184+
185+ Exclusive zone is double-buffered, see wl_surface.commit.
186+ </description>
187+ <arg name="zone" type="int"/>
188+ </request>
189+
190+ <request name="set_margin">
191+ <description summary="sets a margin from the anchor point">
192+ Requests that the surface be placed some distance away from the anchor
193+ point on the output, in surface-local coordinates. Setting this value
194+ for edges you are not anchored to has no effect.
195+
196+ The exclusive zone includes the margin.
197+
198+ Margin is double-buffered, see wl_surface.commit.
199+ </description>
200+ <arg name="top" type="int"/>
201+ <arg name="right" type="int"/>
202+ <arg name="bottom" type="int"/>
203+ <arg name="left" type="int"/>
204+ </request>
205+
206+ <enum name="keyboard_interactivity">
207+ <description summary="types of keyboard interaction possible for a layer shell surface">
208+ Types of keyboard interaction possible for layer shell surfaces. The
209+ rationale for this is twofold: (1) some applications are not interested
210+ in keyboard events and not allowing them to be focused can improve the
211+ desktop experience; (2) some applications will want to take exclusive
212+ keyboard focus.
213+ </description>
214+
215+ <entry name="none" value="0">
216+ <description summary="no keyboard focus is possible">
217+ This value indicates that this surface is not interested in keyboard
218+ events and the compositor should never assign it the keyboard focus.
219+
220+ This is the default value, set for newly created layer shell surfaces.
221+
222+ This is useful for e.g. desktop widgets that display information or
223+ only have interaction with non-keyboard input devices.
224+ </description>
225+ </entry>
226+ <entry name="exclusive" value="1">
227+ <description summary="request exclusive keyboard focus">
228+ Request exclusive keyboard focus if this surface is above the shell surface layer.
229+
230+ For the top and overlay layers, the seat will always give
231+ exclusive keyboard focus to the top-most layer which has keyboard
232+ interactivity set to exclusive. If this layer contains multiple
233+ surfaces with keyboard interactivity set to exclusive, the compositor
234+ determines the one receiving keyboard events in an implementation-
235+ defined manner. In this case, no guarantee is made when this surface
236+ will receive keyboard focus (if ever).
237+
238+ For the bottom and background layers, the compositor is allowed to use
239+ normal focus semantics.
240+
241+ This setting is mainly intended for applications that need to ensure
242+ they receive all keyboard events, such as a lock screen or a password
243+ prompt.
244+ </description>
245+ </entry>
246+ <entry name="on_demand" value="2" since="4">
247+ <description summary="request regular keyboard focus semantics">
248+ This requests the compositor to allow this surface to be focused and
249+ unfocused by the user in an implementation-defined manner. The user
250+ should be able to unfocus this surface even regardless of the layer
251+ it is on.
252+
253+ Typically, the compositor will want to use its normal mechanism to
254+ manage keyboard focus between layer shell surfaces with this setting
255+ and regular toplevels on the desktop layer (e.g. click to focus).
256+ Nevertheless, it is possible for a compositor to require a special
257+ interaction to focus or unfocus layer shell surfaces (e.g. requiring
258+ a click even if focus follows the mouse normally, or providing a
259+ keybinding to switch focus between layers).
260+
261+ This setting is mainly intended for desktop shell components (e.g.
262+ panels) that allow keyboard interaction. Using this option can allow
263+ implementing a desktop shell that can be fully usable without the
264+ mouse.
265+ </description>
266+ </entry>
267+ </enum>
268+
269+ <request name="set_keyboard_interactivity">
270+ <description summary="requests keyboard events">
271+ Set how keyboard events are delivered to this surface. By default,
272+ layer shell surfaces do not receive keyboard events; this request can
273+ be used to change this.
274+
275+ This setting is inherited by child surfaces set by the get_popup
276+ request.
277+
278+ Layer surfaces receive pointer, touch, and tablet events normally. If
279+ you do not want to receive them, set the input region on your surface
280+ to an empty region.
281+
282+ Keyboard interactivity is double-buffered, see wl_surface.commit.
283+ </description>
284+ <arg name="keyboard_interactivity" type="uint" enum="keyboard_interactivity"/>
285+ </request>
286+
287+ <request name="get_popup">
288+ <description summary="assign this layer_surface as an xdg_popup parent">
289+ This assigns an xdg_popup's parent to this layer_surface. This popup
290+ should have been created via xdg_surface::get_popup with the parent set
291+ to NULL, and this request must be invoked before committing the popup's
292+ initial state.
293+
294+ See the documentation of xdg_popup for more details about what an
295+ xdg_popup is and how it is used.
296+ </description>
297+ <arg name="popup" type="object" interface="xdg_popup"/>
298+ </request>
299+
300+ <request name="ack_configure">
301+ <description summary="ack a configure event">
302+ When a configure event is received, if a client commits the
303+ surface in response to the configure event, then the client
304+ must make an ack_configure request sometime before the commit
305+ request, passing along the serial of the configure event.
306+
307+ If the client receives multiple configure events before it
308+ can respond to one, it only has to ack the last configure event.
309+
310+ A client is not required to commit immediately after sending
311+ an ack_configure request - it may even ack_configure several times
312+ before its next surface commit.
313+
314+ A client may send multiple ack_configure requests before committing, but
315+ only the last request sent before a commit indicates which configure
316+ event the client really is responding to.
317+ </description>
318+ <arg name="serial" type="uint" summary="the serial from the configure event"/>
319+ </request>
320+
321+ <request name="destroy" type="destructor">
322+ <description summary="destroy the layer_surface">
323+ This request destroys the layer surface.
324+ </description>
325+ </request>
326+
327+ <event name="configure">
328+ <description summary="suggest a surface change">
329+ The configure event asks the client to resize its surface.
330+
331+ Clients should arrange their surface for the new states, and then send
332+ an ack_configure request with the serial sent in this configure event at
333+ some point before committing the new surface.
334+
335+ The client is free to dismiss all but the last configure event it
336+ received.
337+
338+ The width and height arguments specify the size of the window in
339+ surface-local coordinates.
340+
341+ The size is a hint, in the sense that the client is free to ignore it if
342+ it doesn't resize, pick a smaller size (to satisfy aspect ratio or
343+ resize in steps of NxM pixels). If the client picks a smaller size and
344+ is anchored to two opposite anchors (e.g. 'top' and 'bottom'), the
345+ surface will be centered on this axis.
346+
347+ If the width or height arguments are zero, it means the client should
348+ decide its own window dimension.
349+ </description>
350+ <arg name="serial" type="uint"/>
351+ <arg name="width" type="uint"/>
352+ <arg name="height" type="uint"/>
353+ </event>
354+
355+ <event name="closed">
356+ <description summary="surface should be closed">
357+ The closed event is sent by the compositor when the surface will no
358+ longer be shown. The output may have been destroyed or the user may
359+ have asked for it to be removed. Further changes to the surface will be
360+ ignored. The client should destroy the resource after receiving this
361+ event, and create a new surface if they so choose.
362+ </description>
363+ </event>
364+
365+ <enum name="error">
366+ <entry name="invalid_surface_state" value="0" summary="provided surface state is invalid"/>
367+ <entry name="invalid_size" value="1" summary="size is invalid"/>
368+ <entry name="invalid_anchor" value="2" summary="anchor bitfield is invalid"/>
369+ <entry name="invalid_keyboard_interactivity" value="3" summary="keyboard interactivity is invalid"/>
370+ <entry name="invalid_exclusive_edge" value="4" summary="exclusive edge is invalid given the surface anchors"/>
371+ </enum>
372+
373+ <enum name="anchor" bitfield="true">
374+ <entry name="top" value="1" summary="the top edge of the anchor rectangle"/>
375+ <entry name="bottom" value="2" summary="the bottom edge of the anchor rectangle"/>
376+ <entry name="left" value="4" summary="the left edge of the anchor rectangle"/>
377+ <entry name="right" value="8" summary="the right edge of the anchor rectangle"/>
378+ </enum>
379+
380+ <!-- Version 2 additions -->
381+
382+ <request name="set_layer" since="2">
383+ <description summary="change the layer of the surface">
384+ Change the layer that the surface is rendered on.
385+
386+ Layer is double-buffered, see wl_surface.commit.
387+ </description>
388+ <arg name="layer" type="uint" enum="zwlr_layer_shell_v1.layer" summary="layer to move this surface to"/>
389+ </request>
390+
391+ <!-- Version 5 additions -->
392+
393+ <request name="set_exclusive_edge" since="5">
394+ <description summary="set the edge the exclusive zone will be applied to">
395+ Requests an edge for the exclusive zone to apply. The exclusive
396+ edge will be automatically deduced from anchor points when possible,
397+ but when the surface is anchored to a corner, it will be necessary
398+ to set it explicitly to disambiguate, as it is not possible to deduce
399+ which one of the two corner edges should be used.
400+
401+ The edge must be one the surface is anchored to, otherwise the
402+ invalid_exclusive_edge protocol error will be raised.
403+ </description>
404+ <arg name="edge" type="uint" enum="anchor"/>
405+ </request>
406+ </interface>
407+</protocol>
new file mode 100644
@@ -0,0 +1,407 @@
1+<?xml version="1.0" encoding="UTF-8"?>
2+<protocol name="wlr_layer_shell_unstable_v1">
3+ <copyright>
4+ Copyright © 2017 Drew DeVault
5+
6+ Permission to use, copy, modify, distribute, and sell this
7+ software and its documentation for any purpose is hereby granted
8+ without fee, provided that the above copyright notice appear in
9+ all copies and that both that copyright notice and this permission
10+ notice appear in supporting documentation, and that the name of
11+ the copyright holders not be used in advertising or publicity
12+ pertaining to distribution of the software without specific,
13+ written prior permission. The copyright holders make no
14+ representations about the suitability of this software for any
15+ purpose. It is provided "as is" without express or implied
16+ warranty.
17+
18+ THE COPYRIGHT HOLDERS DISCLAIM ALL WARRANTIES WITH REGARD TO THIS
19+ SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
20+ FITNESS, IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY
21+ SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
22+ WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN
23+ AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
24+ ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
25+ THIS SOFTWARE.
26+ </copyright>
27+
28+ <interface name="zwlr_layer_shell_v1" version="5">
29+ <description summary="create surfaces that are layers of the desktop">
30+ Clients can use this interface to assign the surface_layer role to
31+ wl_surfaces. Such surfaces are assigned to a "layer" of the output and
32+ rendered with a defined z-depth respective to each other. They may also be
33+ anchored to the edges and corners of a screen and specify input handling
34+ semantics. This interface should be suitable for the implementation of
35+ many desktop shell components, and a broad number of other applications
36+ that interact with the desktop.
37+ </description>
38+
39+ <request name="get_layer_surface">
40+ <description summary="create a layer_surface from a surface">
41+ Create a layer surface for an existing surface. This assigns the role of
42+ layer_surface, or raises a protocol error if another role is already
43+ assigned.
44+
45+ Creating a layer surface from a wl_surface which has a buffer attached
46+ or committed is a client error, and any attempts by a client to attach
47+ or manipulate a buffer prior to the first layer_surface.configure call
48+ must also be treated as errors.
49+
50+ After creating a layer_surface object and setting it up, the client
51+ must perform an initial commit without any buffer attached.
52+ The compositor will reply with a layer_surface.configure event.
53+ The client must acknowledge it and is then allowed to attach a buffer
54+ to map the surface.
55+
56+ You may pass NULL for output to allow the compositor to decide which
57+ output to use. Generally this will be the one that the user most
58+ recently interacted with.
59+
60+ Clients can specify a namespace that defines the purpose of the layer
61+ surface.
62+ </description>
63+ <arg name="id" type="new_id" interface="zwlr_layer_surface_v1"/>
64+ <arg name="surface" type="object" interface="wl_surface"/>
65+ <arg name="output" type="object" interface="wl_output" allow-null="true"/>
66+ <arg name="layer" type="uint" enum="layer" summary="layer to add this surface to"/>
67+ <arg name="namespace" type="string" summary="namespace for the layer surface"/>
68+ </request>
69+
70+ <enum name="error">
71+ <entry name="role" value="0" summary="wl_surface has another role"/>
72+ <entry name="invalid_layer" value="1" summary="layer value is invalid"/>
73+ <entry name="already_constructed" value="2" summary="wl_surface has a buffer attached or committed"/>
74+ </enum>
75+
76+ <enum name="layer">
77+ <description summary="available layers for surfaces">
78+ These values indicate which layers a surface can be rendered in. They
79+ are ordered by z depth, bottom-most first. Traditional shell surfaces
80+ will typically be rendered between the bottom and top layers.
81+ Fullscreen shell surfaces are typically rendered at the top layer.
82+ Multiple surfaces can share a single layer, and ordering within a
83+ single layer is undefined.
84+ </description>
85+
86+ <entry name="background" value="0"/>
87+ <entry name="bottom" value="1"/>
88+ <entry name="top" value="2"/>
89+ <entry name="overlay" value="3"/>
90+ </enum>
91+
92+ <!-- Version 3 additions -->
93+
94+ <request name="destroy" type="destructor" since="3">
95+ <description summary="destroy the layer_shell object">
96+ This request indicates that the client will not use the layer_shell
97+ object any more. Objects that have been created through this instance
98+ are not affected.
99+ </description>
100+ </request>
101+ </interface>
102+
103+ <interface name="zwlr_layer_surface_v1" version="5">
104+ <description summary="layer metadata interface">
105+ An interface that may be implemented by a wl_surface, for surfaces that
106+ are designed to be rendered as a layer of a stacked desktop-like
107+ environment.
108+
109+ Layer surface state (layer, size, anchor, exclusive zone,
110+ margin, interactivity) is double-buffered, and will be applied at the
111+ time wl_surface.commit of the corresponding wl_surface is called.
112+
113+ Attaching a null buffer to a layer surface unmaps it.
114+
115+ Unmapping a layer_surface means that the surface cannot be shown by the
116+ compositor until it is explicitly mapped again. The layer_surface
117+ returns to the state it had right after layer_shell.get_layer_surface.
118+ The client can re-map the surface by performing a commit without any
119+ buffer attached, waiting for a configure event and handling it as usual.
120+ </description>
121+
122+ <request name="set_size">
123+ <description summary="sets the size of the surface">
124+ Sets the size of the surface in surface-local coordinates. The
125+ compositor will display the surface centered with respect to its
126+ anchors.
127+
128+ If you pass 0 for either value, the compositor will assign it and
129+ inform you of the assignment in the configure event. You must set your
130+ anchor to opposite edges in the dimensions you omit; not doing so is a
131+ protocol error. Both values are 0 by default.
132+
133+ Size is double-buffered, see wl_surface.commit.
134+ </description>
135+ <arg name="width" type="uint"/>
136+ <arg name="height" type="uint"/>
137+ </request>
138+
139+ <request name="set_anchor">
140+ <description summary="configures the anchor point of the surface">
141+ Requests that the compositor anchor the surface to the specified edges
142+ and corners. If two orthogonal edges are specified (e.g. 'top' and
143+ 'left'), then the anchor point will be the intersection of the edges
144+ (e.g. the top left corner of the output); otherwise the anchor point
145+ will be centered on that edge, or in the center if none is specified.
146+
147+ Anchor is double-buffered, see wl_surface.commit.
148+ </description>
149+ <arg name="anchor" type="uint" enum="anchor"/>
150+ </request>
151+
152+ <request name="set_exclusive_zone">
153+ <description summary="configures the exclusive geometry of this surface">
154+ Requests that the compositor avoids occluding an area with other
155+ surfaces. The compositor's use of this information is
156+ implementation-dependent - do not assume that this region will not
157+ actually be occluded.
158+
159+ A positive value is only meaningful if the surface is anchored to one
160+ edge or an edge and both perpendicular edges. If the surface is not
161+ anchored, anchored to only two perpendicular edges (a corner), anchored
162+ to only two parallel edges or anchored to all edges, a positive value
163+ will be treated the same as zero.
164+
165+ A positive zone is the distance from the edge in surface-local
166+ coordinates to consider exclusive.
167+
168+ Surfaces that do not wish to have an exclusive zone may instead specify
169+ how they should interact with surfaces that do. If set to zero, the
170+ surface indicates that it would like to be moved to avoid occluding
171+ surfaces with a positive exclusive zone. If set to -1, the surface
172+ indicates that it would not like to be moved to accommodate for other
173+ surfaces, and the compositor should extend it all the way to the edges
174+ it is anchored to.
175+
176+ For example, a panel might set its exclusive zone to 10, so that
177+ maximized shell surfaces are not shown on top of it. A notification
178+ might set its exclusive zone to 0, so that it is moved to avoid
179+ occluding the panel, but shell surfaces are shown underneath it. A
180+ wallpaper or lock screen might set their exclusive zone to -1, so that
181+ they stretch below or over the panel.
182+
183+ The default value is 0.
184+
185+ Exclusive zone is double-buffered, see wl_surface.commit.
186+ </description>
187+ <arg name="zone" type="int"/>
188+ </request>
189+
190+ <request name="set_margin">
191+ <description summary="sets a margin from the anchor point">
192+ Requests that the surface be placed some distance away from the anchor
193+ point on the output, in surface-local coordinates. Setting this value
194+ for edges you are not anchored to has no effect.
195+
196+ The exclusive zone includes the margin.
197+
198+ Margin is double-buffered, see wl_surface.commit.
199+ </description>
200+ <arg name="top" type="int"/>
201+ <arg name="right" type="int"/>
202+ <arg name="bottom" type="int"/>
203+ <arg name="left" type="int"/>
204+ </request>
205+
206+ <enum name="keyboard_interactivity">
207+ <description summary="types of keyboard interaction possible for a layer shell surface">
208+ Types of keyboard interaction possible for layer shell surfaces. The
209+ rationale for this is twofold: (1) some applications are not interested
210+ in keyboard events and not allowing them to be focused can improve the
211+ desktop experience; (2) some applications will want to take exclusive
212+ keyboard focus.
213+ </description>
214+
215+ <entry name="none" value="0">
216+ <description summary="no keyboard focus is possible">
217+ This value indicates that this surface is not interested in keyboard
218+ events and the compositor should never assign it the keyboard focus.
219+
220+ This is the default value, set for newly created layer shell surfaces.
221+
222+ This is useful for e.g. desktop widgets that display information or
223+ only have interaction with non-keyboard input devices.
224+ </description>
225+ </entry>
226+ <entry name="exclusive" value="1">
227+ <description summary="request exclusive keyboard focus">
228+ Request exclusive keyboard focus if this surface is above the shell surface layer.
229+
230+ For the top and overlay layers, the seat will always give
231+ exclusive keyboard focus to the top-most layer which has keyboard
232+ interactivity set to exclusive. If this layer contains multiple
233+ surfaces with keyboard interactivity set to exclusive, the compositor
234+ determines the one receiving keyboard events in an implementation-
235+ defined manner. In this case, no guarantee is made when this surface
236+ will receive keyboard focus (if ever).
237+
238+ For the bottom and background layers, the compositor is allowed to use
239+ normal focus semantics.
240+
241+ This setting is mainly intended for applications that need to ensure
242+ they receive all keyboard events, such as a lock screen or a password
243+ prompt.
244+ </description>
245+ </entry>
246+ <entry name="on_demand" value="2" since="4">
247+ <description summary="request regular keyboard focus semantics">
248+ This requests the compositor to allow this surface to be focused and
249+ unfocused by the user in an implementation-defined manner. The user
250+ should be able to unfocus this surface even regardless of the layer
251+ it is on.
252+
253+ Typically, the compositor will want to use its normal mechanism to
254+ manage keyboard focus between layer shell surfaces with this setting
255+ and regular toplevels on the desktop layer (e.g. click to focus).
256+ Nevertheless, it is possible for a compositor to require a special
257+ interaction to focus or unfocus layer shell surfaces (e.g. requiring
258+ a click even if focus follows the mouse normally, or providing a
259+ keybinding to switch focus between layers).
260+
261+ This setting is mainly intended for desktop shell components (e.g.
262+ panels) that allow keyboard interaction. Using this option can allow
263+ implementing a desktop shell that can be fully usable without the
264+ mouse.
265+ </description>
266+ </entry>
267+ </enum>
268+
269+ <request name="set_keyboard_interactivity">
270+ <description summary="requests keyboard events">
271+ Set how keyboard events are delivered to this surface. By default,
272+ layer shell surfaces do not receive keyboard events; this request can
273+ be used to change this.
274+
275+ This setting is inherited by child surfaces set by the get_popup
276+ request.
277+
278+ Layer surfaces receive pointer, touch, and tablet events normally. If
279+ you do not want to receive them, set the input region on your surface
280+ to an empty region.
281+
282+ Keyboard interactivity is double-buffered, see wl_surface.commit.
283+ </description>
284+ <arg name="keyboard_interactivity" type="uint" enum="keyboard_interactivity"/>
285+ </request>
286+
287+ <request name="get_popup">
288+ <description summary="assign this layer_surface as an xdg_popup parent">
289+ This assigns an xdg_popup's parent to this layer_surface. This popup
290+ should have been created via xdg_surface::get_popup with the parent set
291+ to NULL, and this request must be invoked before committing the popup's
292+ initial state.
293+
294+ See the documentation of xdg_popup for more details about what an
295+ xdg_popup is and how it is used.
296+ </description>
297+ <arg name="popup" type="object" interface="xdg_popup"/>
298+ </request>
299+
300+ <request name="ack_configure">
301+ <description summary="ack a configure event">
302+ When a configure event is received, if a client commits the
303+ surface in response to the configure event, then the client
304+ must make an ack_configure request sometime before the commit
305+ request, passing along the serial of the configure event.
306+
307+ If the client receives multiple configure events before it
308+ can respond to one, it only has to ack the last configure event.
309+
310+ A client is not required to commit immediately after sending
311+ an ack_configure request - it may even ack_configure several times
312+ before its next surface commit.
313+
314+ A client may send multiple ack_configure requests before committing, but
315+ only the last request sent before a commit indicates which configure
316+ event the client really is responding to.
317+ </description>
318+ <arg name="serial" type="uint" summary="the serial from the configure event"/>
319+ </request>
320+
321+ <request name="destroy" type="destructor">
322+ <description summary="destroy the layer_surface">
323+ This request destroys the layer surface.
324+ </description>
325+ </request>
326+
327+ <event name="configure">
328+ <description summary="suggest a surface change">
329+ The configure event asks the client to resize its surface.
330+
331+ Clients should arrange their surface for the new states, and then send
332+ an ack_configure request with the serial sent in this configure event at
333+ some point before committing the new surface.
334+
335+ The client is free to dismiss all but the last configure event it
336+ received.
337+
338+ The width and height arguments specify the size of the window in
339+ surface-local coordinates.
340+
341+ The size is a hint, in the sense that the client is free to ignore it if
342+ it doesn't resize, pick a smaller size (to satisfy aspect ratio or
343+ resize in steps of NxM pixels). If the client picks a smaller size and
344+ is anchored to two opposite anchors (e.g. 'top' and 'bottom'), the
345+ surface will be centered on this axis.
346+
347+ If the width or height arguments are zero, it means the client should
348+ decide its own window dimension.
349+ </description>
350+ <arg name="serial" type="uint"/>
351+ <arg name="width" type="uint"/>
352+ <arg name="height" type="uint"/>
353+ </event>
354+
355+ <event name="closed">
356+ <description summary="surface should be closed">
357+ The closed event is sent by the compositor when the surface will no
358+ longer be shown. The output may have been destroyed or the user may
359+ have asked for it to be removed. Further changes to the surface will be
360+ ignored. The client should destroy the resource after receiving this
361+ event, and create a new surface if they so choose.
362+ </description>
363+ </event>
364+
365+ <enum name="error">
366+ <entry name="invalid_surface_state" value="0" summary="provided surface state is invalid"/>
367+ <entry name="invalid_size" value="1" summary="size is invalid"/>
368+ <entry name="invalid_anchor" value="2" summary="anchor bitfield is invalid"/>
369+ <entry name="invalid_keyboard_interactivity" value="3" summary="keyboard interactivity is invalid"/>
370+ <entry name="invalid_exclusive_edge" value="4" summary="exclusive edge is invalid given the surface anchors"/>
371+ </enum>
372+
373+ <enum name="anchor" bitfield="true">
374+ <entry name="top" value="1" summary="the top edge of the anchor rectangle"/>
375+ <entry name="bottom" value="2" summary="the bottom edge of the anchor rectangle"/>
376+ <entry name="left" value="4" summary="the left edge of the anchor rectangle"/>
377+ <entry name="right" value="8" summary="the right edge of the anchor rectangle"/>
378+ </enum>
379+
380+ <!-- Version 2 additions -->
381+
382+ <request name="set_layer" since="2">
383+ <description summary="change the layer of the surface">
384+ Change the layer that the surface is rendered on.
385+
386+ Layer is double-buffered, see wl_surface.commit.
387+ </description>
388+ <arg name="layer" type="uint" enum="zwlr_layer_shell_v1.layer" summary="layer to move this surface to"/>
389+ </request>
390+
391+ <!-- Version 5 additions -->
392+
393+ <request name="set_exclusive_edge" since="5">
394+ <description summary="set the edge the exclusive zone will be applied to">
395+ Requests an edge for the exclusive zone to apply. The exclusive
396+ edge will be automatically deduced from anchor points when possible,
397+ but when the surface is anchored to a corner, it will be necessary
398+ to set it explicitly to disambiguate, as it is not possible to deduce
399+ which one of the two corner edges should be used.
400+
401+ The edge must be one the surface is anchored to, otherwise the
402+ invalid_exclusive_edge protocol error will be raised.
403+ </description>
404+ <arg name="edge" type="uint" enum="anchor"/>
405+ </request>
406+ </interface>
407+</protocol>
added wayland-bar-compositor/wayland-bar-compositor +778 -0
new file mode 100755
@@ -0,0 +1,778 @@
1+#!/usr/bin/env jolt
2+;; A Wayland compositor for wayland-bar, written in jolt on raw wlroots.
3+;;
4+;; It replaces the nested sway: one wlroots X11 output of the requested size,
5+;; layer-shell and xdg-shell surfaces drawn by the wlroots scene graph, pointer
6+;; and keyboard forwarded to them. Because it owns the scene, it knows where
7+;; every popup is, so it shapes its own X11 window (strip + popups) through
8+;; XShape directly — no screenshots, no polling.
9+;;
10+;; usage: wayland-bar-compositor --size WxH --strip X,Y,W,H --title TITLE -- CMD [ARGS...]
11+;;
12+;; Struct offsets come from offsets.edn, generated from the installed wlroots
13+;; headers by ./build. Single-threaded: every wlroots callback arrives on this
14+;; thread from inside wl_event_loop_dispatch.
15+
16+(require '[jolt.ffi :as ffi]
17+ '[babashka.fs :as fs]
18+ '[babashka.process :as p]
19+ '[clojure.edn :as edn]
20+ '[clojure.string :as str])
21+
22+(def here (str (fs/parent (fs/canonicalize *file*))))
23+
24+(def debug? (some? (System/getenv "WBC_DEBUG")))
25+
26+(defn debug [& parts]
27+ (when debug?
28+ (binding [*out* *err*] (apply println "wbc:" parts))))
29+
30+(defn die [& msg]
31+ (binding [*out* *err*] (apply println "wayland-bar-compositor:" msg))
32+ (System/exit 1))
33+
34+;; --- arguments ---------------------------------------------------------------
35+
36+(defn parse-args [args]
37+ (loop [[a b & more :as args] args opts {}]
38+ (cond
39+ (empty? args) opts
40+ (= a "--") (assoc opts :command (vec (rest args)))
41+ (= a "--size") (let [[w h] (map parse-long (str/split b #"x"))] (recur more (assoc opts :width w :height h)))
42+ (= a "--strip") (recur more (assoc opts :strip (mapv parse-long (str/split b #","))))
43+ (= a "--title") (recur more (assoc opts :title b))
44+ (str/starts-with? a "--") (die "unknown argument" a)
45+ ;; jolt may consume a "--" itself, so the first non-option starts the command.
46+ :else (assoc opts :command (vec args)))))
47+
48+(def opts (parse-args *command-line-args*))
49+(let [{:keys [width height strip title command]} opts]
50+ (when-not (and width height strip title (seq command))
51+ (die "usage: --size WxH --strip X,Y,W,H --title TITLE -- CMD [ARGS...]")))
52+
53+;; --- layout facts --------------------------------------------------------------
54+
55+(def layout
56+ (let [f (str here "/offsets.edn")]
57+ (when-not (fs/exists? f) (die "missing" f "- run" (str here "/build")))
58+ (edn/read-string (slurp f))))
59+
60+(defn off [k]
61+ (or (get layout k) (die "offsets.edn has no" k)))
62+
63+;; --- libraries -----------------------------------------------------------------
64+
65+(ffi/load-library "libc.so.6")
66+(ffi/load-library "libwayland-server.so.0")
67+(ffi/load-library "libxkbcommon.so.0")
68+(ffi/load-library "libwlroots-0.20.so")
69+(ffi/load-library "libX11.so.6")
70+(ffi/load-library "libXext.so.6")
71+
72+(ffi/defcfn clock-gettime "clock_gettime" [:int :pointer] :int)
73+
74+(ffi/defcfn wl-display-create "wl_display_create" [] :pointer)
75+(ffi/defcfn wl-display-get-event-loop "wl_display_get_event_loop" [:pointer] :pointer)
76+(ffi/defcfn wl-display-add-socket-auto "wl_display_add_socket_auto" [:pointer] :string)
77+(ffi/defcfn wl-display-flush-clients "wl_display_flush_clients" [:pointer] :void)
78+(ffi/defcfn wl-display-destroy-clients "wl_display_destroy_clients" [:pointer] :void)
79+(ffi/defcfn wl-event-loop-dispatch "wl_event_loop_dispatch" [:pointer :int] :int)
80+(ffi/defcfn wl-list-insert "wl_list_insert" [:pointer :pointer] :void)
81+(ffi/defcfn wl-list-remove "wl_list_remove" [:pointer] :void)
82+
83+(ffi/defcfn xkb-context-new "xkb_context_new" [:int] :pointer)
84+(ffi/defcfn xkb-keymap-new-from-names "xkb_keymap_new_from_names" [:pointer :pointer :int] :pointer)
85+(ffi/defcfn xkb-keymap-unref "xkb_keymap_unref" [:pointer] :void)
86+(ffi/defcfn xkb-context-unref "xkb_context_unref" [:pointer] :void)
87+
88+(ffi/defcfn backend-autocreate "wlr_backend_autocreate" [:pointer :pointer] :pointer)
89+(ffi/defcfn backend-start "wlr_backend_start" [:pointer] :bool)
90+(ffi/defcfn renderer-autocreate "wlr_renderer_autocreate" [:pointer] :pointer)
91+(ffi/defcfn renderer-init-wl-display "wlr_renderer_init_wl_display" [:pointer :pointer] :bool)
92+(ffi/defcfn allocator-autocreate "wlr_allocator_autocreate" [:pointer :pointer] :pointer)
93+
94+(ffi/defcfn compositor-create "wlr_compositor_create" [:pointer :uint32 :pointer] :pointer)
95+(ffi/defcfn subcompositor-create "wlr_subcompositor_create" [:pointer] :pointer)
96+(ffi/defcfn data-device-manager-create "wlr_data_device_manager_create" [:pointer] :pointer)
97+(ffi/defcfn primary-selection-manager-create "wlr_primary_selection_v1_device_manager_create" [:pointer] :pointer)
98+(ffi/defcfn data-control-manager-create "wlr_data_control_manager_v1_create" [:pointer] :pointer)
99+(ffi/defcfn xdg-output-manager-create "wlr_xdg_output_manager_v1_create" [:pointer :pointer] :pointer)
100+(ffi/defcfn screencopy-manager-create "wlr_screencopy_manager_v1_create" [:pointer] :pointer)
101+(ffi/defcfn viewporter-create "wlr_viewporter_create" [:pointer] :pointer)
102+(ffi/defcfn fractional-scale-manager-create "wlr_fractional_scale_manager_v1_create" [:pointer :uint32] :pointer)
103+(ffi/defcfn single-pixel-buffer-manager-create "wlr_single_pixel_buffer_manager_v1_create" [:pointer] :pointer)
104+(ffi/defcfn presentation-create "wlr_presentation_create" [:pointer :pointer :uint32] :pointer)
105+(ffi/defcfn xdg-activation-create "wlr_xdg_activation_v1_create" [:pointer] :pointer)
106+
107+(ffi/defcfn output-layout-create "wlr_output_layout_create" [:pointer] :pointer)
108+(ffi/defcfn output-layout-add-auto "wlr_output_layout_add_auto" [:pointer :pointer] :pointer)
109+(ffi/defcfn output-init-render "wlr_output_init_render" [:pointer :pointer :pointer] :bool)
110+(ffi/defcfn output-state-init "wlr_output_state_init" [:pointer] :void)
111+(ffi/defcfn output-state-finish "wlr_output_state_finish" [:pointer] :void)
112+(ffi/defcfn output-state-set-enabled "wlr_output_state_set_enabled" [:pointer :bool] :void)
113+(ffi/defcfn output-state-set-custom-mode "wlr_output_state_set_custom_mode" [:pointer :int32 :int32 :int32] :void)
114+(ffi/defcfn output-commit-state "wlr_output_commit_state" [:pointer :pointer] :bool)
115+(ffi/defcfn x11-output-set-title "wlr_x11_output_set_title" [:pointer :string] :void)
116+(ffi/defcfn output-is-x11 "wlr_output_is_x11" [:pointer] :bool)
117+
118+(ffi/defcfn scene-create "wlr_scene_create" [] :pointer)
119+(ffi/defcfn scene-attach-output-layout "wlr_scene_attach_output_layout" [:pointer :pointer] :pointer)
120+(ffi/defcfn scene-output-create "wlr_scene_output_create" [:pointer :pointer] :pointer)
121+(ffi/defcfn scene-output-layout-add-output "wlr_scene_output_layout_add_output" [:pointer :pointer :pointer] :void)
122+(ffi/defcfn scene-output-needs-frame "wlr_scene_output_needs_frame" [:pointer] :bool)
123+(ffi/defcfn scene-output-build-state "wlr_scene_output_build_state" [:pointer :pointer :pointer] :bool)
124+(ffi/defcfn buffer-begin-data-ptr-access "wlr_buffer_begin_data_ptr_access" [:pointer :uint32 :pointer :pointer :pointer] :bool)
125+(ffi/defcfn buffer-end-data-ptr-access "wlr_buffer_end_data_ptr_access" [:pointer] :void)
126+(ffi/defcfn scene-output-send-frame-done "wlr_scene_output_send_frame_done" [:pointer :pointer] :void)
127+(ffi/defcfn scene-tree-create "wlr_scene_tree_create" [:pointer] :pointer)
128+(ffi/defcfn scene-node-at "wlr_scene_node_at" [:pointer :double :double :pointer :pointer] :pointer)
129+(ffi/defcfn scene-node-coords "wlr_scene_node_coords" [:pointer :pointer :pointer] :bool)
130+(ffi/defcfn scene-buffer-from-node "wlr_scene_buffer_from_node" [:pointer] :pointer)
131+(ffi/defcfn scene-surface-try-from-buffer "wlr_scene_surface_try_from_buffer" [:pointer] :pointer)
132+(ffi/defcfn scene-xdg-surface-create "wlr_scene_xdg_surface_create" [:pointer :pointer] :pointer)
133+(ffi/defcfn scene-layer-surface-create "wlr_scene_layer_surface_v1_create" [:pointer :pointer] :pointer)
134+(ffi/defcfn scene-layer-surface-configure "wlr_scene_layer_surface_v1_configure" [:pointer :pointer :pointer] :void)
135+
136+(ffi/defcfn xdg-shell-create "wlr_xdg_shell_create" [:pointer :uint32] :pointer)
137+(ffi/defcfn xdg-surface-try-from-wlr-surface "wlr_xdg_surface_try_from_wlr_surface" [:pointer] :pointer)
138+(ffi/defcfn xdg-surface-schedule-configure "wlr_xdg_surface_schedule_configure" [:pointer] :uint32)
139+(ffi/defcfn xdg-toplevel-set-size "wlr_xdg_toplevel_set_size" [:pointer :int32 :int32] :uint32)
140+(ffi/defcfn xdg-popup-unconstrain-from-box "wlr_xdg_popup_unconstrain_from_box" [:pointer :pointer] :void)
141+(ffi/defcfn layer-shell-create "wlr_layer_shell_v1_create" [:pointer :uint32] :pointer)
142+(ffi/defcfn layer-surface-try-from-wlr-surface "wlr_layer_surface_v1_try_from_wlr_surface" [:pointer] :pointer)
143+
144+(ffi/defcfn cursor-create "wlr_cursor_create" [] :pointer)
145+(ffi/defcfn cursor-attach-output-layout "wlr_cursor_attach_output_layout" [:pointer :pointer] :void)
146+(ffi/defcfn cursor-attach-input-device "wlr_cursor_attach_input_device" [:pointer :pointer] :void)
147+(ffi/defcfn cursor-move "wlr_cursor_move" [:pointer :pointer :double :double] :void)
148+(ffi/defcfn cursor-warp-absolute "wlr_cursor_warp_absolute" [:pointer :pointer :double :double] :void)
149+(ffi/defcfn cursor-set-xcursor "wlr_cursor_set_xcursor" [:pointer :pointer :string] :void)
150+(ffi/defcfn cursor-set-surface "wlr_cursor_set_surface" [:pointer :pointer :int32 :int32] :void)
151+(ffi/defcfn xcursor-manager-create "wlr_xcursor_manager_create" [:pointer :uint32] :pointer)
152+
153+(ffi/defcfn seat-create "wlr_seat_create" [:pointer :string] :pointer)
154+(ffi/defcfn seat-set-capabilities "wlr_seat_set_capabilities" [:pointer :uint32] :void)
155+(ffi/defcfn seat-set-keyboard "wlr_seat_set_keyboard" [:pointer :pointer] :void)
156+(ffi/defcfn seat-set-selection "wlr_seat_set_selection" [:pointer :pointer :uint32] :void)
157+(ffi/defcfn seat-set-primary-selection "wlr_seat_set_primary_selection" [:pointer :pointer :uint32] :void)
158+(ffi/defcfn seat-pointer-notify-enter "wlr_seat_pointer_notify_enter" [:pointer :pointer :double :double] :void)
159+(ffi/defcfn seat-pointer-notify-motion "wlr_seat_pointer_notify_motion" [:pointer :uint32 :double :double] :void)
160+(ffi/defcfn seat-pointer-notify-button "wlr_seat_pointer_notify_button" [:pointer :uint32 :uint32 :int] :uint32)
161+(ffi/defcfn seat-pointer-notify-axis "wlr_seat_pointer_notify_axis" [:pointer :uint32 :int :double :int32 :int :int] :void)
162+(ffi/defcfn seat-pointer-notify-frame "wlr_seat_pointer_notify_frame" [:pointer] :void)
163+(ffi/defcfn seat-pointer-clear-focus "wlr_seat_pointer_clear_focus" [:pointer] :void)
164+(ffi/defcfn seat-keyboard-notify-enter "wlr_seat_keyboard_notify_enter" [:pointer :pointer :pointer :size_t :pointer] :void)
165+(ffi/defcfn seat-keyboard-notify-key "wlr_seat_keyboard_notify_key" [:pointer :uint32 :uint32 :uint32] :void)
166+(ffi/defcfn seat-keyboard-notify-modifiers "wlr_seat_keyboard_notify_modifiers" [:pointer :pointer] :void)
167+(ffi/defcfn keyboard-from-input-device "wlr_keyboard_from_input_device" [:pointer] :pointer)
168+(ffi/defcfn keyboard-set-keymap "wlr_keyboard_set_keymap" [:pointer :pointer] :bool)
169+(ffi/defcfn keyboard-set-repeat-info "wlr_keyboard_set_repeat_info" [:pointer :int32 :int32] :void)
170+
171+(ffi/load-library "libXi.so.6")
172+(ffi/defcfn wl-event-loop-add-fd "wl_event_loop_add_fd" [:pointer :int :uint32 :pointer :pointer] :pointer)
173+(ffi/defcfn xdg-popup-destroy "wlr_xdg_popup_destroy" [:pointer] :void)
174+(ffi/defcfn x-query-extension "XQueryExtension" [:pointer :string :pointer :pointer :pointer] :int)
175+(ffi/defcfn xi-query-version "XIQueryVersion" [:pointer :pointer :pointer] :int)
176+(ffi/defcfn xi-select-events "XISelectEvents" [:pointer :long :pointer :int] :int)
177+(ffi/defcfn x-pending "XPending" [:pointer] :int)
178+(ffi/defcfn x-next-event "XNextEvent" [:pointer :pointer] :int)
179+(ffi/defcfn x-get-event-data "XGetEventData" [:pointer :pointer] :int)
180+(ffi/defcfn x-free-event-data "XFreeEventData" [:pointer :pointer] :void)
181+(ffi/defcfn x-query-pointer "XQueryPointer"
182+ [:pointer :long :pointer :pointer :pointer :pointer :pointer :pointer :pointer] :int)
183+(ffi/defcfn x-default-root-window "XDefaultRootWindow" [:pointer] :long)
184+(ffi/defcfn x-connection-number "XConnectionNumber" [:pointer] :int)
185+(ffi/defcfn x-open-display "XOpenDisplay" [:pointer] :pointer)
186+(ffi/defcfn x-flush "XFlush" [:pointer] :int)
187+(ffi/defcfn x-shape-combine-rectangles "XShapeCombineRectangles"
188+ [:pointer :long :int :int :int :pointer :int :int :int] :void)
189+
190+;; --- memory helpers ---------------------------------------------------------------
191+
192+(def arena (ffi/global-arena))
193+(defn ptr [p k] (ffi/read p :pointer (off k)))
194+(defn i32 [p k] (ffi/read p :int (off k)))
195+(defn u32 [p k] (ffi/read p :uint32 (off k)))
196+(defn f64 [p k] (ffi/read p :double (off k)))
197+(defn flag [p k] (not (zero? (ffi/read p :uint8 (off k)))))
198+(defn field [p k] (+ p (off k)))
199+
200+;; Scratch buffers reused by every callback; this compositor is single-threaded.
201+(def out-a (ffi/alloc arena 8))
202+(def out-b (ffi/alloc arena 8))
203+(def box-buf (ffi/alloc arena (off :wlr_box/sizeof)))
204+(def usable-buf (ffi/alloc arena (off :wlr_box/sizeof)))
205+(def timespec (ffi/alloc arena (off :timespec/sizeof)))
206+
207+(defn write-box! [buf x y w h]
208+ (ffi/write buf :int x (off :wlr_box/x))
209+ (ffi/write buf :int y (off :wlr_box/y))
210+ (ffi/write buf :int w (off :wlr_box/width))
211+ (ffi/write buf :int h (off :wlr_box/height))
212+ buf)
213+
214+;; --- signals ----------------------------------------------------------------------
215+;; wl_signal_add is a static inline in C. Every listener here shares ONE native
216+;; callback, which looks the listener's address up in `handlers`; listeners come
217+;; from a free list, so surfaces that come and go don't leak callbacks.
218+
219+(def handlers (atom {}))
220+(def free-listeners (atom ()))
221+
222+(defn- dispatch [listener data]
223+ (when-let [f (get @handlers listener)]
224+ (try (f data)
225+ (catch Throwable e
226+ (binding [*out* *err*] (println "wayland-bar-compositor: handler failed:" e))))))
227+
228+(def notify (ffi/callback arena dispatch [:pointer :pointer] :void))
229+
230+(defn listen!
231+ "Hook f onto the wl_signal at address `signal`. Answers the listener."
232+ [signal f]
233+ (let [listener (or (let [[l] @free-listeners] (when l (swap! free-listeners rest) l))
234+ (ffi/alloc arena (off :wl_listener/sizeof)))]
235+ (ffi/write listener :pointer notify (off :wl_listener/notify))
236+ (swap! handlers assoc listener f)
237+ ;; wl_list_insert(signal->listener_list.prev, &listener->link)
238+ (wl-list-insert (ffi/read signal :pointer 0) (field listener :wl_listener/link))
239+ listener))
240+
241+(defn unlisten! [& listeners]
242+ (doseq [l listeners]
243+ (wl-list-remove (field l :wl_listener/link))
244+ (swap! handlers dissoc l)
245+ (swap! free-listeners conj l)))
246+
247+;; --- the server -----------------------------------------------------------------
248+
249+(def width (:width opts))
250+(def height (:height opts))
251+(def display (wl-display-create))
252+(def event-loop (wl-display-get-event-loop display))
253+(def backend (backend-autocreate event-loop 0))
254+(when (zero? backend) (die "no wlroots backend; is DISPLAY set and WLR_BACKENDS=x11?"))
255+(def renderer (renderer-autocreate backend))
256+(when (zero? renderer) (die "no renderer"))
257+(renderer-init-wl-display renderer display)
258+(def allocator (allocator-autocreate backend renderer))
259+(when (zero? allocator) (die "no allocator"))
260+
261+(compositor-create display 5 renderer)
262+(subcompositor-create display)
263+(data-device-manager-create display)
264+(primary-selection-manager-create display)
265+(data-control-manager-create display)
266+(viewporter-create display)
267+(fractional-scale-manager-create display 1)
268+(single-pixel-buffer-manager-create display)
269+(screencopy-manager-create display)
270+(xdg-activation-create display)
271+(presentation-create display backend 2)
272+
273+(def output-layout (output-layout-create display))
274+(xdg-output-manager-create display output-layout)
275+(def scene (scene-create))
276+(def scene-layout (scene-attach-output-layout scene output-layout))
277+(def root (field scene :wlr_scene/tree))
278+
279+;; Layer-shell layers, bottom to top; popups float above everything.
280+(def layer-trees (vec (repeatedly 4 #(scene-tree-create root))))
281+(def toplevel-tree (scene-tree-create root))
282+(def popup-tree (scene-tree-create root))
283+
284+(def output (atom nil)) ; the one wlr_output
285+(def layer-surfaces (atom {})) ; wlr_layer_surface_v1 -> scene layer surface
286+(def popups (atom {})) ; wlr_xdg_popup -> scene tree
287+
288+;; --- X11 window shape --------------------------------------------------------------
289+
290+(def x-display (x-open-display 0))
291+(when (zero? x-display) (die "cannot open the X display"))
292+(def x-window (atom nil))
293+(def shown-rects (atom nil))
294+(def max-rects 1024)
295+(def rect-buf (ffi/alloc arena (* 8 max-rects))) ; XRectangle { short x, y; ushort w, h }
296+
297+(defn find-x-window
298+ "wlroots owns the X11 window; we gave it a unique title, so look it up."
299+ []
300+ (let [out (:out (p/sh "xwininfo" "-name" (:title opts)))]
301+ (some->> (re-find #"Window id: (0x[0-9a-f]+)" out) second (#(Long/parseLong (subs % 2) 16)))))
302+
303+(defn popup-rects
304+ "Layout-space boxes of every mapped popup: its geometry, without shadows."
305+ []
306+ (for [[popup tree] @popups
307+ :let [base (ptr popup :wlr_xdg_popup/base)
308+ surface (ptr base :wlr_xdg_surface/surface)]
309+ :when (flag surface :wlr_surface/mapped)
310+ :let [_ (scene-node-coords (field tree :wlr_scene_tree/node) out-a out-b)
311+ geo (field base :wlr_xdg_surface/geometry)
312+ w (i32 geo :wlr_box/width)
313+ h (i32 geo :wlr_box/height)]
314+ :when (and (pos? w) (pos? h))]
315+ [(ffi/read out-a :int) (ffi/read out-b :int) w h]))
316+
317+;; Popups have rounded corners; their geometry box would show the black output
318+;; behind the corners. So read the frame about to be shown and trace each
319+;; corner row inward to the first painted pixel. Pixman frames are plain
320+;; memory, and only corner rows are scanned, only when the popups change.
321+
322+(def data-out (ffi/alloc arena 8))
323+(def format-out (ffi/alloc arena 4))
324+(def stride-out (ffi/alloc arena 8))
325+(def rgb32-formats #{0x34325258 0x34325241 0x34324258 0x34324241}) ; XRGB/ARGB/XBGR/ABGR8888
326+
327+;; Transparent margins and faint shadows composite onto the black output as
328+;; black or near-black; a popup's own background is well above this.
329+(def paint-threshold 10)
330+
331+(defn- painted? [px]
332+ (or (> (bit-and (bit-shift-right px 16) 0xff) paint-threshold)
333+ (> (bit-and (bit-shift-right px 8) 0xff) paint-threshold)
334+ (> (bit-and px 0xff) paint-threshold)))
335+
336+(defn- row-span
337+ "[left right) of the painted part of row y within [x, x+w); nil if none.
338+ The row is copied out in one call rather than read pixel by pixel."
339+ [data stride x y w]
340+ (let [row (ffi/read-array (+ data (* y stride)) :uint32 w (* 4 x))
341+ left (loop [i 0] (cond (= i w) nil (painted? (aget row i)) i :else (recur (inc i))))]
342+ (when left
343+ (let [right (loop [i (dec w)] (if (painted? (aget row i)) (inc i) (recur (dec i))))]
344+ [(+ x left) (+ x right)]))))
345+
346+(defn outline-rects
347+ "XShape rects for popup box [x y w h], following what the popup actually
348+ painted: rounded corners, and any transparent margin its geometry includes.
349+ Consecutive rows with the same span merge into one rect."
350+ [data stride [x y w h]]
351+ (let [rows (for [row (range y (+ y h))
352+ :let [[l r] (row-span data stride x row w)]
353+ :when l]
354+ [l row (- r l) 1])]
355+ (->> rows
356+ (reduce (fn [acc [rx ry rw rh :as rect]]
357+ (let [[px py pw ph] (peek acc)]
358+ (if (and px (= px rx) (= pw rw) (= (+ py ph) ry))
359+ (conj (pop acc) [px py pw (+ ph rh)])
360+ (conj acc rect))))
361+ []))))
362+
363+(defn- frame-outlines
364+ "Outline rects for every popup box, read from `buffer`; nil if unreadable."
365+ [buffer boxes]
366+ (when (and (pos? buffer)
367+ (buffer-begin-data-ptr-access buffer (off :enum/buffer-data-ptr-access-read)
368+ data-out format-out stride-out))
369+ (try
370+ (when (rgb32-formats (ffi/read format-out :uint32))
371+ (let [data (ffi/read data-out :pointer)
372+ stride (ffi/read stride-out :size_t)]
373+ (vec (mapcat (fn [[x y w h]]
374+ ;; clamp to the output so a scan never leaves the buffer
375+ (let [x (max 0 x) y (max 0 y)
376+ w (min w (- width x)) h (min h (- height y))]
377+ (when (and (pos? w) (pos? h))
378+ (outline-rects data stride [x y w h]))))
379+ boxes))))
380+ (finally (buffer-end-data-ptr-access buffer)))))
381+
382+(def shown-boxes (atom nil))
383+(def popups-dirty (atom false)) ; a popup committed since its outline was traced
384+
385+(defn update-shape!
386+ "Shape the window to the strip plus the popups' outlines. `buffer` is the
387+ frame about to be shown, or nil when nothing was rendered."
388+ [buffer]
389+ (when-not @x-window
390+ (reset! x-window (find-x-window)))
391+ (when-let [win @x-window]
392+ (let [boxes (vec (popup-rects))
393+ retrace? (and (seq boxes) (or (not= boxes @shown-boxes) (and buffer @popups-dirty)))
394+ outlines (when retrace?
395+ ;; tracing needs a rendered frame; without one, wait for it
396+ (when buffer
397+ (reset! popups-dirty false)
398+ (or (frame-outlines buffer boxes) boxes)))
399+ rects (cond
400+ (empty? boxes) [(:strip opts)]
401+ outlines (vec (take max-rects (cons (:strip opts) outlines)))
402+ :else nil)]
403+ (when (and rects (not= rects @shown-rects))
404+ (reset! shown-boxes boxes)
405+ (debug "shape" (count rects) "rects" (take 4 rects))
406+ (doseq [[i [x y w h]] (map-indexed vector rects)]
407+ (ffi/write rect-buf :short (short x) (* 8 i))
408+ (ffi/write rect-buf :short (short y) (+ 2 (* 8 i)))
409+ (ffi/write rect-buf :short (unchecked-short w) (+ 4 (* 8 i)))
410+ (ffi/write rect-buf :short (unchecked-short h) (+ 6 (* 8 i))))
411+ ;; ShapeBounding = 0, ShapeInput = 2; ShapeSet = 0; Unsorted = 0
412+ (x-shape-combine-rectangles x-display win 0 0 0 rect-buf (count rects) 0 0)
413+ (x-shape-combine-rectangles x-display win 2 0 0 rect-buf (count rects) 0 0)
414+ (x-flush x-display)
415+ (reset! shown-rects rects)))))
416+
417+;; --- outputs ------------------------------------------------------------------------
418+
419+(defn with-output-state [f]
420+ (let [state (ffi/alloc arena (off :wlr_output_state/sizeof))]
421+ (output-state-init state)
422+ (try (f state) (finally (output-state-finish state)))))
423+
424+(def child (atom nil))
425+(def frame-state (ffi/alloc arena (off :wlr_output_state/sizeof))) ; reused every frame
426+
427+(defn arrange-layers! []
428+ (write-box! box-buf 0 0 width height)
429+ (write-box! usable-buf 0 0 width height)
430+ (doseq [[_ scene-ls] @layer-surfaces]
431+ (scene-layer-surface-configure scene-ls box-buf usable-buf)))
432+
433+(listen! (field backend :wlr_backend/events.new_output)
434+ (fn [wlr-output]
435+ (if @output
436+ (println "wayland-bar-compositor: ignoring extra output")
437+ (do
438+ (reset! output wlr-output)
439+ (output-init-render wlr-output allocator renderer)
440+ (with-output-state
441+ (fn [state]
442+ (output-state-set-enabled state true)
443+ (output-state-set-custom-mode state width height 0)
444+ (output-commit-state wlr-output state)))
445+ (when (output-is-x11 wlr-output)
446+ (x11-output-set-title wlr-output (:title opts)))
447+ (let [scene-output (scene-output-create scene wlr-output)]
448+ (scene-output-layout-add-output scene-layout (output-layout-add-auto output-layout wlr-output) scene-output)
449+ (listen! (field wlr-output :wlr_output/events.frame)
450+ (fn [_]
451+ ;; wlr_scene_output_commit, split open so the frame can be read
452+ ;; for popup outlines between rendering and showing it.
453+ (if (scene-output-needs-frame scene-output)
454+ (do
455+ (output-state-init frame-state)
456+ (try
457+ (when (scene-output-build-state scene-output frame-state 0)
458+ (update-shape! (when (pos? (bit-and (u32 frame-state :wlr_output_state/committed)
459+ (off :enum/output-state-buffer)))
460+ (ptr frame-state :wlr_output_state/buffer)))
461+ (output-commit-state wlr-output frame-state))
462+ (finally (output-state-finish frame-state))))
463+ (update-shape! nil))
464+ (clock-gettime 1 timespec) ; CLOCK_MONOTONIC
465+ (scene-output-send-frame-done scene-output timespec)))
466+ (listen! (field wlr-output :wlr_output/events.request_state)
467+ (fn [event]
468+ (output-commit-state wlr-output (ptr event :wlr_output_event_request_state/state)))))))))
469+
470+;; --- layer shell -----------------------------------------------------------------
471+
472+(def layer-shell (layer-shell-create display 4))
473+(declare add-popup!)
474+
475+(listen! (field layer-shell :wlr_layer_shell_v1/events.new_surface)
476+ (fn [ls]
477+ (when (zero? (ptr ls :wlr_layer_surface_v1/output))
478+ (ffi/write ls :pointer (or @output 0) (off :wlr_layer_surface_v1/output)))
479+ (let [layer (min 3 (max 0 (i32 ls :wlr_layer_surface_v1/current.layer)))
480+ scene-ls (scene-layer-surface-create (nth layer-trees layer) ls)
481+ surface (ptr ls :wlr_layer_surface_v1/surface)]
482+ ;; popups find their parent's scene tree through data
483+ (ffi/write ls :pointer (ptr scene-ls :wlr_scene_layer_surface_v1/tree) (off :wlr_layer_surface_v1/data))
484+ (swap! layer-surfaces assoc ls scene-ls)
485+ (let [commit (listen! (field surface :wlr_surface/events.commit)
486+ (fn [_] (when (flag ls :wlr_layer_surface_v1/initialized) (arrange-layers!))))
487+ ;; xdg-shell announces a layer surface's popup before it has a
488+ ;; parent; this signal comes once the parent is set.
489+ new-popup (listen! (field ls :wlr_layer_surface_v1/events.new_popup) add-popup!)
490+ destroy (atom nil)]
491+ (reset! destroy
492+ (listen! (field ls :wlr_layer_surface_v1/events.destroy)
493+ (fn [_]
494+ (swap! layer-surfaces dissoc ls)
495+ (unlisten! commit new-popup @destroy))))))))
496+
497+;; --- xdg shell -------------------------------------------------------------------
498+
499+(def xdg-shell (xdg-shell-create display 6))
500+
501+(listen! (field xdg-shell :wlr_xdg_shell/events.new_toplevel)
502+ (fn [toplevel]
503+ (let [base (ptr toplevel :wlr_xdg_toplevel/base)
504+ tree (scene-xdg-surface-create toplevel-tree base)
505+ surface (ptr base :wlr_xdg_surface/surface)]
506+ (ffi/write base :pointer tree (off :wlr_xdg_surface/data))
507+ (let [commit (listen! (field surface :wlr_surface/events.commit)
508+ (fn [_] (when (flag base :wlr_xdg_surface/initial_commit)
509+ (xdg-toplevel-set-size toplevel 0 0))))
510+ destroy (atom nil)]
511+ (reset! destroy
512+ (listen! (field toplevel :wlr_xdg_toplevel/events.destroy)
513+ (fn [_] (unlisten! commit @destroy))))))))
514+
515+(defn parent-tree
516+ "The scene tree a popup's parent surface draws into: an xdg surface's or a
517+ layer surface's, both kept in their data field."
518+ [parent-surface]
519+ (let [xdg (xdg-surface-try-from-wlr-surface parent-surface)]
520+ (if (pos? xdg)
521+ (ptr xdg :wlr_xdg_surface/data)
522+ (let [ls (layer-surface-try-from-wlr-surface parent-surface)]
523+ (when (pos? ls) (ptr ls :wlr_layer_surface_v1/data))))))
524+
525+(defn add-popup!
526+ "Put a popup whose parent is set into the scene, under its parent's tree."
527+ [popup]
528+ (let [base (ptr popup :wlr_xdg_popup/base)
529+ surface (ptr base :wlr_xdg_surface/surface)
530+ parent (parent-tree (ptr popup :wlr_xdg_popup/parent))]
531+ (debug "add popup" popup "parent tree" parent)
532+ (if-not parent
533+ (println "wayland-bar-compositor: popup with no known parent")
534+ (let [tree (scene-xdg-surface-create parent base)]
535+ (ffi/write base :pointer tree (off :wlr_xdg_surface/data))
536+ (swap! popups assoc popup tree)
537+ (let [commit (listen! (field surface :wlr_surface/events.commit)
538+ (fn [_]
539+ ;; new content may change the outline (a client's
540+ ;; first buffer is often blank), so retrace it
541+ (reset! popups-dirty true)
542+ (when (flag base :wlr_xdg_surface/initial_commit)
543+ ;; keep the popup inside the output, in parent-relative space
544+ (scene-node-coords (field parent :wlr_scene_tree/node) out-a out-b)
545+ (xdg-popup-unconstrain-from-box
546+ popup (write-box! box-buf (- (ffi/read out-a :int)) (- (ffi/read out-b :int)) width height))
547+ (xdg-surface-schedule-configure base))))
548+ destroy (atom nil)]
549+ (reset! destroy
550+ (listen! (field popup :wlr_xdg_popup/events.destroy)
551+ (fn [_]
552+ (swap! popups dissoc popup)
553+ (unlisten! commit @destroy)))))))))
554+
555+;; A layer surface's popup arrives here with no parent yet and again, parented,
556+;; on the layer surface's own new_popup; only take the parented ones here.
557+(listen! (field xdg-shell :wlr_xdg_shell/events.new_popup)
558+ (fn [popup]
559+ (when (pos? (ptr popup :wlr_xdg_popup/parent))
560+ (add-popup! popup))))
561+
562+;; --- clicks on X11 apps close popups --------------------------------------------
563+;; A click on an X11 window never reaches Wayland, so popups' own grabs can't
564+;; see it. XInput2 raw button presses on the root window report every click
565+;; without grabbing anything; if the pointer is outside what our window shows,
566+;; close the open popups. Layouts below checked against the X11/XI2 headers.
567+
568+(def generic-event 35)
569+(def xi-raw-button-press 15)
570+
571+(def xi-opcode
572+ (let [opcode (ffi/alloc arena 4) event (ffi/alloc arena 4) error (ffi/alloc arena 4)]
573+ (when (pos? (x-query-extension x-display "XInputExtension" opcode event error))
574+ (ffi/read opcode :int))))
575+
576+(if-not xi-opcode
577+ (println "wayland-bar-compositor: no XInput2; clicks on X11 apps won't close popups")
578+ (let [major (ffi/alloc arena 4) minor (ffi/alloc arena 4)
579+ mask (ffi/alloc arena 5) ; XIMaskLen(XI_LASTEVENT)
580+ event-mask (ffi/alloc arena 16)] ; XIEventMask { deviceid; mask_len; mask* }
581+ (ffi/write major :int 2)
582+ (ffi/write minor :int 0)
583+ (xi-query-version x-display major minor) ; required before XI2 selection
584+ (ffi/write mask :uint8 (bit-shift-left 1 (mod xi-raw-button-press 8)) (quot xi-raw-button-press 8))
585+ (ffi/write event-mask :int 1 0) ; XIAllMasterDevices
586+ (ffi/write event-mask :int 5 4)
587+ (ffi/write event-mask :pointer mask 8)
588+ (xi-select-events x-display (x-default-root-window x-display) event-mask 1)
589+ (x-flush x-display)))
590+
591+(def x-event (ffi/alloc arena 192)) ; sizeof(XEvent)
592+(def query-bufs (vec (repeatedly 7 #(ffi/alloc arena 8))))
593+
594+(defn pointer-in-window?
595+ "Whether the pointer is over a part of our window that is shown."
596+ []
597+ (let [[root child root-x root-y win-x win-y buttons] query-bufs]
598+ (x-query-pointer x-display @x-window root child root-x root-y win-x win-y buttons)
599+ (let [x (ffi/read win-x :int) y (ffi/read win-y :int)]
600+ (some (fn [[rx ry rw rh]] (and (<= rx x) (< x (+ rx rw)) (<= ry y) (< y (+ ry rh))))
601+ @shown-rects))))
602+
603+(defn dismiss-popups!
604+ "Destroy the top-level popups; wlroots takes their child popups with them."
605+ []
606+ (let [roots (doall (for [[popup _] @popups
607+ :when (zero? (xdg-surface-try-from-wlr-surface (ptr popup :wlr_xdg_popup/parent)))]
608+ popup))]
609+ (debug "click outside on X11: closing" (count roots) "popup(s)")
610+ (doseq [popup roots] (xdg-popup-destroy popup))))
611+
612+(defn drain-x-events! []
613+ (while (pos? (x-pending x-display))
614+ (x-next-event x-display x-event)
615+ (when (and xi-opcode
616+ (= (ffi/read x-event :int 0) generic-event) ; cookie.type
617+ (= (ffi/read x-event :int 32) xi-opcode) ; cookie.extension
618+ (pos? (x-get-event-data x-display x-event)))
619+ (let [evtype (ffi/read x-event :int 36)] ; cookie.evtype
620+ (x-free-event-data x-display x-event)
621+ (when (and (= evtype xi-raw-button-press) (seq @popups) @x-window (not (pointer-in-window?)))
622+ (dismiss-popups!))))))
623+
624+(def x-fd-ready
625+ (ffi/callback arena
626+ (fn [_fd _mask _data]
627+ (try (drain-x-events!)
628+ (catch Throwable e
629+ (binding [*out* *err*] (println "wayland-bar-compositor: X event handling failed:" e))))
630+ 0)
631+ [:int :uint32 :pointer] :int))
632+
633+(when xi-opcode
634+ (wl-event-loop-add-fd event-loop (x-connection-number x-display) 1 x-fd-ready 0)) ; WL_EVENT_READABLE
635+
636+;; --- seat and input ----------------------------------------------------------------
637+
638+(def seat (seat-create display "seat0"))
639+(def cursor (cursor-create))
640+(cursor-attach-output-layout cursor output-layout)
641+(def cursor-manager (xcursor-manager-create 0 24))
642+(def keyboards (atom #{}))
643+
644+(defn surface-at
645+ "[surface sx sy] under layout point (lx, ly), or nil."
646+ [lx ly]
647+ (let [node (scene-node-at (field root :wlr_scene_tree/node) lx ly out-a out-b)]
648+ (when (and (pos? node) (= (i32 node :wlr_scene_node/type) (off :enum/scene-node-buffer)))
649+ (let [scene-surface (scene-surface-try-from-buffer (scene-buffer-from-node node))]
650+ (when (pos? scene-surface)
651+ [(ptr scene-surface :wlr_scene_surface/surface) (ffi/read out-a :double) (ffi/read out-b :double)])))))
652+
653+(defn focus-keyboard! [surface]
654+ (when-let [kb (first @keyboards)]
655+ (seat-keyboard-notify-enter seat surface (field kb :wlr_keyboard/keycodes)
656+ (ffi/read kb :size_t (off :wlr_keyboard/num_keycodes))
657+ (field kb :wlr_keyboard/modifiers))))
658+
659+(defn pointer-motion! [time]
660+ (debug "motion" (f64 cursor :wlr_cursor/x) (f64 cursor :wlr_cursor/y))
661+ (if-let [[surface sx sy] (surface-at (f64 cursor :wlr_cursor/x) (f64 cursor :wlr_cursor/y))]
662+ (do (seat-pointer-notify-enter seat surface sx sy)
663+ (seat-pointer-notify-motion seat time sx sy))
664+ (do (cursor-set-xcursor cursor cursor-manager "default")
665+ (seat-pointer-clear-focus seat))))
666+
667+(listen! (field cursor :wlr_cursor/events.motion)
668+ (fn [e]
669+ (cursor-move cursor (field (ptr e :wlr_pointer_motion_event/pointer) :wlr_pointer/base)
670+ (f64 e :wlr_pointer_motion_event/delta_x) (f64 e :wlr_pointer_motion_event/delta_y))
671+ (pointer-motion! (u32 e :wlr_pointer_motion_event/time_msec))))
672+
673+(listen! (field cursor :wlr_cursor/events.motion_absolute)
674+ (fn [e]
675+ (cursor-warp-absolute cursor (field (ptr e :wlr_pointer_motion_absolute_event/pointer) :wlr_pointer/base)
676+ (f64 e :wlr_pointer_motion_absolute_event/x) (f64 e :wlr_pointer_motion_absolute_event/y))
677+ (pointer-motion! (u32 e :wlr_pointer_motion_absolute_event/time_msec))))
678+
679+(listen! (field cursor :wlr_cursor/events.button)
680+ (fn [e]
681+ (seat-pointer-notify-button seat (u32 e :wlr_pointer_button_event/time_msec)
682+ (u32 e :wlr_pointer_button_event/button) (i32 e :wlr_pointer_button_event/state))
683+ (debug "button" (u32 e :wlr_pointer_button_event/button) "state" (i32 e :wlr_pointer_button_event/state)
684+ "at" (f64 cursor :wlr_cursor/x) (f64 cursor :wlr_cursor/y)
685+ "surface" (first (surface-at (f64 cursor :wlr_cursor/x) (f64 cursor :wlr_cursor/y))))
686+ (when (= (i32 e :wlr_pointer_button_event/state) (off :enum/button-pressed))
687+ (when-let [[surface] (surface-at (f64 cursor :wlr_cursor/x) (f64 cursor :wlr_cursor/y))]
688+ (focus-keyboard! surface)))))
689+
690+(listen! (field cursor :wlr_cursor/events.axis)
691+ (fn [e]
692+ (seat-pointer-notify-axis seat (u32 e :wlr_pointer_axis_event/time_msec)
693+ (i32 e :wlr_pointer_axis_event/orientation) (f64 e :wlr_pointer_axis_event/delta)
694+ (i32 e :wlr_pointer_axis_event/delta_discrete) (i32 e :wlr_pointer_axis_event/source)
695+ (i32 e :wlr_pointer_axis_event/relative_direction))))
696+
697+(listen! (field cursor :wlr_cursor/events.frame)
698+ (fn [_] (seat-pointer-notify-frame seat)))
699+
700+(listen! (field seat :wlr_seat/events.request_set_cursor)
701+ (fn [e]
702+ (when (= (ptr e :wlr_seat_pointer_request_set_cursor_event/seat_client)
703+ (ptr seat :wlr_seat/pointer_state.focused_client))
704+ (cursor-set-surface cursor (ptr e :wlr_seat_pointer_request_set_cursor_event/surface)
705+ (i32 e :wlr_seat_pointer_request_set_cursor_event/hotspot_x)
706+ (i32 e :wlr_seat_pointer_request_set_cursor_event/hotspot_y)))))
707+
708+(listen! (field seat :wlr_seat/events.request_set_selection)
709+ (fn [e] (seat-set-selection seat (ptr e :wlr_seat_request_set_selection_event/source)
710+ (u32 e :wlr_seat_request_set_selection_event/serial))))
711+
712+(listen! (field seat :wlr_seat/events.request_set_primary_selection)
713+ (fn [e] (seat-set-primary-selection seat (ptr e :wlr_seat_request_set_primary_selection_event/source)
714+ (u32 e :wlr_seat_request_set_primary_selection_event/serial))))
715+
716+(defn update-capabilities! []
717+ (seat-set-capabilities seat (bit-or (off :enum/seat-capability-pointer)
718+ (if (seq @keyboards) (off :enum/seat-capability-keyboard) 0))))
719+
720+(defn add-keyboard! [device]
721+ (let [kb (keyboard-from-input-device device)
722+ context (xkb-context-new 0)
723+ keymap (xkb-keymap-new-from-names context 0 0)]
724+ (keyboard-set-keymap kb keymap)
725+ (xkb-keymap-unref keymap)
726+ (xkb-context-unref context)
727+ (keyboard-set-repeat-info kb 25 600)
728+ (let [modifiers (listen! (field kb :wlr_keyboard/events.modifiers)
729+ (fn [_]
730+ (seat-set-keyboard seat kb)
731+ (seat-keyboard-notify-modifiers seat (field kb :wlr_keyboard/modifiers))))
732+ key (listen! (field kb :wlr_keyboard/events.key)
733+ (fn [e]
734+ (seat-set-keyboard seat kb)
735+ (seat-keyboard-notify-key seat (u32 e :wlr_keyboard_key_event/time_msec)
736+ (u32 e :wlr_keyboard_key_event/keycode)
737+ (u32 e :wlr_keyboard_key_event/state))))
738+ destroy (atom nil)]
739+ (reset! destroy
740+ (listen! (field device :wlr_input_device/events.destroy)
741+ (fn [_]
742+ (swap! keyboards disj kb)
743+ (unlisten! modifiers key @destroy)
744+ (update-capabilities!)))))
745+ (seat-set-keyboard seat kb)
746+ (swap! keyboards conj kb)))
747+
748+(listen! (field backend :wlr_backend/events.new_input)
749+ (fn [device]
750+ (let [type (i32 device :wlr_input_device/type)]
751+ (debug "new input device type" type)
752+ (cond
753+ (= type (off :enum/input-device-keyboard)) (add-keyboard! device)
754+ (= type (off :enum/input-device-pointer)) (cursor-attach-input-device cursor device)))
755+ (update-capabilities!)))
756+
757+;; --- run -----------------------------------------------------------------------------
758+
759+(def socket (wl-display-add-socket-auto display))
760+(when-not socket (die "cannot create a wayland socket"))
761+(when-not (backend-start backend) (die "backend failed to start"))
762+(println "wayland-bar-compositor: WAYLAND_DISPLAY" socket)
763+
764+(reset! child (p/process (:command opts) {:extra-env {"WAYLAND_DISPLAY" socket}
765+ :out :inherit :err :inherit}))
766+(.addShutdownHook (Runtime/getRuntime)
767+ (Thread. (fn [] (when @child (p/destroy @child)))))
768+
769+(while (p/alive? @child)
770+ (wl-event-loop-dispatch event-loop 250)
771+ ;; Xlib may have read events into its queue during our own X calls, where
772+ ;; the fd never becomes readable again; drain them here too.
773+ (drain-x-events!)
774+ (wl-display-flush-clients display))
775+
776+(println "wayland-bar-compositor:" (first (:command opts)) "exited")
777+(wl-display-destroy-clients display)
778+(System/exit 0)
new file mode 100755
@@ -0,0 +1,778 @@
1+#!/usr/bin/env jolt
2+;; A Wayland compositor for wayland-bar, written in jolt on raw wlroots.
3+;;
4+;; It replaces the nested sway: one wlroots X11 output of the requested size,
5+;; layer-shell and xdg-shell surfaces drawn by the wlroots scene graph, pointer
6+;; and keyboard forwarded to them. Because it owns the scene, it knows where
7+;; every popup is, so it shapes its own X11 window (strip + popups) through
8+;; XShape directly — no screenshots, no polling.
9+;;
10+;; usage: wayland-bar-compositor --size WxH --strip X,Y,W,H --title TITLE -- CMD [ARGS...]
11+;;
12+;; Struct offsets come from offsets.edn, generated from the installed wlroots
13+;; headers by ./build. Single-threaded: every wlroots callback arrives on this
14+;; thread from inside wl_event_loop_dispatch.
15+
16+(require '[jolt.ffi :as ffi]
17+ '[babashka.fs :as fs]
18+ '[babashka.process :as p]
19+ '[clojure.edn :as edn]
20+ '[clojure.string :as str])
21+
22+(def here (str (fs/parent (fs/canonicalize *file*))))
23+
24+(def debug? (some? (System/getenv "WBC_DEBUG")))
25+
26+(defn debug [& parts]
27+ (when debug?
28+ (binding [*out* *err*] (apply println "wbc:" parts))))
29+
30+(defn die [& msg]
31+ (binding [*out* *err*] (apply println "wayland-bar-compositor:" msg))
32+ (System/exit 1))
33+
34+;; --- arguments ---------------------------------------------------------------
35+
36+(defn parse-args [args]
37+ (loop [[a b & more :as args] args opts {}]
38+ (cond
39+ (empty? args) opts
40+ (= a "--") (assoc opts :command (vec (rest args)))
41+ (= a "--size") (let [[w h] (map parse-long (str/split b #"x"))] (recur more (assoc opts :width w :height h)))
42+ (= a "--strip") (recur more (assoc opts :strip (mapv parse-long (str/split b #","))))
43+ (= a "--title") (recur more (assoc opts :title b))
44+ (str/starts-with? a "--") (die "unknown argument" a)
45+ ;; jolt may consume a "--" itself, so the first non-option starts the command.
46+ :else (assoc opts :command (vec args)))))
47+
48+(def opts (parse-args *command-line-args*))
49+(let [{:keys [width height strip title command]} opts]
50+ (when-not (and width height strip title (seq command))
51+ (die "usage: --size WxH --strip X,Y,W,H --title TITLE -- CMD [ARGS...]")))
52+
53+;; --- layout facts --------------------------------------------------------------
54+
55+(def layout
56+ (let [f (str here "/offsets.edn")]
57+ (when-not (fs/exists? f) (die "missing" f "- run" (str here "/build")))
58+ (edn/read-string (slurp f))))
59+
60+(defn off [k]
61+ (or (get layout k) (die "offsets.edn has no" k)))
62+
63+;; --- libraries -----------------------------------------------------------------
64+
65+(ffi/load-library "libc.so.6")
66+(ffi/load-library "libwayland-server.so.0")
67+(ffi/load-library "libxkbcommon.so.0")
68+(ffi/load-library "libwlroots-0.20.so")
69+(ffi/load-library "libX11.so.6")
70+(ffi/load-library "libXext.so.6")
71+
72+(ffi/defcfn clock-gettime "clock_gettime" [:int :pointer] :int)
73+
74+(ffi/defcfn wl-display-create "wl_display_create" [] :pointer)
75+(ffi/defcfn wl-display-get-event-loop "wl_display_get_event_loop" [:pointer] :pointer)
76+(ffi/defcfn wl-display-add-socket-auto "wl_display_add_socket_auto" [:pointer] :string)
77+(ffi/defcfn wl-display-flush-clients "wl_display_flush_clients" [:pointer] :void)
78+(ffi/defcfn wl-display-destroy-clients "wl_display_destroy_clients" [:pointer] :void)
79+(ffi/defcfn wl-event-loop-dispatch "wl_event_loop_dispatch" [:pointer :int] :int)
80+(ffi/defcfn wl-list-insert "wl_list_insert" [:pointer :pointer] :void)
81+(ffi/defcfn wl-list-remove "wl_list_remove" [:pointer] :void)
82+
83+(ffi/defcfn xkb-context-new "xkb_context_new" [:int] :pointer)
84+(ffi/defcfn xkb-keymap-new-from-names "xkb_keymap_new_from_names" [:pointer :pointer :int] :pointer)
85+(ffi/defcfn xkb-keymap-unref "xkb_keymap_unref" [:pointer] :void)
86+(ffi/defcfn xkb-context-unref "xkb_context_unref" [:pointer] :void)
87+
88+(ffi/defcfn backend-autocreate "wlr_backend_autocreate" [:pointer :pointer] :pointer)
89+(ffi/defcfn backend-start "wlr_backend_start" [:pointer] :bool)
90+(ffi/defcfn renderer-autocreate "wlr_renderer_autocreate" [:pointer] :pointer)
91+(ffi/defcfn renderer-init-wl-display "wlr_renderer_init_wl_display" [:pointer :pointer] :bool)
92+(ffi/defcfn allocator-autocreate "wlr_allocator_autocreate" [:pointer :pointer] :pointer)
93+
94+(ffi/defcfn compositor-create "wlr_compositor_create" [:pointer :uint32 :pointer] :pointer)
95+(ffi/defcfn subcompositor-create "wlr_subcompositor_create" [:pointer] :pointer)
96+(ffi/defcfn data-device-manager-create "wlr_data_device_manager_create" [:pointer] :pointer)
97+(ffi/defcfn primary-selection-manager-create "wlr_primary_selection_v1_device_manager_create" [:pointer] :pointer)
98+(ffi/defcfn data-control-manager-create "wlr_data_control_manager_v1_create" [:pointer] :pointer)
99+(ffi/defcfn xdg-output-manager-create "wlr_xdg_output_manager_v1_create" [:pointer :pointer] :pointer)
100+(ffi/defcfn screencopy-manager-create "wlr_screencopy_manager_v1_create" [:pointer] :pointer)
101+(ffi/defcfn viewporter-create "wlr_viewporter_create" [:pointer] :pointer)
102+(ffi/defcfn fractional-scale-manager-create "wlr_fractional_scale_manager_v1_create" [:pointer :uint32] :pointer)
103+(ffi/defcfn single-pixel-buffer-manager-create "wlr_single_pixel_buffer_manager_v1_create" [:pointer] :pointer)
104+(ffi/defcfn presentation-create "wlr_presentation_create" [:pointer :pointer :uint32] :pointer)
105+(ffi/defcfn xdg-activation-create "wlr_xdg_activation_v1_create" [:pointer] :pointer)
106+
107+(ffi/defcfn output-layout-create "wlr_output_layout_create" [:pointer] :pointer)
108+(ffi/defcfn output-layout-add-auto "wlr_output_layout_add_auto" [:pointer :pointer] :pointer)
109+(ffi/defcfn output-init-render "wlr_output_init_render" [:pointer :pointer :pointer] :bool)
110+(ffi/defcfn output-state-init "wlr_output_state_init" [:pointer] :void)
111+(ffi/defcfn output-state-finish "wlr_output_state_finish" [:pointer] :void)
112+(ffi/defcfn output-state-set-enabled "wlr_output_state_set_enabled" [:pointer :bool] :void)
113+(ffi/defcfn output-state-set-custom-mode "wlr_output_state_set_custom_mode" [:pointer :int32 :int32 :int32] :void)
114+(ffi/defcfn output-commit-state "wlr_output_commit_state" [:pointer :pointer] :bool)
115+(ffi/defcfn x11-output-set-title "wlr_x11_output_set_title" [:pointer :string] :void)
116+(ffi/defcfn output-is-x11 "wlr_output_is_x11" [:pointer] :bool)
117+
118+(ffi/defcfn scene-create "wlr_scene_create" [] :pointer)
119+(ffi/defcfn scene-attach-output-layout "wlr_scene_attach_output_layout" [:pointer :pointer] :pointer)
120+(ffi/defcfn scene-output-create "wlr_scene_output_create" [:pointer :pointer] :pointer)
121+(ffi/defcfn scene-output-layout-add-output "wlr_scene_output_layout_add_output" [:pointer :pointer :pointer] :void)
122+(ffi/defcfn scene-output-needs-frame "wlr_scene_output_needs_frame" [:pointer] :bool)
123+(ffi/defcfn scene-output-build-state "wlr_scene_output_build_state" [:pointer :pointer :pointer] :bool)
124+(ffi/defcfn buffer-begin-data-ptr-access "wlr_buffer_begin_data_ptr_access" [:pointer :uint32 :pointer :pointer :pointer] :bool)
125+(ffi/defcfn buffer-end-data-ptr-access "wlr_buffer_end_data_ptr_access" [:pointer] :void)
126+(ffi/defcfn scene-output-send-frame-done "wlr_scene_output_send_frame_done" [:pointer :pointer] :void)
127+(ffi/defcfn scene-tree-create "wlr_scene_tree_create" [:pointer] :pointer)
128+(ffi/defcfn scene-node-at "wlr_scene_node_at" [:pointer :double :double :pointer :pointer] :pointer)
129+(ffi/defcfn scene-node-coords "wlr_scene_node_coords" [:pointer :pointer :pointer] :bool)
130+(ffi/defcfn scene-buffer-from-node "wlr_scene_buffer_from_node" [:pointer] :pointer)
131+(ffi/defcfn scene-surface-try-from-buffer "wlr_scene_surface_try_from_buffer" [:pointer] :pointer)
132+(ffi/defcfn scene-xdg-surface-create "wlr_scene_xdg_surface_create" [:pointer :pointer] :pointer)
133+(ffi/defcfn scene-layer-surface-create "wlr_scene_layer_surface_v1_create" [:pointer :pointer] :pointer)
134+(ffi/defcfn scene-layer-surface-configure "wlr_scene_layer_surface_v1_configure" [:pointer :pointer :pointer] :void)
135+
136+(ffi/defcfn xdg-shell-create "wlr_xdg_shell_create" [:pointer :uint32] :pointer)
137+(ffi/defcfn xdg-surface-try-from-wlr-surface "wlr_xdg_surface_try_from_wlr_surface" [:pointer] :pointer)
138+(ffi/defcfn xdg-surface-schedule-configure "wlr_xdg_surface_schedule_configure" [:pointer] :uint32)
139+(ffi/defcfn xdg-toplevel-set-size "wlr_xdg_toplevel_set_size" [:pointer :int32 :int32] :uint32)
140+(ffi/defcfn xdg-popup-unconstrain-from-box "wlr_xdg_popup_unconstrain_from_box" [:pointer :pointer] :void)
141+(ffi/defcfn layer-shell-create "wlr_layer_shell_v1_create" [:pointer :uint32] :pointer)
142+(ffi/defcfn layer-surface-try-from-wlr-surface "wlr_layer_surface_v1_try_from_wlr_surface" [:pointer] :pointer)
143+
144+(ffi/defcfn cursor-create "wlr_cursor_create" [] :pointer)
145+(ffi/defcfn cursor-attach-output-layout "wlr_cursor_attach_output_layout" [:pointer :pointer] :void)
146+(ffi/defcfn cursor-attach-input-device "wlr_cursor_attach_input_device" [:pointer :pointer] :void)
147+(ffi/defcfn cursor-move "wlr_cursor_move" [:pointer :pointer :double :double] :void)
148+(ffi/defcfn cursor-warp-absolute "wlr_cursor_warp_absolute" [:pointer :pointer :double :double] :void)
149+(ffi/defcfn cursor-set-xcursor "wlr_cursor_set_xcursor" [:pointer :pointer :string] :void)
150+(ffi/defcfn cursor-set-surface "wlr_cursor_set_surface" [:pointer :pointer :int32 :int32] :void)
151+(ffi/defcfn xcursor-manager-create "wlr_xcursor_manager_create" [:pointer :uint32] :pointer)
152+
153+(ffi/defcfn seat-create "wlr_seat_create" [:pointer :string] :pointer)
154+(ffi/defcfn seat-set-capabilities "wlr_seat_set_capabilities" [:pointer :uint32] :void)
155+(ffi/defcfn seat-set-keyboard "wlr_seat_set_keyboard" [:pointer :pointer] :void)
156+(ffi/defcfn seat-set-selection "wlr_seat_set_selection" [:pointer :pointer :uint32] :void)
157+(ffi/defcfn seat-set-primary-selection "wlr_seat_set_primary_selection" [:pointer :pointer :uint32] :void)
158+(ffi/defcfn seat-pointer-notify-enter "wlr_seat_pointer_notify_enter" [:pointer :pointer :double :double] :void)
159+(ffi/defcfn seat-pointer-notify-motion "wlr_seat_pointer_notify_motion" [:pointer :uint32 :double :double] :void)
160+(ffi/defcfn seat-pointer-notify-button "wlr_seat_pointer_notify_button" [:pointer :uint32 :uint32 :int] :uint32)
161+(ffi/defcfn seat-pointer-notify-axis "wlr_seat_pointer_notify_axis" [:pointer :uint32 :int :double :int32 :int :int] :void)
162+(ffi/defcfn seat-pointer-notify-frame "wlr_seat_pointer_notify_frame" [:pointer] :void)
163+(ffi/defcfn seat-pointer-clear-focus "wlr_seat_pointer_clear_focus" [:pointer] :void)
164+(ffi/defcfn seat-keyboard-notify-enter "wlr_seat_keyboard_notify_enter" [:pointer :pointer :pointer :size_t :pointer] :void)
165+(ffi/defcfn seat-keyboard-notify-key "wlr_seat_keyboard_notify_key" [:pointer :uint32 :uint32 :uint32] :void)
166+(ffi/defcfn seat-keyboard-notify-modifiers "wlr_seat_keyboard_notify_modifiers" [:pointer :pointer] :void)
167+(ffi/defcfn keyboard-from-input-device "wlr_keyboard_from_input_device" [:pointer] :pointer)
168+(ffi/defcfn keyboard-set-keymap "wlr_keyboard_set_keymap" [:pointer :pointer] :bool)
169+(ffi/defcfn keyboard-set-repeat-info "wlr_keyboard_set_repeat_info" [:pointer :int32 :int32] :void)
170+
171+(ffi/load-library "libXi.so.6")
172+(ffi/defcfn wl-event-loop-add-fd "wl_event_loop_add_fd" [:pointer :int :uint32 :pointer :pointer] :pointer)
173+(ffi/defcfn xdg-popup-destroy "wlr_xdg_popup_destroy" [:pointer] :void)
174+(ffi/defcfn x-query-extension "XQueryExtension" [:pointer :string :pointer :pointer :pointer] :int)
175+(ffi/defcfn xi-query-version "XIQueryVersion" [:pointer :pointer :pointer] :int)
176+(ffi/defcfn xi-select-events "XISelectEvents" [:pointer :long :pointer :int] :int)
177+(ffi/defcfn x-pending "XPending" [:pointer] :int)
178+(ffi/defcfn x-next-event "XNextEvent" [:pointer :pointer] :int)
179+(ffi/defcfn x-get-event-data "XGetEventData" [:pointer :pointer] :int)
180+(ffi/defcfn x-free-event-data "XFreeEventData" [:pointer :pointer] :void)
181+(ffi/defcfn x-query-pointer "XQueryPointer"
182+ [:pointer :long :pointer :pointer :pointer :pointer :pointer :pointer :pointer] :int)
183+(ffi/defcfn x-default-root-window "XDefaultRootWindow" [:pointer] :long)
184+(ffi/defcfn x-connection-number "XConnectionNumber" [:pointer] :int)
185+(ffi/defcfn x-open-display "XOpenDisplay" [:pointer] :pointer)
186+(ffi/defcfn x-flush "XFlush" [:pointer] :int)
187+(ffi/defcfn x-shape-combine-rectangles "XShapeCombineRectangles"
188+ [:pointer :long :int :int :int :pointer :int :int :int] :void)
189+
190+;; --- memory helpers ---------------------------------------------------------------
191+
192+(def arena (ffi/global-arena))
193+(defn ptr [p k] (ffi/read p :pointer (off k)))
194+(defn i32 [p k] (ffi/read p :int (off k)))
195+(defn u32 [p k] (ffi/read p :uint32 (off k)))
196+(defn f64 [p k] (ffi/read p :double (off k)))
197+(defn flag [p k] (not (zero? (ffi/read p :uint8 (off k)))))
198+(defn field [p k] (+ p (off k)))
199+
200+;; Scratch buffers reused by every callback; this compositor is single-threaded.
201+(def out-a (ffi/alloc arena 8))
202+(def out-b (ffi/alloc arena 8))
203+(def box-buf (ffi/alloc arena (off :wlr_box/sizeof)))
204+(def usable-buf (ffi/alloc arena (off :wlr_box/sizeof)))
205+(def timespec (ffi/alloc arena (off :timespec/sizeof)))
206+
207+(defn write-box! [buf x y w h]
208+ (ffi/write buf :int x (off :wlr_box/x))
209+ (ffi/write buf :int y (off :wlr_box/y))
210+ (ffi/write buf :int w (off :wlr_box/width))
211+ (ffi/write buf :int h (off :wlr_box/height))
212+ buf)
213+
214+;; --- signals ----------------------------------------------------------------------
215+;; wl_signal_add is a static inline in C. Every listener here shares ONE native
216+;; callback, which looks the listener's address up in `handlers`; listeners come
217+;; from a free list, so surfaces that come and go don't leak callbacks.
218+
219+(def handlers (atom {}))
220+(def free-listeners (atom ()))
221+
222+(defn- dispatch [listener data]
223+ (when-let [f (get @handlers listener)]
224+ (try (f data)
225+ (catch Throwable e
226+ (binding [*out* *err*] (println "wayland-bar-compositor: handler failed:" e))))))
227+
228+(def notify (ffi/callback arena dispatch [:pointer :pointer] :void))
229+
230+(defn listen!
231+ "Hook f onto the wl_signal at address `signal`. Answers the listener."
232+ [signal f]
233+ (let [listener (or (let [[l] @free-listeners] (when l (swap! free-listeners rest) l))
234+ (ffi/alloc arena (off :wl_listener/sizeof)))]
235+ (ffi/write listener :pointer notify (off :wl_listener/notify))
236+ (swap! handlers assoc listener f)
237+ ;; wl_list_insert(signal->listener_list.prev, &listener->link)
238+ (wl-list-insert (ffi/read signal :pointer 0) (field listener :wl_listener/link))
239+ listener))
240+
241+(defn unlisten! [& listeners]
242+ (doseq [l listeners]
243+ (wl-list-remove (field l :wl_listener/link))
244+ (swap! handlers dissoc l)
245+ (swap! free-listeners conj l)))
246+
247+;; --- the server -----------------------------------------------------------------
248+
249+(def width (:width opts))
250+(def height (:height opts))
251+(def display (wl-display-create))
252+(def event-loop (wl-display-get-event-loop display))
253+(def backend (backend-autocreate event-loop 0))
254+(when (zero? backend) (die "no wlroots backend; is DISPLAY set and WLR_BACKENDS=x11?"))
255+(def renderer (renderer-autocreate backend))
256+(when (zero? renderer) (die "no renderer"))
257+(renderer-init-wl-display renderer display)
258+(def allocator (allocator-autocreate backend renderer))
259+(when (zero? allocator) (die "no allocator"))
260+
261+(compositor-create display 5 renderer)
262+(subcompositor-create display)
263+(data-device-manager-create display)
264+(primary-selection-manager-create display)
265+(data-control-manager-create display)
266+(viewporter-create display)
267+(fractional-scale-manager-create display 1)
268+(single-pixel-buffer-manager-create display)
269+(screencopy-manager-create display)
270+(xdg-activation-create display)
271+(presentation-create display backend 2)
272+
273+(def output-layout (output-layout-create display))
274+(xdg-output-manager-create display output-layout)
275+(def scene (scene-create))
276+(def scene-layout (scene-attach-output-layout scene output-layout))
277+(def root (field scene :wlr_scene/tree))
278+
279+;; Layer-shell layers, bottom to top; popups float above everything.
280+(def layer-trees (vec (repeatedly 4 #(scene-tree-create root))))
281+(def toplevel-tree (scene-tree-create root))
282+(def popup-tree (scene-tree-create root))
283+
284+(def output (atom nil)) ; the one wlr_output
285+(def layer-surfaces (atom {})) ; wlr_layer_surface_v1 -> scene layer surface
286+(def popups (atom {})) ; wlr_xdg_popup -> scene tree
287+
288+;; --- X11 window shape --------------------------------------------------------------
289+
290+(def x-display (x-open-display 0))
291+(when (zero? x-display) (die "cannot open the X display"))
292+(def x-window (atom nil))
293+(def shown-rects (atom nil))
294+(def max-rects 1024)
295+(def rect-buf (ffi/alloc arena (* 8 max-rects))) ; XRectangle { short x, y; ushort w, h }
296+
297+(defn find-x-window
298+ "wlroots owns the X11 window; we gave it a unique title, so look it up."
299+ []
300+ (let [out (:out (p/sh "xwininfo" "-name" (:title opts)))]
301+ (some->> (re-find #"Window id: (0x[0-9a-f]+)" out) second (#(Long/parseLong (subs % 2) 16)))))
302+
303+(defn popup-rects
304+ "Layout-space boxes of every mapped popup: its geometry, without shadows."
305+ []
306+ (for [[popup tree] @popups
307+ :let [base (ptr popup :wlr_xdg_popup/base)
308+ surface (ptr base :wlr_xdg_surface/surface)]
309+ :when (flag surface :wlr_surface/mapped)
310+ :let [_ (scene-node-coords (field tree :wlr_scene_tree/node) out-a out-b)
311+ geo (field base :wlr_xdg_surface/geometry)
312+ w (i32 geo :wlr_box/width)
313+ h (i32 geo :wlr_box/height)]
314+ :when (and (pos? w) (pos? h))]
315+ [(ffi/read out-a :int) (ffi/read out-b :int) w h]))
316+
317+;; Popups have rounded corners; their geometry box would show the black output
318+;; behind the corners. So read the frame about to be shown and trace each
319+;; corner row inward to the first painted pixel. Pixman frames are plain
320+;; memory, and only corner rows are scanned, only when the popups change.
321+
322+(def data-out (ffi/alloc arena 8))
323+(def format-out (ffi/alloc arena 4))
324+(def stride-out (ffi/alloc arena 8))
325+(def rgb32-formats #{0x34325258 0x34325241 0x34324258 0x34324241}) ; XRGB/ARGB/XBGR/ABGR8888
326+
327+;; Transparent margins and faint shadows composite onto the black output as
328+;; black or near-black; a popup's own background is well above this.
329+(def paint-threshold 10)
330+
331+(defn- painted? [px]
332+ (or (> (bit-and (bit-shift-right px 16) 0xff) paint-threshold)
333+ (> (bit-and (bit-shift-right px 8) 0xff) paint-threshold)
334+ (> (bit-and px 0xff) paint-threshold)))
335+
336+(defn- row-span
337+ "[left right) of the painted part of row y within [x, x+w); nil if none.
338+ The row is copied out in one call rather than read pixel by pixel."
339+ [data stride x y w]
340+ (let [row (ffi/read-array (+ data (* y stride)) :uint32 w (* 4 x))
341+ left (loop [i 0] (cond (= i w) nil (painted? (aget row i)) i :else (recur (inc i))))]
342+ (when left
343+ (let [right (loop [i (dec w)] (if (painted? (aget row i)) (inc i) (recur (dec i))))]
344+ [(+ x left) (+ x right)]))))
345+
346+(defn outline-rects
347+ "XShape rects for popup box [x y w h], following what the popup actually
348+ painted: rounded corners, and any transparent margin its geometry includes.
349+ Consecutive rows with the same span merge into one rect."
350+ [data stride [x y w h]]
351+ (let [rows (for [row (range y (+ y h))
352+ :let [[l r] (row-span data stride x row w)]
353+ :when l]
354+ [l row (- r l) 1])]
355+ (->> rows
356+ (reduce (fn [acc [rx ry rw rh :as rect]]
357+ (let [[px py pw ph] (peek acc)]
358+ (if (and px (= px rx) (= pw rw) (= (+ py ph) ry))
359+ (conj (pop acc) [px py pw (+ ph rh)])
360+ (conj acc rect))))
361+ []))))
362+
363+(defn- frame-outlines
364+ "Outline rects for every popup box, read from `buffer`; nil if unreadable."
365+ [buffer boxes]
366+ (when (and (pos? buffer)
367+ (buffer-begin-data-ptr-access buffer (off :enum/buffer-data-ptr-access-read)
368+ data-out format-out stride-out))
369+ (try
370+ (when (rgb32-formats (ffi/read format-out :uint32))
371+ (let [data (ffi/read data-out :pointer)
372+ stride (ffi/read stride-out :size_t)]
373+ (vec (mapcat (fn [[x y w h]]
374+ ;; clamp to the output so a scan never leaves the buffer
375+ (let [x (max 0 x) y (max 0 y)
376+ w (min w (- width x)) h (min h (- height y))]
377+ (when (and (pos? w) (pos? h))
378+ (outline-rects data stride [x y w h]))))
379+ boxes))))
380+ (finally (buffer-end-data-ptr-access buffer)))))
381+
382+(def shown-boxes (atom nil))
383+(def popups-dirty (atom false)) ; a popup committed since its outline was traced
384+
385+(defn update-shape!
386+ "Shape the window to the strip plus the popups' outlines. `buffer` is the
387+ frame about to be shown, or nil when nothing was rendered."
388+ [buffer]
389+ (when-not @x-window
390+ (reset! x-window (find-x-window)))
391+ (when-let [win @x-window]
392+ (let [boxes (vec (popup-rects))
393+ retrace? (and (seq boxes) (or (not= boxes @shown-boxes) (and buffer @popups-dirty)))
394+ outlines (when retrace?
395+ ;; tracing needs a rendered frame; without one, wait for it
396+ (when buffer
397+ (reset! popups-dirty false)
398+ (or (frame-outlines buffer boxes) boxes)))
399+ rects (cond
400+ (empty? boxes) [(:strip opts)]
401+ outlines (vec (take max-rects (cons (:strip opts) outlines)))
402+ :else nil)]
403+ (when (and rects (not= rects @shown-rects))
404+ (reset! shown-boxes boxes)
405+ (debug "shape" (count rects) "rects" (take 4 rects))
406+ (doseq [[i [x y w h]] (map-indexed vector rects)]
407+ (ffi/write rect-buf :short (short x) (* 8 i))
408+ (ffi/write rect-buf :short (short y) (+ 2 (* 8 i)))
409+ (ffi/write rect-buf :short (unchecked-short w) (+ 4 (* 8 i)))
410+ (ffi/write rect-buf :short (unchecked-short h) (+ 6 (* 8 i))))
411+ ;; ShapeBounding = 0, ShapeInput = 2; ShapeSet = 0; Unsorted = 0
412+ (x-shape-combine-rectangles x-display win 0 0 0 rect-buf (count rects) 0 0)
413+ (x-shape-combine-rectangles x-display win 2 0 0 rect-buf (count rects) 0 0)
414+ (x-flush x-display)
415+ (reset! shown-rects rects)))))
416+
417+;; --- outputs ------------------------------------------------------------------------
418+
419+(defn with-output-state [f]
420+ (let [state (ffi/alloc arena (off :wlr_output_state/sizeof))]
421+ (output-state-init state)
422+ (try (f state) (finally (output-state-finish state)))))
423+
424+(def child (atom nil))
425+(def frame-state (ffi/alloc arena (off :wlr_output_state/sizeof))) ; reused every frame
426+
427+(defn arrange-layers! []
428+ (write-box! box-buf 0 0 width height)
429+ (write-box! usable-buf 0 0 width height)
430+ (doseq [[_ scene-ls] @layer-surfaces]
431+ (scene-layer-surface-configure scene-ls box-buf usable-buf)))
432+
433+(listen! (field backend :wlr_backend/events.new_output)
434+ (fn [wlr-output]
435+ (if @output
436+ (println "wayland-bar-compositor: ignoring extra output")
437+ (do
438+ (reset! output wlr-output)
439+ (output-init-render wlr-output allocator renderer)
440+ (with-output-state
441+ (fn [state]
442+ (output-state-set-enabled state true)
443+ (output-state-set-custom-mode state width height 0)
444+ (output-commit-state wlr-output state)))
445+ (when (output-is-x11 wlr-output)
446+ (x11-output-set-title wlr-output (:title opts)))
447+ (let [scene-output (scene-output-create scene wlr-output)]
448+ (scene-output-layout-add-output scene-layout (output-layout-add-auto output-layout wlr-output) scene-output)
449+ (listen! (field wlr-output :wlr_output/events.frame)
450+ (fn [_]
451+ ;; wlr_scene_output_commit, split open so the frame can be read
452+ ;; for popup outlines between rendering and showing it.
453+ (if (scene-output-needs-frame scene-output)
454+ (do
455+ (output-state-init frame-state)
456+ (try
457+ (when (scene-output-build-state scene-output frame-state 0)
458+ (update-shape! (when (pos? (bit-and (u32 frame-state :wlr_output_state/committed)
459+ (off :enum/output-state-buffer)))
460+ (ptr frame-state :wlr_output_state/buffer)))
461+ (output-commit-state wlr-output frame-state))
462+ (finally (output-state-finish frame-state))))
463+ (update-shape! nil))
464+ (clock-gettime 1 timespec) ; CLOCK_MONOTONIC
465+ (scene-output-send-frame-done scene-output timespec)))
466+ (listen! (field wlr-output :wlr_output/events.request_state)
467+ (fn [event]
468+ (output-commit-state wlr-output (ptr event :wlr_output_event_request_state/state)))))))))
469+
470+;; --- layer shell -----------------------------------------------------------------
471+
472+(def layer-shell (layer-shell-create display 4))
473+(declare add-popup!)
474+
475+(listen! (field layer-shell :wlr_layer_shell_v1/events.new_surface)
476+ (fn [ls]
477+ (when (zero? (ptr ls :wlr_layer_surface_v1/output))
478+ (ffi/write ls :pointer (or @output 0) (off :wlr_layer_surface_v1/output)))
479+ (let [layer (min 3 (max 0 (i32 ls :wlr_layer_surface_v1/current.layer)))
480+ scene-ls (scene-layer-surface-create (nth layer-trees layer) ls)
481+ surface (ptr ls :wlr_layer_surface_v1/surface)]
482+ ;; popups find their parent's scene tree through data
483+ (ffi/write ls :pointer (ptr scene-ls :wlr_scene_layer_surface_v1/tree) (off :wlr_layer_surface_v1/data))
484+ (swap! layer-surfaces assoc ls scene-ls)
485+ (let [commit (listen! (field surface :wlr_surface/events.commit)
486+ (fn [_] (when (flag ls :wlr_layer_surface_v1/initialized) (arrange-layers!))))
487+ ;; xdg-shell announces a layer surface's popup before it has a
488+ ;; parent; this signal comes once the parent is set.
489+ new-popup (listen! (field ls :wlr_layer_surface_v1/events.new_popup) add-popup!)
490+ destroy (atom nil)]
491+ (reset! destroy
492+ (listen! (field ls :wlr_layer_surface_v1/events.destroy)
493+ (fn [_]
494+ (swap! layer-surfaces dissoc ls)
495+ (unlisten! commit new-popup @destroy))))))))
496+
497+;; --- xdg shell -------------------------------------------------------------------
498+
499+(def xdg-shell (xdg-shell-create display 6))
500+
501+(listen! (field xdg-shell :wlr_xdg_shell/events.new_toplevel)
502+ (fn [toplevel]
503+ (let [base (ptr toplevel :wlr_xdg_toplevel/base)
504+ tree (scene-xdg-surface-create toplevel-tree base)
505+ surface (ptr base :wlr_xdg_surface/surface)]
506+ (ffi/write base :pointer tree (off :wlr_xdg_surface/data))
507+ (let [commit (listen! (field surface :wlr_surface/events.commit)
508+ (fn [_] (when (flag base :wlr_xdg_surface/initial_commit)
509+ (xdg-toplevel-set-size toplevel 0 0))))
510+ destroy (atom nil)]
511+ (reset! destroy
512+ (listen! (field toplevel :wlr_xdg_toplevel/events.destroy)
513+ (fn [_] (unlisten! commit @destroy))))))))
514+
515+(defn parent-tree
516+ "The scene tree a popup's parent surface draws into: an xdg surface's or a
517+ layer surface's, both kept in their data field."
518+ [parent-surface]
519+ (let [xdg (xdg-surface-try-from-wlr-surface parent-surface)]
520+ (if (pos? xdg)
521+ (ptr xdg :wlr_xdg_surface/data)
522+ (let [ls (layer-surface-try-from-wlr-surface parent-surface)]
523+ (when (pos? ls) (ptr ls :wlr_layer_surface_v1/data))))))
524+
525+(defn add-popup!
526+ "Put a popup whose parent is set into the scene, under its parent's tree."
527+ [popup]
528+ (let [base (ptr popup :wlr_xdg_popup/base)
529+ surface (ptr base :wlr_xdg_surface/surface)
530+ parent (parent-tree (ptr popup :wlr_xdg_popup/parent))]
531+ (debug "add popup" popup "parent tree" parent)
532+ (if-not parent
533+ (println "wayland-bar-compositor: popup with no known parent")
534+ (let [tree (scene-xdg-surface-create parent base)]
535+ (ffi/write base :pointer tree (off :wlr_xdg_surface/data))
536+ (swap! popups assoc popup tree)
537+ (let [commit (listen! (field surface :wlr_surface/events.commit)
538+ (fn [_]
539+ ;; new content may change the outline (a client's
540+ ;; first buffer is often blank), so retrace it
541+ (reset! popups-dirty true)
542+ (when (flag base :wlr_xdg_surface/initial_commit)
543+ ;; keep the popup inside the output, in parent-relative space
544+ (scene-node-coords (field parent :wlr_scene_tree/node) out-a out-b)
545+ (xdg-popup-unconstrain-from-box
546+ popup (write-box! box-buf (- (ffi/read out-a :int)) (- (ffi/read out-b :int)) width height))
547+ (xdg-surface-schedule-configure base))))
548+ destroy (atom nil)]
549+ (reset! destroy
550+ (listen! (field popup :wlr_xdg_popup/events.destroy)
551+ (fn [_]
552+ (swap! popups dissoc popup)
553+ (unlisten! commit @destroy)))))))))
554+
555+;; A layer surface's popup arrives here with no parent yet and again, parented,
556+;; on the layer surface's own new_popup; only take the parented ones here.
557+(listen! (field xdg-shell :wlr_xdg_shell/events.new_popup)
558+ (fn [popup]
559+ (when (pos? (ptr popup :wlr_xdg_popup/parent))
560+ (add-popup! popup))))
561+
562+;; --- clicks on X11 apps close popups --------------------------------------------
563+;; A click on an X11 window never reaches Wayland, so popups' own grabs can't
564+;; see it. XInput2 raw button presses on the root window report every click
565+;; without grabbing anything; if the pointer is outside what our window shows,
566+;; close the open popups. Layouts below checked against the X11/XI2 headers.
567+
568+(def generic-event 35)
569+(def xi-raw-button-press 15)
570+
571+(def xi-opcode
572+ (let [opcode (ffi/alloc arena 4) event (ffi/alloc arena 4) error (ffi/alloc arena 4)]
573+ (when (pos? (x-query-extension x-display "XInputExtension" opcode event error))
574+ (ffi/read opcode :int))))
575+
576+(if-not xi-opcode
577+ (println "wayland-bar-compositor: no XInput2; clicks on X11 apps won't close popups")
578+ (let [major (ffi/alloc arena 4) minor (ffi/alloc arena 4)
579+ mask (ffi/alloc arena 5) ; XIMaskLen(XI_LASTEVENT)
580+ event-mask (ffi/alloc arena 16)] ; XIEventMask { deviceid; mask_len; mask* }
581+ (ffi/write major :int 2)
582+ (ffi/write minor :int 0)
583+ (xi-query-version x-display major minor) ; required before XI2 selection
584+ (ffi/write mask :uint8 (bit-shift-left 1 (mod xi-raw-button-press 8)) (quot xi-raw-button-press 8))
585+ (ffi/write event-mask :int 1 0) ; XIAllMasterDevices
586+ (ffi/write event-mask :int 5 4)
587+ (ffi/write event-mask :pointer mask 8)
588+ (xi-select-events x-display (x-default-root-window x-display) event-mask 1)
589+ (x-flush x-display)))
590+
591+(def x-event (ffi/alloc arena 192)) ; sizeof(XEvent)
592+(def query-bufs (vec (repeatedly 7 #(ffi/alloc arena 8))))
593+
594+(defn pointer-in-window?
595+ "Whether the pointer is over a part of our window that is shown."
596+ []
597+ (let [[root child root-x root-y win-x win-y buttons] query-bufs]
598+ (x-query-pointer x-display @x-window root child root-x root-y win-x win-y buttons)
599+ (let [x (ffi/read win-x :int) y (ffi/read win-y :int)]
600+ (some (fn [[rx ry rw rh]] (and (<= rx x) (< x (+ rx rw)) (<= ry y) (< y (+ ry rh))))
601+ @shown-rects))))
602+
603+(defn dismiss-popups!
604+ "Destroy the top-level popups; wlroots takes their child popups with them."
605+ []
606+ (let [roots (doall (for [[popup _] @popups
607+ :when (zero? (xdg-surface-try-from-wlr-surface (ptr popup :wlr_xdg_popup/parent)))]
608+ popup))]
609+ (debug "click outside on X11: closing" (count roots) "popup(s)")
610+ (doseq [popup roots] (xdg-popup-destroy popup))))
611+
612+(defn drain-x-events! []
613+ (while (pos? (x-pending x-display))
614+ (x-next-event x-display x-event)
615+ (when (and xi-opcode
616+ (= (ffi/read x-event :int 0) generic-event) ; cookie.type
617+ (= (ffi/read x-event :int 32) xi-opcode) ; cookie.extension
618+ (pos? (x-get-event-data x-display x-event)))
619+ (let [evtype (ffi/read x-event :int 36)] ; cookie.evtype
620+ (x-free-event-data x-display x-event)
621+ (when (and (= evtype xi-raw-button-press) (seq @popups) @x-window (not (pointer-in-window?)))
622+ (dismiss-popups!))))))
623+
624+(def x-fd-ready
625+ (ffi/callback arena
626+ (fn [_fd _mask _data]
627+ (try (drain-x-events!)
628+ (catch Throwable e
629+ (binding [*out* *err*] (println "wayland-bar-compositor: X event handling failed:" e))))
630+ 0)
631+ [:int :uint32 :pointer] :int))
632+
633+(when xi-opcode
634+ (wl-event-loop-add-fd event-loop (x-connection-number x-display) 1 x-fd-ready 0)) ; WL_EVENT_READABLE
635+
636+;; --- seat and input ----------------------------------------------------------------
637+
638+(def seat (seat-create display "seat0"))
639+(def cursor (cursor-create))
640+(cursor-attach-output-layout cursor output-layout)
641+(def cursor-manager (xcursor-manager-create 0 24))
642+(def keyboards (atom #{}))
643+
644+(defn surface-at
645+ "[surface sx sy] under layout point (lx, ly), or nil."
646+ [lx ly]
647+ (let [node (scene-node-at (field root :wlr_scene_tree/node) lx ly out-a out-b)]
648+ (when (and (pos? node) (= (i32 node :wlr_scene_node/type) (off :enum/scene-node-buffer)))
649+ (let [scene-surface (scene-surface-try-from-buffer (scene-buffer-from-node node))]
650+ (when (pos? scene-surface)
651+ [(ptr scene-surface :wlr_scene_surface/surface) (ffi/read out-a :double) (ffi/read out-b :double)])))))
652+
653+(defn focus-keyboard! [surface]
654+ (when-let [kb (first @keyboards)]
655+ (seat-keyboard-notify-enter seat surface (field kb :wlr_keyboard/keycodes)
656+ (ffi/read kb :size_t (off :wlr_keyboard/num_keycodes))
657+ (field kb :wlr_keyboard/modifiers))))
658+
659+(defn pointer-motion! [time]
660+ (debug "motion" (f64 cursor :wlr_cursor/x) (f64 cursor :wlr_cursor/y))
661+ (if-let [[surface sx sy] (surface-at (f64 cursor :wlr_cursor/x) (f64 cursor :wlr_cursor/y))]
662+ (do (seat-pointer-notify-enter seat surface sx sy)
663+ (seat-pointer-notify-motion seat time sx sy))
664+ (do (cursor-set-xcursor cursor cursor-manager "default")
665+ (seat-pointer-clear-focus seat))))
666+
667+(listen! (field cursor :wlr_cursor/events.motion)
668+ (fn [e]
669+ (cursor-move cursor (field (ptr e :wlr_pointer_motion_event/pointer) :wlr_pointer/base)
670+ (f64 e :wlr_pointer_motion_event/delta_x) (f64 e :wlr_pointer_motion_event/delta_y))
671+ (pointer-motion! (u32 e :wlr_pointer_motion_event/time_msec))))
672+
673+(listen! (field cursor :wlr_cursor/events.motion_absolute)
674+ (fn [e]
675+ (cursor-warp-absolute cursor (field (ptr e :wlr_pointer_motion_absolute_event/pointer) :wlr_pointer/base)
676+ (f64 e :wlr_pointer_motion_absolute_event/x) (f64 e :wlr_pointer_motion_absolute_event/y))
677+ (pointer-motion! (u32 e :wlr_pointer_motion_absolute_event/time_msec))))
678+
679+(listen! (field cursor :wlr_cursor/events.button)
680+ (fn [e]
681+ (seat-pointer-notify-button seat (u32 e :wlr_pointer_button_event/time_msec)
682+ (u32 e :wlr_pointer_button_event/button) (i32 e :wlr_pointer_button_event/state))
683+ (debug "button" (u32 e :wlr_pointer_button_event/button) "state" (i32 e :wlr_pointer_button_event/state)
684+ "at" (f64 cursor :wlr_cursor/x) (f64 cursor :wlr_cursor/y)
685+ "surface" (first (surface-at (f64 cursor :wlr_cursor/x) (f64 cursor :wlr_cursor/y))))
686+ (when (= (i32 e :wlr_pointer_button_event/state) (off :enum/button-pressed))
687+ (when-let [[surface] (surface-at (f64 cursor :wlr_cursor/x) (f64 cursor :wlr_cursor/y))]
688+ (focus-keyboard! surface)))))
689+
690+(listen! (field cursor :wlr_cursor/events.axis)
691+ (fn [e]
692+ (seat-pointer-notify-axis seat (u32 e :wlr_pointer_axis_event/time_msec)
693+ (i32 e :wlr_pointer_axis_event/orientation) (f64 e :wlr_pointer_axis_event/delta)
694+ (i32 e :wlr_pointer_axis_event/delta_discrete) (i32 e :wlr_pointer_axis_event/source)
695+ (i32 e :wlr_pointer_axis_event/relative_direction))))
696+
697+(listen! (field cursor :wlr_cursor/events.frame)
698+ (fn [_] (seat-pointer-notify-frame seat)))
699+
700+(listen! (field seat :wlr_seat/events.request_set_cursor)
701+ (fn [e]
702+ (when (= (ptr e :wlr_seat_pointer_request_set_cursor_event/seat_client)
703+ (ptr seat :wlr_seat/pointer_state.focused_client))
704+ (cursor-set-surface cursor (ptr e :wlr_seat_pointer_request_set_cursor_event/surface)
705+ (i32 e :wlr_seat_pointer_request_set_cursor_event/hotspot_x)
706+ (i32 e :wlr_seat_pointer_request_set_cursor_event/hotspot_y)))))
707+
708+(listen! (field seat :wlr_seat/events.request_set_selection)
709+ (fn [e] (seat-set-selection seat (ptr e :wlr_seat_request_set_selection_event/source)
710+ (u32 e :wlr_seat_request_set_selection_event/serial))))
711+
712+(listen! (field seat :wlr_seat/events.request_set_primary_selection)
713+ (fn [e] (seat-set-primary-selection seat (ptr e :wlr_seat_request_set_primary_selection_event/source)
714+ (u32 e :wlr_seat_request_set_primary_selection_event/serial))))
715+
716+(defn update-capabilities! []
717+ (seat-set-capabilities seat (bit-or (off :enum/seat-capability-pointer)
718+ (if (seq @keyboards) (off :enum/seat-capability-keyboard) 0))))
719+
720+(defn add-keyboard! [device]
721+ (let [kb (keyboard-from-input-device device)
722+ context (xkb-context-new 0)
723+ keymap (xkb-keymap-new-from-names context 0 0)]
724+ (keyboard-set-keymap kb keymap)
725+ (xkb-keymap-unref keymap)
726+ (xkb-context-unref context)
727+ (keyboard-set-repeat-info kb 25 600)
728+ (let [modifiers (listen! (field kb :wlr_keyboard/events.modifiers)
729+ (fn [_]
730+ (seat-set-keyboard seat kb)
731+ (seat-keyboard-notify-modifiers seat (field kb :wlr_keyboard/modifiers))))
732+ key (listen! (field kb :wlr_keyboard/events.key)
733+ (fn [e]
734+ (seat-set-keyboard seat kb)
735+ (seat-keyboard-notify-key seat (u32 e :wlr_keyboard_key_event/time_msec)
736+ (u32 e :wlr_keyboard_key_event/keycode)
737+ (u32 e :wlr_keyboard_key_event/state))))
738+ destroy (atom nil)]
739+ (reset! destroy
740+ (listen! (field device :wlr_input_device/events.destroy)
741+ (fn [_]
742+ (swap! keyboards disj kb)
743+ (unlisten! modifiers key @destroy)
744+ (update-capabilities!)))))
745+ (seat-set-keyboard seat kb)
746+ (swap! keyboards conj kb)))
747+
748+(listen! (field backend :wlr_backend/events.new_input)
749+ (fn [device]
750+ (let [type (i32 device :wlr_input_device/type)]
751+ (debug "new input device type" type)
752+ (cond
753+ (= type (off :enum/input-device-keyboard)) (add-keyboard! device)
754+ (= type (off :enum/input-device-pointer)) (cursor-attach-input-device cursor device)))
755+ (update-capabilities!)))
756+
757+;; --- run -----------------------------------------------------------------------------
758+
759+(def socket (wl-display-add-socket-auto display))
760+(when-not socket (die "cannot create a wayland socket"))
761+(when-not (backend-start backend) (die "backend failed to start"))
762+(println "wayland-bar-compositor: WAYLAND_DISPLAY" socket)
763+
764+(reset! child (p/process (:command opts) {:extra-env {"WAYLAND_DISPLAY" socket}
765+ :out :inherit :err :inherit}))
766+(.addShutdownHook (Runtime/getRuntime)
767+ (Thread. (fn [] (when @child (p/destroy @child)))))
768+
769+(while (p/alive? @child)
770+ (wl-event-loop-dispatch event-loop 250)
771+ ;; Xlib may have read events into its queue during our own X calls, where
772+ ;; the fd never becomes readable again; drain them here too.
773+ (drain-x-events!)
774+ (wl-display-flush-clients display))
775+
776+(println "wayland-bar-compositor:" (first (:command opts)) "exited")
777+(wl-display-destroy-clients display)
778+(System/exit 0)