From 68dd63f6b3de774863051b66e609a0ca4f4ac2a1 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Tue, 6 Jan 2026 15:09:52 -0700 Subject: [rebrand] to arken = runtime, montis = plugin --- .gitignore | 2 +- CMakeLists.txt | 20 +- README.md | 133 ++- arken/CMakeLists.txt | 149 +++ arken/include/plugin.h | 190 ++++ arken/include/plugin_types.h | 9 + arken/include/util.h | 19 + arken/include/wl.h | 125 +++ arken/src/plugin.c | 260 +++++ arken/src/util.c | 133 +++ arken/src/wl.c | 1135 +++++++++++++++++++++ arken/tools/genbuild.pl | 48 + arken/tools/genintf.pl | 42 + montis/README.md | 1 + montis/package.yaml | 87 ++ montis/src/Config.hs | 33 + montis/src/Link.hs | 18 + montis/src/Montis/Base/Foreign/Runtime.hs | 37 + montis/src/Montis/Base/Foreign/WlRoots.hs | 44 + montis/src/Montis/Base/Foreign/WlRoots/Types.hs | 99 ++ montis/src/Montis/Core.hs | 10 + montis/src/Montis/Core/Events.hs | 46 + montis/src/Montis/Core/Extensions.hs | 30 + montis/src/Montis/Core/Internal/Foreign/Export.hs | 226 ++++ montis/src/Montis/Core/Monad.hs | 125 +++ montis/src/Montis/Core/Plugin/Interface.hs | 20 + montis/src/Montis/Core/Runtime.hs | 82 ++ montis/src/Montis/Core/Start.hs | 38 + montis/src/Montis/Core/State.hs | 116 +++ montis/src/Montis/Core/State/Marshal.hs | 44 + montis/src/Montis/Foreign/Marshal.hs | 20 + montis/src/Montis/Standard/Drag.hs | 123 +++ montis/src/Montis/Standard/Keys.hs | 110 ++ montis/src/Montis/Standard/Mouse.hs | 50 + montis/src/harness_adapter.c | 73 ++ montis/stack.yaml | 67 ++ montis/test/Spec.hs | 2 + plug/README.md | 1 - plug/package.yaml | 87 -- plug/src/Config.hs | 33 - plug/src/Link.hs | 18 - plug/src/Montis/Base/Foreign/Runtime.hs | 37 - plug/src/Montis/Base/Foreign/WlRoots.hs | 44 - plug/src/Montis/Base/Foreign/WlRoots/Types.hs | 99 -- plug/src/Montis/Core.hs | 10 - plug/src/Montis/Core/Events.hs | 46 - plug/src/Montis/Core/Extensions.hs | 30 - plug/src/Montis/Core/Internal/Foreign/Export.hs | 226 ---- plug/src/Montis/Core/Monad.hs | 125 --- plug/src/Montis/Core/Plugin/Interface.hs | 20 - plug/src/Montis/Core/Runtime.hs | 82 -- plug/src/Montis/Core/Start.hs | 38 - plug/src/Montis/Core/State.hs | 116 --- plug/src/Montis/Core/State/Marshal.hs | 44 - plug/src/Montis/Foreign/Marshal.hs | 20 - plug/src/Montis/Standard/Drag.hs | 123 --- plug/src/Montis/Standard/Keys.hs | 110 -- plug/src/Montis/Standard/Mouse.hs | 50 - plug/src/harness_adapter.c | 73 -- plug/stack.yaml | 67 -- plug/test/Spec.hs | 2 - rt/CMakeLists.txt | 149 --- rt/include/plugin.h | 190 ---- rt/include/plugin_types.h | 9 - rt/include/util.h | 19 - rt/include/wl.h | 125 --- rt/src/plugin.c | 260 ----- rt/src/util.c | 133 --- rt/src/wl.c | 1135 --------------------- rt/tools/genbuild.pl | 48 - rt/tools/genintf.pl | 42 - 71 files changed, 3711 insertions(+), 3666 deletions(-) create mode 100644 arken/CMakeLists.txt create mode 100644 arken/include/plugin.h create mode 100644 arken/include/plugin_types.h create mode 100644 arken/include/util.h create mode 100644 arken/include/wl.h create mode 100644 arken/src/plugin.c create mode 100644 arken/src/util.c create mode 100644 arken/src/wl.c create mode 100644 arken/tools/genbuild.pl create mode 100644 arken/tools/genintf.pl create mode 100644 montis/README.md create mode 100644 montis/package.yaml create mode 100644 montis/src/Config.hs create mode 100644 montis/src/Link.hs create mode 100644 montis/src/Montis/Base/Foreign/Runtime.hs create mode 100644 montis/src/Montis/Base/Foreign/WlRoots.hs create mode 100644 montis/src/Montis/Base/Foreign/WlRoots/Types.hs create mode 100644 montis/src/Montis/Core.hs create mode 100644 montis/src/Montis/Core/Events.hs create mode 100644 montis/src/Montis/Core/Extensions.hs create mode 100644 montis/src/Montis/Core/Internal/Foreign/Export.hs create mode 100644 montis/src/Montis/Core/Monad.hs create mode 100644 montis/src/Montis/Core/Plugin/Interface.hs create mode 100644 montis/src/Montis/Core/Runtime.hs create mode 100644 montis/src/Montis/Core/Start.hs create mode 100644 montis/src/Montis/Core/State.hs create mode 100644 montis/src/Montis/Core/State/Marshal.hs create mode 100644 montis/src/Montis/Foreign/Marshal.hs create mode 100644 montis/src/Montis/Standard/Drag.hs create mode 100644 montis/src/Montis/Standard/Keys.hs create mode 100644 montis/src/Montis/Standard/Mouse.hs create mode 100644 montis/src/harness_adapter.c create mode 100644 montis/stack.yaml create mode 100644 montis/test/Spec.hs delete mode 100644 plug/README.md delete mode 100644 plug/package.yaml delete mode 100644 plug/src/Config.hs delete mode 100644 plug/src/Link.hs delete mode 100644 plug/src/Montis/Base/Foreign/Runtime.hs delete mode 100644 plug/src/Montis/Base/Foreign/WlRoots.hs delete mode 100644 plug/src/Montis/Base/Foreign/WlRoots/Types.hs delete mode 100644 plug/src/Montis/Core.hs delete mode 100644 plug/src/Montis/Core/Events.hs delete mode 100644 plug/src/Montis/Core/Extensions.hs delete mode 100644 plug/src/Montis/Core/Internal/Foreign/Export.hs delete mode 100644 plug/src/Montis/Core/Monad.hs delete mode 100644 plug/src/Montis/Core/Plugin/Interface.hs delete mode 100644 plug/src/Montis/Core/Runtime.hs delete mode 100644 plug/src/Montis/Core/Start.hs delete mode 100644 plug/src/Montis/Core/State.hs delete mode 100644 plug/src/Montis/Core/State/Marshal.hs delete mode 100644 plug/src/Montis/Foreign/Marshal.hs delete mode 100644 plug/src/Montis/Standard/Drag.hs delete mode 100644 plug/src/Montis/Standard/Keys.hs delete mode 100644 plug/src/Montis/Standard/Mouse.hs delete mode 100644 plug/src/harness_adapter.c delete mode 100644 plug/stack.yaml delete mode 100644 plug/test/Spec.hs delete mode 100644 rt/CMakeLists.txt delete mode 100644 rt/include/plugin.h delete mode 100644 rt/include/plugin_types.h delete mode 100644 rt/include/util.h delete mode 100644 rt/include/wl.h delete mode 100644 rt/src/plugin.c delete mode 100644 rt/src/util.c delete mode 100644 rt/src/wl.c delete mode 100644 rt/tools/genbuild.pl delete mode 100644 rt/tools/genintf.pl diff --git a/.gitignore b/.gitignore index fc1ccab..2eb9018 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,4 @@ -plug/.stack-work +montis/.stack-work *~ harness/build wtr.so diff --git a/CMakeLists.txt b/CMakeLists.txt index 18348ae..95296b6 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -3,32 +3,32 @@ project(montis LANGUAGES C) add_custom_target(wlroots_build ALL DEPENDS "${WLROOTS_LIB_LINK}") -add_subdirectory(rt) -add_dependencies(montis wlroots_build) +add_subdirectory(arken) +add_dependencies(arken wlroots_build) add_custom_target( plug_build ALL - COMMAND sh -c "if [ -d \"$1\" ] && [ ! -L \"$1\" ]; then rm -rf \"$2\"; mv \"$1\" \"$2\"; fi" sh "${CMAKE_SOURCE_DIR}/plug/.stack-work" "${CMAKE_BINARY_DIR}/stack-work" + COMMAND sh -c "if [ -d \"$1\" ] && [ ! -L \"$1\" ]; then rm -rf \"$2\"; mv \"$1\" \"$2\"; fi" sh "${CMAKE_SOURCE_DIR}/montis/.stack-work" "${CMAKE_BINARY_DIR}/stack-work" COMMAND "${CMAKE_COMMAND}" -E make_directory "${CMAKE_BINARY_DIR}/stack-work" - COMMAND "${CMAKE_COMMAND}" -E create_symlink "${CMAKE_BINARY_DIR}/stack-work" "${CMAKE_SOURCE_DIR}/plug/.stack-work" - COMMAND "${CMAKE_COMMAND}" -E chdir "${CMAKE_SOURCE_DIR}/plug" stack build + COMMAND "${CMAKE_COMMAND}" -E create_symlink "${CMAKE_BINARY_DIR}/stack-work" "${CMAKE_SOURCE_DIR}/montis/.stack-work" + COMMAND "${CMAKE_COMMAND}" -E chdir "${CMAKE_SOURCE_DIR}/montis" stack build # Not sure why stack is generating an a.out file, but remove it. - COMMAND "${CMAKE_COMMAND}" -E rm -f "${CMAKE_SOURCE_DIR}/plug/a.out" - DEPENDS montis + COMMAND "${CMAKE_COMMAND}" -E rm -f "${CMAKE_SOURCE_DIR}/montis/a.out" + DEPENDS arken COMMENT "Building Haskell plugin with Stack" VERBATIM ) add_custom_target( run - COMMAND sh -c "PLUGIN_SO=$(find '${CMAKE_BINARY_DIR}/stack-work' -name montis.so -type f | head -n 1); if [ -z \"$PLUGIN_SO\" ]; then echo 'montis.so not found in ${CMAKE_BINARY_DIR}/stack-work' 1>&2; exit 1; fi; \"$\" -s foot -p \"$PLUGIN_SO\"" - DEPENDS montis plug_build + COMMAND sh -c "PLUGIN_SO=$(find '${CMAKE_BINARY_DIR}/stack-work' -name montis.so -type f | head -n 1); if [ -z \"$PLUGIN_SO\" ]; then echo 'montis.so not found in ${CMAKE_BINARY_DIR}/stack-work' 1>&2; exit 1; fi; \"$\" -s foot -p \"$PLUGIN_SO\"" + DEPENDS arken plug_build USES_TERMINAL VERBATIM ) -install(TARGETS montis RUNTIME DESTINATION bin) +install(TARGETS arken RUNTIME DESTINATION bin) install(CODE [[ execute_process( diff --git a/README.md b/README.md index a7d3eeb..b722f5a 100644 --- a/README.md +++ b/README.md @@ -1,44 +1,89 @@ -# Wetterhorn - -Wetterhorn is a wlroots-based Wayland compositor inspired by XMonad. It has a -unique harness-plugin architecture to support hot-reloading of some code. The -goal is to have as much code as feasible hot-reloadable. - -This is accomplished by Wetterhorn's architecture. It has 2 parts: - - - A harness, written in C, that provides the core of interacting with Wayland. - It is based off tinywl, dwl, weston and others. The window management and - event handling duties are stubbed out though, relying on a plugin to manage - those. - - - A plugin, written in Haskell, which provides the "configuration" for - handling events and window management. This plugin could theoretically be - replaced by any other program implementing the stubs. - - The aim is for the plugin to contain as much logic as possible as it is - likely to be written in a safe language. - -This architecture provides some benefits. - - 1. It provides speed where it counts by having the compositor bits being - written in a language like C. - - 2. It provides safety and expressiveness where it counts by having the logic - and handlers written in a higher level language, like Haskell. - - 3. Right now the harness and Haskell plugin are coupled together, but in the - future the boundary between the plugin and harness can be generalized to - allow different plugins to be used if one particularly does not like the - haskell implementation. - - 4. It enables hot-reloading. This is a huge benefit, and the main impetus for - this architecture. With X11, the Window Manager was a separate binary that - could be reloaded without killing the whole session. This is not the case - for Wayland because the Window Manager and Compositor are the same binary. - This is great for performance, but really bad for window managers like DWM - and XMonad which rely on the hot-swappability as these WMs source code _is_ - their configuration. - - Now, when a changes is made to the plugin, it can be hot-reloaded by the - harness, theoretically providing the best of both worlds in terms of - performance and configuration expressiveness. + +``` +Ladies and Gentlemen, this is + +• ▌ ▄ ·. ▐ ▄ ▄▄▄▄▄▪ .▄▄ · +·██ ▐███▪▪ •█▌▐█•██ ██ ▐█ ▀. +▐█ ▌▐▌▐█· ▄█▀▄ ▐█▐▐▌ ▐█.▪▐█·▄▀▀▀█▄ +██ ██▌▐█▌▐█▌.▐▌██▐█▌ ▐█▌·▐█▌▐█▄▪▐█ +▀▀ █▪▀▀▀ ▀█▄▀▪▀▀ █▪ ▀▀▀ ▀▀▀ ▀▀▀▀ +``` + +Montis is a pluggable Wayland compositor, designed to make *hot-pluggable window +management* a thing of the present ... again! + + +## What Is It + +Montis is intentionally split into two components, each with a very different role. + +### Arken -- The Runtime + +**Arken** is the small, stable executable at the heart of the system. It very +much *is* the compositor. + +* It is the compositor runtime. +* It sets up wlroots, Wayland invariants, and lifecycle management. +* It persists ocross reload. +* It is deliberately lean: a harness, not an engine + +Arken exists to keep the window system alive while everything interesting +changes around it. + +### Montis -- The Window Manager + +Montis is the window management logic, written in Haskell. + +* It compiles to a shared object (.so) +* It is loaded into Arken at runtime +* It can be edited, recompiled, and hot-reloaded on the fly +* No compositor restart required + +Montis is not a DSL and not a configuration file. It is the window manager. +Written in a Turing-complete programming language with full access to the Arken +runtime and wlroots itself. + +### Why This is Powerful + +Montis takes direct inspiration from XMonad. + +XMonad is often described as a window manager “configured in Haskell”, but +that’s misleading. In reality: + +* XMonad is a library +* Your “configuration” is just a cleverly hidden main +* You can rip the abstraction layer off entirely if you want +* The configuration language is arbitrarily powerful + +That power is fundamentally impossible to replicate with window managers that +invent their own configuration formats. + +However, XMonad has one major downside: + + Because the configuration is the window manager, changing it requires a full + recompile—and a restart. + +On X11, that’s fine. The window manager is a separate process from the windowing +system. + +On Wayland, that model collapses. The compositor is the window system. +Restarting it kills every GUI application. + +### Montis's Mandate + +Montis exists to answer a simple question: + + Can we get XMonad-style window management configuration on Wayland without + restarting the compositor? + +The constraints are strict: + +* Like XMonad, the configuration is the window manager +* Changes must not require restarting the window system +* No IPC-heavy control planes +* No bespoke configuration languages + +The solution is a pluggable architecture: + +* A persistent runtime (Arken) that owns wlroots and the Wayland lifecycle +* A hot-reloadable window manager (Montis) that owns behavior diff --git a/arken/CMakeLists.txt b/arken/CMakeLists.txt new file mode 100644 index 0000000..2bfd1d7 --- /dev/null +++ b/arken/CMakeLists.txt @@ -0,0 +1,149 @@ +cmake_minimum_required(VERSION 3.10) +project ( + arken + VERSION 0.1 + LANGUAGES C) + +set(CMAKE_VERBOSE_MAKEFILE ON) +set(CMAKE_BUILD_TYPE Debug) + +set(WLROOTS_VERSION "0.18") +set(WLROOTS_URL "https://gitlab.freedesktop.org/wlroots/wlroots/-/archive/${WLROOTS_VERSION}/wlroots-${WLROOTS_VERSION}.tar.gz") +set(WLROOTS_TARBALL "${CMAKE_BINARY_DIR}/wlroots-${WLROOTS_VERSION}.tar.gz") +set(WLROOTS_SOURCE_DIR "${CMAKE_BINARY_DIR}/wlroots-src") +set(WLROOTS_BUILD_DIR "${CMAKE_BINARY_DIR}/wlroots") +set(WLROOTS_LIB_STATIC "${WLROOTS_BUILD_DIR}/libwlroots-${WLROOTS_VERSION}.a") +set(WLROOTS_LIB_LINK "${WLROOTS_BUILD_DIR}/libwlroots.a") + +add_custom_command( + OUTPUT "${WLROOTS_LIB_LINK}" + COMMAND sh -c "if [ ! -d \"$1\" ]; then mkdir -p \"$1\" && curl -L \"$2\" | tar xzf - --strip-components=1 -C \"$1\"; fi" sh "${WLROOTS_SOURCE_DIR}" "${WLROOTS_URL}" + COMMAND "${CMAKE_COMMAND}" -E make_directory "${WLROOTS_BUILD_DIR}" + COMMAND meson setup --reconfigure -Ddefault_library=static "${WLROOTS_BUILD_DIR}" "${WLROOTS_SOURCE_DIR}" + COMMAND meson compile -C "${WLROOTS_BUILD_DIR}" + COMMAND "${CMAKE_COMMAND}" -E create_symlink "${WLROOTS_LIB_STATIC}" "${WLROOTS_LIB_LINK}" + WORKING_DIRECTORY "${CMAKE_SOURCE_DIR}" + COMMENT "Building wlroots via Meson (static)" + VERBATIM +) + +include_directories(include/ /usr/include/pixman-1 + ${CMAKE_CURRENT_BINARY_DIR}/ + ${WLROOTS_SOURCE_DIR}/include + ${WLROOTS_BUILD_DIR}/include + ${WLROOTS_BUILD_DIR}/protocol +) + +add_definitions(-DWLR_USE_UNSTABLE) + +execute_process( + COMMAND pkg-config --variable=pkgdatadir wayland-protocols + OUTPUT_VARIABLE WAYLAND_PROTOCOLS + RESULT_VARIABLE ec + OUTPUT_STRIP_TRAILING_WHITESPACE +) +if(${ec} EQUAL 0) +else() + message(FATAL_ERROR "Failed to execute pkg-config") +endif() + +execute_process( + COMMAND pkg-config --variable=wayland_scanner wayland-scanner + OUTPUT_VARIABLE WAYLAND_SCANNER + RESULT_VARIABLE ec + OUTPUT_STRIP_TRAILING_WHITESPACE +) +if(${ec} EQUAL 0) +else() + message(FATAL_ERROR "Failed to execute pkg-config") +endif() + +set(PLUGIN_INTF ${CMAKE_BINARY_DIR}/plugin_interface.h) +add_custom_command( + OUTPUT ${PLUGIN_INTF} + COMMAND perl ${PROJECT_SOURCE_DIR}/tools/genintf.pl < + ${PROJECT_SOURCE_DIR}/include/plugin.h > ${PLUGIN_INTF} + DEPENDS ${PROJECT_SOURCE_DIR}/include/plugin.h + DEPENDS ${PROJECT_SOURCE_DIR}/tools/genintf.pl +) + +set(PLUGIN_LOAD ${CMAKE_BINARY_DIR}/gen_plugin_load.c) +add_custom_command( + OUTPUT ${PLUGIN_LOAD} + COMMAND perl ${PROJECT_SOURCE_DIR}/tools/genbuild.pl < + ${PROJECT_SOURCE_DIR}/include/plugin.h > ${PLUGIN_LOAD} + DEPENDS ${PROJECT_SOURCE_DIR}/include/plugin.h + DEPENDS ${PROJECT_SOURCE_DIR}/tools/genbuild.pl +) + +add_custom_command( + OUTPUT xdg-shell-protocol.h + COMMAND ${WAYLAND_SCANNER} server-header + ${WAYLAND_PROTOCOLS}/stable/xdg-shell/xdg-shell.xml + xdg-shell-protocol.h +) + +add_custom_command( + OUTPUT xdg-shell-protocol.c + COMMAND ${WAYLAND_SCANNER} private-code + ${WAYLAND_PROTOCOLS}/stable/xdg-shell/xdg-shell.xml + xdg-shell-protocol.c + DEPENDS xdg-shell-protocol.h +) + +file (GLOB_RECURSE SOURCES src/*.c) + +set(CMAKE_EXPORT_COMPILE_COMMANDS ON) + +add_executable (arken ${SOURCES} ${PLUGIN_LOAD} ${PLUGIN_INTF} ${WLROOTS_LIB_LINK} + xdg-shell-protocol.c) + +find_package(PkgConfig REQUIRED) + +pkg_check_modules(WLREQ REQUIRED IMPORTED_TARGET + wayland-server + wayland-client + wayland-egl + wayland-cursor + xkbcommon + pixman-1 + libinput + libudev + libseat + libdrm + gbm + egl + glesv2 +) + +target_link_libraries(arken PRIVATE PkgConfig::WLREQ dl pthread ${WLROOTS_LIB_LINK}) + +pkg_check_modules(WLOPT IMPORTED_TARGET + cairo + lcms2 + libdisplay-info + libliftoff + vulkan + xwayland + xcb + xcb-composite + xcb-dri3 + xcb-errors + xcb-ewmh + xcb-icccm + xcb-present + xcb-render + xcb-renderutil + xcb-res + xcb-shm + xcb-xfixes + xcb-xinput +) + +if(WLOPT_FOUND) + target_link_libraries(arken PRIVATE PkgConfig::WLOPT) +endif() + +target_link_directories(arken PUBLIC + "${WLROOTS_BUILD_DIR}") +target_link_options(arken PRIVATE -rdynamic) diff --git a/arken/include/plugin.h b/arken/include/plugin.h new file mode 100644 index 0000000..3098602 --- /dev/null +++ b/arken/include/plugin.h @@ -0,0 +1,190 @@ +#ifndef _PLUGIN_H_ +#define _PLUGIN_H_ + +#include +#include +#include +#include +#include +#include +#include + +#include "plugin_types.h" + +/* + * Marker macro to define what functions should be exported. This generates the + * interface which the plugin needs to implement. + */ +#define EXPORT(a) a + +#define EXPORT_INCLUDE(a) + +// clang-format off +EXPORT_INCLUDE() +EXPORT_INCLUDE() +EXPORT_INCLUDE() +// clang-format on + +#define MAX_QUEUED_ACTIONS 8 + +typedef void *dlhandle_t; + +/* Opaque state for a plugin. Not to be touched by the harness (not that it + * really can be.) */ + +struct PLUGIN; +/* This structure represents an action requested by the plugin for the harness. + */ +typedef struct { + int (*action)(struct PLUGIN *requester, void *arg); + void (*arg_dtor)(void *arg); + union { + void *ptr_arg; + int int_arg; + char *str_arg; + }; +} requested_action_t; + +/* + * Structure for the plugin. + */ +typedef struct PLUGIN { + /* The argc this plugin is loaded with. Typically the argc from main(). */ + int argc; + + /* The argv this plugin is loaded with. Typically the argv from main(). */ + char **argv; + + /* Filename the plugin is loaded from. */ + char filename[PATH_MAX]; + + /* Opaque state of this plugin. The state is usually some kind of pointer to + * the plugin state, but all the harness knows is the opaque state is a + * pointer-sized piece of data. + * + * This opaque state is used in a linear pattern where the handlers take the + * opaque state, maybe operate on it, and return a new opaque state, which is + * then passed to the next handler, etc. It is on the plugin to properly + * manager the memory for this state and to destroy it upon teardown. + * + * It's guaranteed that this state is used linearly, meaning the harness gives + * up all ownership to it once passed into a handler. */ + opqst_t state; + + /* This plugin's lock. This avoids potential issues with multiple threads + * trying to change the opaque state at once which can lead to undesireable + * outcomes. */ + pthread_mutex_t lock; + + /** Set to not-zero if this plugin is initialized, otherwise set to zero. */ + int initialized; + + /* The handle to the shared library. */ + dlhandle_t library_handle; + + /* Pointer to the plugin name. This is in the shared library and a + * null-terminated string. If the library does not have a plugin name, this + * will be NULL. */ + const char *plugin_name; + + /** + * Initializes the plugin on the first time, and only the first time, it is + * loaded. This is used to do things like setup a runtime that cannot be + * reliably torn down. It is up to the plugin to ensure this won't interfere + * with hot-reloading. + */ + EXPORT(void (*plugin_metaload)(int argc, char **argv)); + + /** Intializes the plugin with the given argc/argv. This is the first thing + * called on the plugin and is called immediately after the library is loaded. + */ + EXPORT(void (*plugin_load)(int argc, char **argv)); + + /* Start the plugin with the marshalled state from the previous plugin. + * + * This should return the opaque state from the mashalled_state. + * + * This function should not fail if the state cannot be demarshalled, rather a + * default state should be returned. This is because changing the plugin and + * hot-reloading can produce incompatibilities between the old state and the + * new state, and this should not cause a failure. + */ + EXPORT(opqst_t (*plugin_hot_start)(void *self, uint8_t *mashalled_state, + uint32_t n)); + + /* + * Starts the plugin without a marshalled state. Happens during the first boot + * when there is not state. + */ + EXPORT(opqst_t (*plugin_cold_start)(void* self)); + + /* + * Marshals the state to a bytestring. The returned pointer should be malloc'd + * on the heap. The harness takes ownership of the malloc'd pointer. + * + * This is usually called in preparation for a teardown followed by a + * hot-start. + */ + EXPORT(uint8_t *(*plugin_marshal_state)(opqst_t st, uint32_t *szout)); + + /* + * Teardown the plugin in preperation for the library's imminent unloading. + */ + EXPORT(void (*plugin_teardown)(opqst_t)); + + /* + * Handles a keybinding. + */ + EXPORT(opqst_t (*plugin_handle_keybinding)( + struct wlr_keyboard *keyboard, struct wlr_keyboard_key_event *event, + uint32_t modifiers, uint32_t keysym, uint32_t codepoint, int *out_handled, + opqst_t state)); + + EXPORT(opqst_t (*plugin_handle_button)(struct wlr_pointer_button_event *event, + uint32_t modifiers, opqst_t state)); + + /* Absolute motion only for now; relative motion stays in the runtime. */ + EXPORT(opqst_t (*plugin_handle_motion)(void *event, uint32_t modifiers, + uint32_t is_absolute, double lx, + double ly, opqst_t state)); + + /* + * Handles a surface being mapped, unmapped or destroyed. + */ + EXPORT(opqst_t (*plugin_handle_surface)(void *surface, surface_event_t event, + opqst_t)); + + /* List of requested actions by the plugin. Right now there is a maximum of 8 + * allowed at one time. That should be plenty. The actions should be flushed + * after each call to a handler anyway. */ + size_t n_requested_actions; + requested_action_t requested_actions[MAX_QUEUED_ACTIONS]; +} plugin_t; + +#undef EXPORT +#undef EXPORT_INCLUDE + +/* Reloads the plugin. This tears down the existing plugin, marshals the state + * for it and reloads it. + * + * This function will call dlclose on the plugin's library handle. + */ +int plugin_hot_reload(int argc, char **argv, const char *filepath, + plugin_t *plugin); + +/* + * Like hot-reload, but uses the same parameters the plugin was originally + * loaded with. + */ +int plugin_hot_reload_same_state(plugin_t *plugin); + +/* Starts a plugin in a cold state. Called after load_plugin_from_file. */ +void plugin_cold_start(plugin_t *plugin); + +/* Reads a plugin from a filename. */ +int load_plugin_from_file(int argc, char **argv, const char *filename, + plugin_t *plugin); + +void plugin_run_requested_actions(plugin_t *plugin); + +#endif /* _PLUGIN_H_ */ diff --git a/arken/include/plugin_types.h b/arken/include/plugin_types.h new file mode 100644 index 0000000..df1eab5 --- /dev/null +++ b/arken/include/plugin_types.h @@ -0,0 +1,9 @@ +#pragma once + +typedef void *opqst_t; + +typedef enum { + SURFACE_MAP = 0, + SURFACE_UNMAP, + SURFACE_DELETE, +} surface_event_t; diff --git a/arken/include/util.h b/arken/include/util.h new file mode 100644 index 0000000..2ed2f70 --- /dev/null +++ b/arken/include/util.h @@ -0,0 +1,19 @@ +#ifndef MONTIS_UTIL_H +#define MONTIS_UTIL_H + +/* + * Runtime helpers exposed to plugins. These operate on compositor state and + * are intended for direct FFI use from the Haskell plugin. + */ + +void *montis_plugin_toplevel_at(void *ctx, double lx, double ly); +void montis_plugin_get_toplevel_position(void *toplevel, double *x, double *y); +void montis_plugin_set_toplevel_position(void *toplevel, double x, double y); +void montis_plugin_get_toplevel_geometry(void *toplevel, double *x, double *y, + double *w, double *h); +void montis_plugin_set_toplevel_geometry(void *toplevel, double x, double y, + double w, double h); +void montis_plugin_focus_toplevel(void *toplevel); +void montis_plugin_warp_cursor(void *ctx, double lx, double ly); + +#endif /* MONTIS_UTIL_H */ diff --git a/arken/include/wl.h b/arken/include/wl.h new file mode 100644 index 0000000..f10ee7d --- /dev/null +++ b/arken/include/wl.h @@ -0,0 +1,125 @@ +#pragma once + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include + +/* For brevity's sake, struct members are annotated where they are used. */ +enum montis_cursor_mode { + TINYWL_CURSOR_PASSTHROUGH, + TINYWL_CURSOR_MOVE, + TINYWL_CURSOR_RESIZE, +}; + +struct montis_server { + struct wl_display *wl_display; + struct wlr_backend *backend; + struct wlr_renderer *renderer; + struct wlr_allocator *allocator; + struct wlr_scene *scene; + struct wlr_scene_output_layout *scene_layout; + + struct wlr_xdg_shell *xdg_shell; + struct wl_listener new_xdg_toplevel; + struct wl_listener new_xdg_popup; + struct wl_list toplevels; + + struct wlr_xdg_decoration_manager_v1 *xdg_decoration_manager; + struct wl_listener new_xdg_decoration; + + struct wlr_cursor *cursor; + struct wlr_xcursor_manager *cursor_mgr; + struct wl_listener cursor_motion; + struct wl_listener cursor_motion_absolute; + struct wl_listener cursor_button; + struct wl_listener cursor_axis; + struct wl_listener cursor_frame; + + struct wlr_seat *seat; + struct wl_listener new_input; + struct wl_listener request_cursor; + struct wl_listener request_set_selection; + struct wl_list keyboards; + enum montis_cursor_mode cursor_mode; + struct montis_toplevel *grabbed_toplevel; + double grab_x, grab_y; + struct wlr_box grab_geobox; + uint32_t resize_edges; + + struct wlr_output_layout *output_layout; + struct wl_list outputs; + struct wl_listener new_output; + + struct wlr_session *session; + plugin_t plugin; +}; + +struct montis_output { + struct wl_list link; + struct montis_server *server; + struct wlr_output *wlr_output; + struct wl_listener frame; + struct wl_listener request_state; + struct wl_listener destroy; +}; + +struct montis_toplevel { + struct wl_list link; + struct montis_server *server; + struct wlr_xdg_toplevel *xdg_toplevel; + struct wlr_scene_tree *scene_tree; + struct wl_listener map; + struct wl_listener unmap; + struct wl_listener destroy; + struct wl_listener commit; + struct wl_listener request_move; + struct wl_listener request_resize; + struct wl_listener request_maximize; + struct wl_listener request_fullscreen; +}; + +struct montis_keyboard { + struct wl_list link; + struct montis_server *server; + struct wlr_keyboard *wlr_keyboard; + + struct wl_listener modifiers; + struct wl_listener key; + struct wl_listener destroy; +}; + +struct montis_popup { + struct wlr_xdg_popup *xdg_popup; + struct wl_listener commit; + struct wl_listener destroy; +}; + +struct montis_xdg_decoration { + struct wlr_xdg_toplevel_decoration_v1 *decoration; + struct wl_listener request_mode; + struct wl_listener destroy; +}; diff --git a/arken/src/plugin.c b/arken/src/plugin.c new file mode 100644 index 0000000..3edf486 --- /dev/null +++ b/arken/src/plugin.c @@ -0,0 +1,260 @@ +#include "plugin.h" +#include "wl.h" + +#include +#include +#include +#include +#include +#include +#include +#include + +/* Utility function for showing the marshalled states as hex code */ +static void shx(uint8_t *state, uint32_t sz) +{ + uint32_t i = 0; + while (i < sz) { + for (int j = 0; j < 16; ++j) { + if (i < sz) { + printf("%02x ", (unsigned int)state[i]); + } + else { + printf(" "); + } + ++i; + } + + i -= 16; + + printf(" "); + + for (int j = 0; j < 16; ++j) { + if (i < sz) { + if (isprint(state[i]) && !isspace(state[i])) { + printf("%c", state[i]); + } + else { + printf("."); + } + } + else { + printf(" "); + } + ++i; + } + printf("\n"); + } +} + +int load_plugin_from_dl_(dlhandle_t dl, plugin_t *plug); + +static void lock(plugin_t *plugin) { pthread_mutex_lock(&plugin->lock); }; + +static void unlock(plugin_t *plugin) { pthread_mutex_unlock(&plugin->lock); }; + +static int plugin_hot_reload_same_state_action_(plugin_t *plugin, void *ignore) +{ + return plugin_hot_reload_same_state(plugin); +} + +void montis_do_request_hot_reload(void *plugv) +{ + plugin_t *plugin = plugv; + + size_t n = plugin->n_requested_actions++; + if (n < 8) { + plugin->requested_actions[n].action = plugin_hot_reload_same_state_action_; + plugin->requested_actions[n].arg_dtor = NULL; + } +} + +static int plugin_do_log(plugin_t *plugin, void *chrs) +{ + char *str = chrs; + puts(str); + return 0; +} + +void montis_do_request_log(void *plugv, const char *str) +{ + plugin_t *plugin = plugv; + + size_t n = plugin->n_requested_actions++; + if (n < 8) { + plugin->requested_actions[n].action = plugin_do_log; + plugin->requested_actions[n].str_arg = strdup(str); + plugin->requested_actions[n].arg_dtor = free; + } +} + +static int montis_plugin_do_exit(void *plugv, int ec) +{ + exit(ec); + return 0; +} + +void montis_do_request_exit(void *plugv, int ec) +{ + plugin_t *plugin = plugv; + + size_t n = plugin->n_requested_actions++; + if (n < 8) { + plugin->requested_actions[n].action = + (int (*)(plugin_t *, void *))montis_plugin_do_exit; + plugin->requested_actions[n].int_arg = ec; + plugin->requested_actions[n].arg_dtor = NULL; + } +} + +void *montis_plugin_get_seat(void *ctx) +{ + struct montis_server *server = wl_container_of(ctx, server, plugin); + return server->seat; +} + +static int load_plugin_from_file_(int argc, char **argv, const char *filename, + plugin_t *plugin) +{ + dlhandle_t lib = dlopen(filename, RTLD_NOW | RTLD_GLOBAL); + int ec = 0; + + if (!lib) { + fprintf(stderr, "Failed to open library: %s: %s\n", filename, dlerror()); + ec = 1; + goto end; + } + + printf("Loading file.\n"); + ec = load_plugin_from_dl_(lib, plugin); + + if (ec) { + goto end; + } + + strncpy(plugin->filename, filename, sizeof(plugin->filename)); + plugin->argc = argc; + plugin->argv = argv; + + plugin->plugin_load(plugin->argc, plugin->argv); +end: + return ec; +} + +static void maybe_run_metaload(int argc, char **argv, plugin_t *plugin) +{ + static char *loaded_plugins[12]; + int i; + for (i = 0; i < 12 && loaded_plugins[i]; ++i) { + if (strcmp(loaded_plugins[i], plugin->plugin_name) == 0) { + return; // Plugin is already loaded + } + } + loaded_plugins[i] = strdup(plugin->plugin_name); + + printf("First time loading %s, running metaload.\n", plugin->plugin_name); + if (plugin->plugin_metaload) { + plugin->plugin_metaload(argc, argv); + } +} + +int load_plugin_from_file(int argc, char **argv, const char *filename, + plugin_t *plugin) +{ + memset(plugin, 0, sizeof(*plugin)); + + pthread_mutexattr_t attr; + if (pthread_mutexattr_init(&attr)) { + perror("pthread_mutexattr_init"); + return 1; + } + + if (pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE)) { + perror("pthread_mutexattr_settype"); + return 1; + } + + if (pthread_mutex_init(&plugin->lock, &attr)) { + pthread_mutexattr_destroy(&attr); + perror("pthread_mutexattr_init"); + return 1; + } + pthread_mutexattr_destroy(&attr); + int rc = load_plugin_from_file_(argc, argv, filename, plugin); + + if (rc == 0) { + maybe_run_metaload(argc, argv, plugin); + } + + return rc; +} + +int plugin_hot_reload_same_state(plugin_t *plugin) +{ + char filename_cpy[PATH_MAX]; + strncpy(filename_cpy, plugin->filename, sizeof(filename_cpy)); + return plugin_hot_reload(plugin->argc, plugin->argv, filename_cpy, plugin); +} + +int plugin_hot_reload(int argc, char **argv, const char *filepath, + plugin_t *plugin) +{ + int ec = 0; + uint32_t sz = 0; + uint8_t *marshalled_state = NULL; + + printf("Hot Reloading %s\n", plugin->plugin_name); + lock(plugin); + + printf("Marshalling state ...\n"); + marshalled_state = plugin->plugin_marshal_state(plugin->state, &sz); + + printf("Calling teardown ...\n"); + plugin->plugin_teardown(plugin->state); + + printf("State Marshalled:\n"); + shx(marshalled_state, sz); + + printf("Unloading old library handle.\n"); + if (dlclose(plugin->library_handle)) { + printf("Could not close library handle: %s\n", dlerror()); + } + + if ((ec = load_plugin_from_file_(argc, argv, filepath, plugin))) { + goto fail; + } + + printf("Hot starting plugin ...\n"); + plugin->state = plugin->plugin_hot_start(plugin, marshalled_state, sz); + +fail: + free(marshalled_state); + unlock(plugin); + return ec; +} + +void plugin_run_requested_actions(plugin_t *plugin) +{ + lock(plugin); + requested_action_t requested_actions[MAX_QUEUED_ACTIONS]; + size_t n_requested_actions = plugin->n_requested_actions; + memcpy(&requested_actions, plugin->requested_actions, + sizeof(requested_actions)); + plugin->n_requested_actions = 0; + unlock(plugin); + + size_t i; + for (i = 0; i < n_requested_actions; ++i) { + requested_actions[i].action(plugin, requested_actions[i].str_arg); + if (requested_actions[i].arg_dtor) { + requested_actions[i].arg_dtor(requested_actions[i].ptr_arg); + } + } +} + +void plugin_cold_start(plugin_t *plugin) +{ + lock(plugin); + plugin->state = plugin->plugin_cold_start(plugin); + unlock(plugin); +} diff --git a/arken/src/util.c b/arken/src/util.c new file mode 100644 index 0000000..e09cff9 --- /dev/null +++ b/arken/src/util.c @@ -0,0 +1,133 @@ +#include "util.h" +#include "wl.h" + +#include +#include + +static struct montis_server *server_from_ctx(void *ctx) +{ + struct montis_server *server = wl_container_of(ctx, server, plugin); + return server; +} + +static struct montis_toplevel *toplevel_at(struct montis_server *server, + double lx, double ly) +{ + double sx = 0.0; + double sy = 0.0; + + struct wlr_scene_node *node = + wlr_scene_node_at(&server->scene->tree.node, lx, ly, &sx, &sy); + if (node == NULL || node->type != WLR_SCENE_NODE_BUFFER) { + return NULL; + } + struct wlr_scene_buffer *scene_buffer = wlr_scene_buffer_from_node(node); + struct wlr_scene_surface *scene_surface = + wlr_scene_surface_try_from_buffer(scene_buffer); + if (!scene_surface) { + return NULL; + } + + struct wlr_scene_tree *tree = node->parent; + while (tree != NULL && tree->node.data == NULL) { + tree = tree->node.parent; + } + return tree ? tree->node.data : NULL; +} + +void *montis_plugin_toplevel_at(void *ctx, double lx, double ly) +{ + if (!ctx) { + return NULL; + } + struct montis_server *server = server_from_ctx(ctx); + return toplevel_at(server, lx, ly); +} + +void montis_plugin_get_toplevel_position(void *toplevel, double *x, double *y) +{ + if (!toplevel || !x || !y) { + return; + } + struct montis_toplevel *tl = toplevel; + *x = tl->scene_tree->node.x; + *y = tl->scene_tree->node.y; +} + +void montis_plugin_set_toplevel_position(void *toplevel, double x, double y) +{ + if (!toplevel) { + return; + } + struct montis_toplevel *tl = toplevel; + wlr_scene_node_set_position(&tl->scene_tree->node, (int)x, (int)y); +} + +void montis_plugin_get_toplevel_geometry(void *toplevel, double *x, double *y, + double *w, double *h) +{ + if (!toplevel || !x || !y || !w || !h) { + return; + } + struct montis_toplevel *tl = toplevel; + struct wlr_box geo_box; + wlr_xdg_surface_get_geometry(tl->xdg_toplevel->base, &geo_box); + *x = tl->scene_tree->node.x; + *y = tl->scene_tree->node.y; + *w = geo_box.width; + *h = geo_box.height; +} + +void montis_plugin_set_toplevel_geometry(void *toplevel, double x, double y, + double w, double h) +{ + if (!toplevel) { + return; + } + struct montis_toplevel *tl = toplevel; + wlr_scene_node_set_position(&tl->scene_tree->node, (int)x, (int)y); + wlr_xdg_toplevel_set_size(tl->xdg_toplevel, (int)w, (int)h); +} + +void montis_plugin_warp_cursor(void *ctx, double lx, double ly) +{ + if (!ctx) { + return; + } + struct montis_server *server = server_from_ctx(ctx); + wlr_cursor_warp(server->cursor, NULL, lx, ly); +} + +void montis_plugin_focus_toplevel(void *toplevel) +{ + if (!toplevel) { + return; + } + struct montis_toplevel *tl = toplevel; + struct montis_server *server = tl->server; + struct wlr_seat *seat = server->seat; + struct wlr_surface *surface = tl->xdg_toplevel->base->surface; + struct wlr_surface *prev_surface = seat->keyboard_state.focused_surface; + + if (prev_surface == surface) { + return; + } + if (prev_surface) { + struct wlr_xdg_toplevel *prev_toplevel = + wlr_xdg_toplevel_try_from_wlr_surface(prev_surface); + if (prev_toplevel != NULL) { + wlr_xdg_toplevel_set_activated(prev_toplevel, false); + } + } + + struct wlr_keyboard *keyboard = wlr_seat_get_keyboard(seat); + wlr_scene_node_raise_to_top(&tl->scene_tree->node); + wl_list_remove(&tl->link); + wl_list_insert(&server->toplevels, &tl->link); + wlr_xdg_toplevel_set_activated(tl->xdg_toplevel, true); + if (keyboard != NULL) { + wlr_seat_keyboard_notify_enter(seat, surface, keyboard->keycodes, + keyboard->num_keycodes, + &keyboard->modifiers); + } +} diff --git a/arken/src/wl.c b/arken/src/wl.c new file mode 100644 index 0000000..8963e39 --- /dev/null +++ b/arken/src/wl.c @@ -0,0 +1,1135 @@ +#define _POSIX_C_SOURCE 200112L + +#include +#include +#include +#include + +#include + +#include "xdg-decoration-unstable-v1-client-protocol.h" + +// This macro is responsible for calling a handler on a plugin. This macro will +// acquire the plugin's lock, call the member with the arguments and update the +// state. +// +// This only works on function which have the format: +// +// opqst_t function(args ..., opqst_t state); +// +// Note that the state parameter is omitted from this macro. +#define plugin_call_update_state(plugin, member, ...) \ + do { \ + plugin_t *pl__ = &(plugin); \ + pthread_mutex_lock(&pl__->lock); \ + pl__->state = pl__->member(__VA_ARGS__, pl__->state); \ + pthread_mutex_unlock(&pl__->lock); \ + plugin_run_requested_actions(pl__); \ + } while (0) + +static void focus_toplevel(struct montis_toplevel *toplevel, + struct wlr_surface *surface) +{ + /* Note: this function only deals with keyboard focus. */ + if (toplevel == NULL) { + return; + } + struct montis_server *server = toplevel->server; + struct wlr_seat *seat = server->seat; + struct wlr_surface *prev_surface = seat->keyboard_state.focused_surface; + if (prev_surface == surface) { + /* Don't re-focus an already focused surface. */ + return; + } + if (prev_surface) { + /* + * Deactivate the previously focused surface. This lets the client know + * it no longer has focus and the client will repaint accordingly, e.g. + * stop displaying a caret. + */ + struct wlr_xdg_toplevel *prev_toplevel = + wlr_xdg_toplevel_try_from_wlr_surface(prev_surface); + if (prev_toplevel != NULL) { + wlr_xdg_toplevel_set_activated(prev_toplevel, false); + } + } + struct wlr_keyboard *keyboard = wlr_seat_get_keyboard(seat); + /* Move the toplevel to the front */ + wlr_scene_node_raise_to_top(&toplevel->scene_tree->node); + wl_list_remove(&toplevel->link); + wl_list_insert(&server->toplevels, &toplevel->link); + /* Activate the new surface */ + wlr_xdg_toplevel_set_activated(toplevel->xdg_toplevel, true); + /* + * Tell the seat to have the keyboard enter this surface. wlroots will keep + * track of this and automatically send key events to the appropriate + * clients without additional work on your part. + */ + if (keyboard != NULL) { + wlr_seat_keyboard_notify_enter(seat, toplevel->xdg_toplevel->base->surface, + keyboard->keycodes, keyboard->num_keycodes, + &keyboard->modifiers); + } +} + +static void keyboard_handle_modifiers(struct wl_listener *listener, void *data) +{ + /* This event is raised when a modifier key, such as shift or alt, is + * pressed. We simply communicate this to the client. */ + struct montis_keyboard *keyboard = + wl_container_of(listener, keyboard, modifiers); + /* + * A seat can only have one keyboard, but this is a limitation of the + * Wayland protocol - not wlroots. We assign all connected keyboards to the + * same seat. You can swap out the underlying wlr_keyboard like this and + * wlr_seat handles this transparently. + */ + wlr_seat_set_keyboard(keyboard->server->seat, keyboard->wlr_keyboard); + /* Send modifiers to the client. */ + wlr_seat_keyboard_notify_modifiers(keyboard->server->seat, + &keyboard->wlr_keyboard->modifiers); +} + +static void keyboard_handle_key(struct wl_listener *listener, void *data) +{ + /* This event is raised when a key is pressed or released. */ + struct montis_keyboard *keyboard = wl_container_of(listener, keyboard, key); + struct montis_server *server = keyboard->server; + struct wlr_keyboard_key_event *event = data; + struct wlr_seat *seat = server->seat; + + /* Translate libinput keycode -> xkbcommon */ + uint32_t keycode = event->keycode + 8; + /* Get a list of keysyms based on the keymap for this keyboard */ + const xkb_keysym_t *syms; + int nsyms = + xkb_state_key_get_syms(keyboard->wlr_keyboard->xkb_state, keycode, &syms); + + int handled = false; + uint32_t modifiers = wlr_keyboard_get_modifiers(keyboard->wlr_keyboard); + uint32_t codepoint; + int ec; + + if (nsyms > 0 && syms[0] >= XKB_KEY_XF86Switch_VT_1 && + syms[0] <= XKB_KEY_XF86Switch_VT_12) { + /* Escape-hatch to change sessions. These should always be available key + * bindings regardless of what the plugin dictates. This allows an escape + * hatch to edit the plugin in a different vterm and then use the escape + * hatch below to hot-restart the plugin if things get borked. */ + if (event->state == WL_KEYBOARD_KEY_STATE_PRESSED) { + wlr_session_change_vt(server->session, + syms[0] - XKB_KEY_XF86Switch_VT_1 + 1); + } + } + else if (modifiers == + (WLR_MODIFIER_SHIFT | WLR_MODIFIER_CTRL | WLR_MODIFIER_ALT) && + nsyms > 0 && syms[0] == XKB_KEY_Escape) { + /* Escape-hatch to hot-reload the plugin in case the plugin got borked and + * stops accepting keybindings. Ctrl+Shift+Alt+Escape will always reload the + * plugin.*/ + if (event->state == WL_KEYBOARD_KEY_STATE_PRESSED) { + if ((ec = plugin_hot_reload_same_state(&server->plugin)) != 0) { + fprintf(stderr, "Failed to hot reload plugin"); + exit(1); + } + } + } + else { + /* Pass the information along to the plugin for the plugin to handle. The + * plugin will return via 'handled' whether or not the key event was handled + * or not. */ + if (nsyms > 0) { + codepoint = + xkb_state_key_get_utf32(keyboard->wlr_keyboard->xkb_state, keycode); + plugin_call_update_state(server->plugin, plugin_handle_keybinding, + keyboard->wlr_keyboard, event, modifiers, + syms[0], codepoint, &handled); + } + } +} + +static void keyboard_handle_destroy(struct wl_listener *listener, void *data) +{ + /* This event is raised by the keyboard base wlr_input_device to signal + * the destruction of the wlr_keyboard. It will no longer receive events + * and should be destroyed. + */ + struct montis_keyboard *keyboard = + wl_container_of(listener, keyboard, destroy); + wl_list_remove(&keyboard->modifiers.link); + wl_list_remove(&keyboard->key.link); + wl_list_remove(&keyboard->destroy.link); + wl_list_remove(&keyboard->link); + free(keyboard); +} + +static void server_new_keyboard(struct montis_server *server, + struct wlr_input_device *device) +{ + struct wlr_keyboard *wlr_keyboard = wlr_keyboard_from_input_device(device); + + struct montis_keyboard *keyboard = calloc(1, sizeof(*keyboard)); + keyboard->server = server; + keyboard->wlr_keyboard = wlr_keyboard; + + struct xkb_rule_names names = (struct xkb_rule_names){0}; + names.layout = "jr"; + names.variant = "jdvprk"; + names.options = "numpad:mac"; + + /* We need to prepare an XKB keymap and assign it to the keyboard. This + * assumes the defaults (e.g. layout = "us"). */ + struct xkb_context *context = xkb_context_new(XKB_CONTEXT_NO_FLAGS); + struct xkb_keymap *keymap = + xkb_keymap_new_from_names(context, &names, XKB_KEYMAP_COMPILE_NO_FLAGS); + + if (!keymap) { + fprintf(stderr, "Unable to read keymap.\n"); + exit(1); + } + + wlr_keyboard_set_keymap(wlr_keyboard, keymap); + xkb_keymap_unref(keymap); + xkb_context_unref(context); + wlr_keyboard_set_repeat_info(wlr_keyboard, 25, 600); + + /* Here we set up listeners for keyboard events. */ + keyboard->modifiers.notify = keyboard_handle_modifiers; + wl_signal_add(&wlr_keyboard->events.modifiers, &keyboard->modifiers); + keyboard->key.notify = keyboard_handle_key; + wl_signal_add(&wlr_keyboard->events.key, &keyboard->key); + keyboard->destroy.notify = keyboard_handle_destroy; + wl_signal_add(&device->events.destroy, &keyboard->destroy); + + wlr_seat_set_keyboard(server->seat, keyboard->wlr_keyboard); + + /* And add the keyboard to our list of keyboards */ + wl_list_insert(&server->keyboards, &keyboard->link); +} + +static void server_new_pointer(struct montis_server *server, + struct wlr_input_device *device) +{ + /* We don't do anything special with pointers. All of our pointer handling + * is proxied through wlr_cursor. On another compositor, you might take this + * opportunity to do libinput configuration on the device to set + * acceleration, etc. */ + wlr_cursor_attach_input_device(server->cursor, device); +} + +static void server_new_input(struct wl_listener *listener, void *data) +{ + /* This event is raised by the backend when a new input device becomes + * available. */ + struct montis_server *server = wl_container_of(listener, server, new_input); + struct wlr_input_device *device = data; + switch (device->type) { + case WLR_INPUT_DEVICE_KEYBOARD: + server_new_keyboard(server, device); + break; + case WLR_INPUT_DEVICE_POINTER: + server_new_pointer(server, device); + break; + default: + break; + } + /* We need to let the wlr_seat know what our capabilities are, which is + * communiciated to the client. In TinyWL we always have a cursor, even if + * there are no pointer devices, so we always include that capability. */ + uint32_t caps = WL_SEAT_CAPABILITY_POINTER; + if (!wl_list_empty(&server->keyboards)) { + caps |= WL_SEAT_CAPABILITY_KEYBOARD; + } + wlr_seat_set_capabilities(server->seat, caps); +} + +static void seat_request_cursor(struct wl_listener *listener, void *data) +{ + struct montis_server *server = + wl_container_of(listener, server, request_cursor); + /* This event is raised by the seat when a client provides a cursor image */ + struct wlr_seat_pointer_request_set_cursor_event *event = data; + struct wlr_seat_client *focused_client = + server->seat->pointer_state.focused_client; + /* This can be sent by any client, so we check to make sure this one is + * actually has pointer focus first. */ + if (focused_client == event->seat_client) { + /* Once we've vetted the client, we can tell the cursor to use the + * provided surface as the cursor image. It will set the hardware cursor + * on the output that it's currently on and continue to do so as the + * cursor moves between outputs. */ + wlr_cursor_set_surface(server->cursor, event->surface, event->hotspot_x, + event->hotspot_y); + } +} + +static void seat_request_set_selection(struct wl_listener *listener, void *data) +{ + /* This event is raised by the seat when a client wants to set the selection, + * usually when the user copies something. wlroots allows compositors to + * ignore such requests if they so choose, but in montis we always honor + */ + struct montis_server *server = + wl_container_of(listener, server, request_set_selection); + struct wlr_seat_request_set_selection_event *event = data; + wlr_seat_set_selection(server->seat, event->source, event->serial); +} + +static struct montis_toplevel *desktop_toplevel_at(struct montis_server *server, + double lx, double ly, + struct wlr_surface **surface, + double *sx, double *sy) +{ + /* This returns the topmost node in the scene at the given layout coords. + * We only care about surface nodes as we are specifically looking for a + * surface in the surface tree of a montis_toplevel. */ + struct wlr_scene_node *node = + wlr_scene_node_at(&server->scene->tree.node, lx, ly, sx, sy); + if (node == NULL || node->type != WLR_SCENE_NODE_BUFFER) { + return NULL; + } + struct wlr_scene_buffer *scene_buffer = wlr_scene_buffer_from_node(node); + struct wlr_scene_surface *scene_surface = + wlr_scene_surface_try_from_buffer(scene_buffer); + if (!scene_surface) { + return NULL; + } + + *surface = scene_surface->surface; + /* Find the node corresponding to the montis_toplevel at the root of this + * surface tree, it is the only one for which we set the data field. */ + struct wlr_scene_tree *tree = node->parent; + while (tree != NULL && tree->node.data == NULL) { + tree = tree->node.parent; + } + return tree->node.data; +} + +static void reset_cursor_mode(struct montis_server *server) +{ + /* Reset the cursor mode to passthrough. */ + server->cursor_mode = TINYWL_CURSOR_PASSTHROUGH; + server->grabbed_toplevel = NULL; +} + +static void process_cursor_move(struct montis_server *server, uint32_t time) +{ + /* Move the grabbed toplevel to the new position. */ + struct montis_toplevel *toplevel = server->grabbed_toplevel; + wlr_scene_node_set_position(&toplevel->scene_tree->node, + server->cursor->x - server->grab_x, + server->cursor->y - server->grab_y); +} + +static void process_cursor_resize(struct montis_server *server, uint32_t time) +{ + /* + * Resizing the grabbed toplevel can be a little bit complicated, because we + * could be resizing from any corner or edge. This not only resizes the + * toplevel on one or two axes, but can also move the toplevel if you resize + * from the top or left edges (or top-left corner). + * + * Note that some shortcuts are taken here. In a more fleshed-out + * compositor, you'd wait for the client to prepare a buffer at the new + * size, then commit any movement that was prepared. + */ + struct montis_toplevel *toplevel = server->grabbed_toplevel; + double border_x = server->cursor->x - server->grab_x; + double border_y = server->cursor->y - server->grab_y; + int new_left = server->grab_geobox.x; + int new_right = server->grab_geobox.x + server->grab_geobox.width; + int new_top = server->grab_geobox.y; + int new_bottom = server->grab_geobox.y + server->grab_geobox.height; + + if (server->resize_edges & WLR_EDGE_TOP) { + new_top = border_y; + if (new_top >= new_bottom) { + new_top = new_bottom - 1; + } + } + else if (server->resize_edges & WLR_EDGE_BOTTOM) { + new_bottom = border_y; + if (new_bottom <= new_top) { + new_bottom = new_top + 1; + } + } + if (server->resize_edges & WLR_EDGE_LEFT) { + new_left = border_x; + if (new_left >= new_right) { + new_left = new_right - 1; + } + } + else if (server->resize_edges & WLR_EDGE_RIGHT) { + new_right = border_x; + if (new_right <= new_left) { + new_right = new_left + 1; + } + } + + struct wlr_box geo_box; + wlr_xdg_surface_get_geometry(toplevel->xdg_toplevel->base, &geo_box); + wlr_scene_node_set_position(&toplevel->scene_tree->node, new_left - geo_box.x, + new_top - geo_box.y); + + int new_width = new_right - new_left; + int new_height = new_bottom - new_top; + wlr_xdg_toplevel_set_size(toplevel->xdg_toplevel, new_width, new_height); +} + +static void process_cursor_motion(struct montis_server *server, uint32_t time) +{ + /* If the mode is non-passthrough, delegate to those functions. */ + if (server->cursor_mode == TINYWL_CURSOR_MOVE) { + process_cursor_move(server, time); + return; + } + else if (server->cursor_mode == TINYWL_CURSOR_RESIZE) { + process_cursor_resize(server, time); + return; + } + + /* Otherwise, find the toplevel under the pointer and send the event along. */ + double sx, sy; + struct wlr_seat *seat = server->seat; + struct wlr_surface *surface = NULL; + struct montis_toplevel *toplevel = desktop_toplevel_at( + server, server->cursor->x, server->cursor->y, &surface, &sx, &sy); + if (!toplevel) { + /* If there's no toplevel under the cursor, set the cursor image to a + * default. This is what makes the cursor image appear when you move it + * around the screen, not over any toplevels. */ + wlr_cursor_set_xcursor(server->cursor, server->cursor_mgr, "default"); + } + if (surface) { + /* + * Send pointer enter and motion events. + * + * The enter event gives the surface "pointer focus", which is distinct + * from keyboard focus. You get pointer focus by moving the pointer over + * a window. + * + * Note that wlroots will avoid sending duplicate enter/motion events if + * the surface has already has pointer focus or if the client is already + * aware of the coordinates passed. + */ + wlr_seat_pointer_notify_enter(seat, surface, sx, sy); + wlr_seat_pointer_notify_motion(seat, time, sx, sy); + } + else { + /* Clear pointer focus so future button events and such are not sent to + * the last client to have the cursor over it. */ + wlr_seat_pointer_clear_focus(seat); + } +} + +static void server_cursor_motion(struct wl_listener *listener, void *data) +{ + /* This event is forwarded by the cursor when a pointer emits a _relative_ + * pointer motion event (i.e. a delta) */ + struct montis_server *server = + wl_container_of(listener, server, cursor_motion); + struct wlr_pointer_motion_event *event = data; + struct wlr_seat *seat = server->seat; + struct wlr_keyboard *keyboard = wlr_seat_get_keyboard(seat); + uint32_t modifiers = keyboard ? wlr_keyboard_get_modifiers(keyboard) : 0; + /* The cursor doesn't move unless we tell it to. The cursor automatically + * handles constraining the motion to the output layout, as well as any + * special configuration applied for the specific input device which + * generated the event. You can pass NULL for the device if you want to move + * the cursor around without any input. */ + wlr_cursor_move(server->cursor, &event->pointer->base, event->delta_x, + event->delta_y); + process_cursor_motion(server, event->time_msec); + plugin_call_update_state(server->plugin, plugin_handle_motion, event, + modifiers, 0, server->cursor->x, server->cursor->y); +} + +static void server_cursor_motion_absolute(struct wl_listener *listener, + void *data) +{ + /* This event is forwarded by the cursor when a pointer emits an _absolute_ + * motion event, from 0..1 on each axis. This happens, for example, when + * wlroots is running under a Wayland window rather than KMS+DRM, and you + * move the mouse over the window. You could enter the window from any edge, + * so we have to warp the mouse there. There is also some hardware which + * emits these events. */ + struct montis_server *server = + wl_container_of(listener, server, cursor_motion_absolute); + struct wlr_pointer_motion_absolute_event *event = data; + + struct wlr_seat *seat = server->seat; + struct wlr_keyboard *keyboard = wlr_seat_get_keyboard(seat); + uint32_t modifiers = keyboard ? wlr_keyboard_get_modifiers(keyboard) : 0; + + wlr_cursor_warp_absolute(server->cursor, &event->pointer->base, event->x, + event->y); + process_cursor_motion(server, event->time_msec); + plugin_call_update_state(server->plugin, plugin_handle_motion, event, + modifiers, 1, server->cursor->x, server->cursor->y); +} + +static void server_cursor_button(struct wl_listener *listener, void *data) +{ + /* This event is forwarded by the cursor when a pointer emits a button + * event. */ + struct montis_server *server = + wl_container_of(listener, server, cursor_button); + struct wlr_pointer_button_event *event = data; + struct wlr_seat *seat = server->seat; + struct wlr_keyboard *keyboard = wlr_seat_get_keyboard(seat); + uint32_t modifiers = wlr_keyboard_get_modifiers(keyboard); + + plugin_call_update_state(server->plugin, plugin_handle_button, event, + modifiers); + + /* Notify the client with pointer focus that a button press has occurred */ + // wlr_seat_pointer_notify_button(server->seat, event->time_msec, + // event->button, + // event->state); + // double sx, sy; + // struct wlr_surface *surface = NULL; + // struct montis_toplevel *toplevel = desktop_toplevel_at( + // server, server->cursor->x, server->cursor->y, &surface, &sx, &sy); + // if (event->state == WLR_BUTTON_RELEASED) { + // /* If you released any buttons, we exit interactive move/resize mode. */ + // reset_cursor_mode(server); + // } + // else { + // /* Focus that client if the button was _pressed_ */ + // focus_toplevel(toplevel, surface); + // } +} + +static void server_cursor_axis(struct wl_listener *listener, void *data) +{ + /* This event is forwarded by the cursor when a pointer emits an axis event, + * for example when you move the scroll wheel. */ + struct montis_server *server = wl_container_of(listener, server, cursor_axis); + struct wlr_pointer_axis_event *event = data; + /* Notify the client with pointer focus of the axis event. */ + wlr_seat_pointer_notify_axis( + server->seat, event->time_msec, event->orientation, event->delta, + event->delta_discrete, event->source, event->relative_direction); +} + +static void server_cursor_frame(struct wl_listener *listener, void *data) +{ + /* This event is forwarded by the cursor when a pointer emits an frame + * event. Frame events are sent after regular pointer events to group + * multiple events together. For instance, two axis events may happen at the + * same time, in which case a frame event won't be sent in between. */ + struct montis_server *server = + wl_container_of(listener, server, cursor_frame); + /* Notify the client with pointer focus of the frame event. */ + wlr_seat_pointer_notify_frame(server->seat); +} + +static void output_frame(struct wl_listener *listener, void *data) +{ + /* This function is called every time an output is ready to display a frame, + * generally at the output's refresh rate (e.g. 60Hz). */ + struct montis_output *output = wl_container_of(listener, output, frame); + struct wlr_scene *scene = output->server->scene; + + struct wlr_scene_output *scene_output = + wlr_scene_get_scene_output(scene, output->wlr_output); + + /* Render the scene if needed and commit the output */ + wlr_scene_output_commit(scene_output, NULL); + + struct timespec now; + clock_gettime(CLOCK_MONOTONIC, &now); + wlr_scene_output_send_frame_done(scene_output, &now); +} + +static void output_request_state(struct wl_listener *listener, void *data) +{ + /* This function is called when the backend requests a new state for + * the output. For example, Wayland and X11 backends request a new mode + * when the output window is resized. */ + struct montis_output *output = + wl_container_of(listener, output, request_state); + const struct wlr_output_event_request_state *event = data; + wlr_output_commit_state(output->wlr_output, event->state); +} + +static void output_destroy(struct wl_listener *listener, void *data) +{ + struct montis_output *output = wl_container_of(listener, output, destroy); + + wl_list_remove(&output->frame.link); + wl_list_remove(&output->request_state.link); + wl_list_remove(&output->destroy.link); + wl_list_remove(&output->link); + free(output); +} + +static void server_new_output(struct wl_listener *listener, void *data) +{ + /* This event is raised by the backend when a new output (aka a display or + * monitor) becomes available. */ + struct montis_server *server = wl_container_of(listener, server, new_output); + struct wlr_output *wlr_output = data; + + /* Configures the output created by the backend to use our allocator + * and our renderer. Must be done once, before commiting the output */ + wlr_output_init_render(wlr_output, server->allocator, server->renderer); + + /* The output may be disabled, switch it on. */ + struct wlr_output_state state; + wlr_output_state_init(&state); + wlr_output_state_set_enabled(&state, true); + + /* Some backends don't have modes. DRM+KMS does, and we need to set a mode + * before we can use the output. The mode is a tuple of (width, height, + * refresh rate), and each monitor supports only a specific set of modes. We + * just pick the monitor's preferred mode, a more sophisticated compositor + * would let the user configure it. */ + struct wlr_output_mode *mode = wlr_output_preferred_mode(wlr_output); + if (mode != NULL) { + wlr_output_state_set_mode(&state, mode); + } + + /* Atomically applies the new output state. */ + wlr_output_commit_state(wlr_output, &state); + wlr_output_state_finish(&state); + + /* Allocates and configures our state for this output */ + struct montis_output *output = calloc(1, sizeof(*output)); + output->wlr_output = wlr_output; + output->server = server; + + /* Sets up a listener for the frame event. */ + output->frame.notify = output_frame; + wl_signal_add(&wlr_output->events.frame, &output->frame); + + /* Sets up a listener for the state request event. */ + output->request_state.notify = output_request_state; + wl_signal_add(&wlr_output->events.request_state, &output->request_state); + + /* Sets up a listener for the destroy event. */ + output->destroy.notify = output_destroy; + wl_signal_add(&wlr_output->events.destroy, &output->destroy); + + wl_list_insert(&server->outputs, &output->link); + + /* Adds this to the output layout. The add_auto function arranges outputs + * from left-to-right in the order they appear. A more sophisticated + * compositor would let the user configure the arrangement of outputs in the + * layout. + * + * The output layout utility automatically adds a wl_output global to the + * display, which Wayland clients can see to find out information about the + * output (such as DPI, scale factor, manufacturer, etc). + */ + struct wlr_output_layout_output *l_output = + wlr_output_layout_add_auto(server->output_layout, wlr_output); + struct wlr_scene_output *scene_output = + wlr_scene_output_create(server->scene, wlr_output); + wlr_scene_output_layout_add_output(server->scene_layout, l_output, + scene_output); +} + +static void xdg_toplevel_map(struct wl_listener *listener, void *data) +{ + /* Called when the surface is mapped, or ready to display on-screen. */ + struct montis_toplevel *toplevel = wl_container_of(listener, toplevel, map); + + wl_list_insert(&toplevel->server->toplevels, &toplevel->link); + + fprintf(stderr, "Surface map ...\n"); + plugin_call_update_state(toplevel->server->plugin, plugin_handle_surface, + toplevel, SURFACE_MAP); + fprintf(stderr, "/ Surface map ...\n"); + + focus_toplevel(toplevel, toplevel->xdg_toplevel->base->surface); +} + +static void xdg_toplevel_unmap(struct wl_listener *listener, void *data) +{ + /* Called when the surface is unmapped, and should no longer be shown. */ + struct montis_toplevel *toplevel = wl_container_of(listener, toplevel, unmap); + + /* Reset the cursor mode if the grabbed toplevel was unmapped. */ + if (toplevel == toplevel->server->grabbed_toplevel) { + reset_cursor_mode(toplevel->server); + } + + fprintf(stderr, "Surface unmap ...\n"); + plugin_call_update_state(toplevel->server->plugin, plugin_handle_surface, + toplevel, SURFACE_UNMAP); + fprintf(stderr, "/ Surface map ...\n"); + + wl_list_remove(&toplevel->link); +} + +static void xdg_toplevel_destroy(struct wl_listener *listener, void *data) +{ + /* Called when the xdg_toplevel is destroyed. */ + struct montis_toplevel *toplevel = + wl_container_of(listener, toplevel, destroy); + + wl_list_remove(&toplevel->map.link); + wl_list_remove(&toplevel->unmap.link); + wl_list_remove(&toplevel->destroy.link); + wl_list_remove(&toplevel->request_move.link); + wl_list_remove(&toplevel->request_resize.link); + wl_list_remove(&toplevel->request_maximize.link); + wl_list_remove(&toplevel->request_fullscreen.link); + + fprintf(stderr, "Surface destroy ...\n"); + plugin_call_update_state(toplevel->server->plugin, plugin_handle_surface, + toplevel, SURFACE_DELETE); + fprintf(stderr, "/ Surface destroy ...\n"); + + free(toplevel); +} + +static void begin_interactive(struct montis_toplevel *toplevel, + enum montis_cursor_mode mode, uint32_t edges) +{ + /* This function sets up an interactive move or resize operation, where the + * compositor stops propegating pointer events to clients and instead + * consumes them itself, to move or resize windows. */ + struct montis_server *server = toplevel->server; + struct wlr_surface *focused_surface = + server->seat->pointer_state.focused_surface; + if (toplevel->xdg_toplevel->base->surface != + wlr_surface_get_root_surface(focused_surface)) { + /* Deny move/resize requests from unfocused clients. */ + return; + } + server->grabbed_toplevel = toplevel; + server->cursor_mode = mode; + + if (mode == TINYWL_CURSOR_MOVE) { + server->grab_x = server->cursor->x - toplevel->scene_tree->node.x; + server->grab_y = server->cursor->y - toplevel->scene_tree->node.y; + } + else { + struct wlr_box geo_box; + wlr_xdg_surface_get_geometry(toplevel->xdg_toplevel->base, &geo_box); + + double border_x = (toplevel->scene_tree->node.x + geo_box.x) + + ((edges & WLR_EDGE_RIGHT) ? geo_box.width : 0); + double border_y = (toplevel->scene_tree->node.y + geo_box.y) + + ((edges & WLR_EDGE_BOTTOM) ? geo_box.height : 0); + server->grab_x = server->cursor->x - border_x; + server->grab_y = server->cursor->y - border_y; + + server->grab_geobox = geo_box; + server->grab_geobox.x += toplevel->scene_tree->node.x; + server->grab_geobox.y += toplevel->scene_tree->node.y; + + server->resize_edges = edges; + } +} + +static void xdg_toplevel_request_move(struct wl_listener *listener, void *data) +{ + /* This event is raised when a client would like to begin an interactive + * move, typically because the user clicked on their client-side + * decorations. Note that a more sophisticated compositor should check the + * provided serial against a list of button press serials sent to this + * client, to prevent the client from requesting this whenever they want. */ + struct montis_toplevel *toplevel = + wl_container_of(listener, toplevel, request_move); + begin_interactive(toplevel, TINYWL_CURSOR_MOVE, 0); +} + +static void xdg_toplevel_request_resize(struct wl_listener *listener, + void *data) +{ + /* This event is raised when a client would like to begin an interactive + * resize, typically because the user clicked on their client-side + * decorations. Note that a more sophisticated compositor should check the + * provided serial against a list of button press serials sent to this + * client, to prevent the client from requesting this whenever they want. */ + struct wlr_xdg_toplevel_resize_event *event = data; + struct montis_toplevel *toplevel = + wl_container_of(listener, toplevel, request_resize); + begin_interactive(toplevel, TINYWL_CURSOR_RESIZE, event->edges); +} + +static void xdg_toplevel_request_maximize(struct wl_listener *listener, + void *data) +{ + /* This event is raised when a client would like to maximize itself, + * typically because the user clicked on the maximize button on + * client-side decorations. montis doesn't support maximization, but + * to conform to xdg-shell protocol we still must send a configure. + * wlr_xdg_surface_schedule_configure() is used to send an empty reply. */ + struct montis_toplevel *toplevel = + wl_container_of(listener, toplevel, request_maximize); + wlr_xdg_surface_schedule_configure(toplevel->xdg_toplevel->base); +} + +static void xdg_toplevel_request_fullscreen(struct wl_listener *listener, + void *data) +{ + /* Just as with request_maximize, we must send a configure here. */ + struct montis_toplevel *toplevel = + wl_container_of(listener, toplevel, request_fullscreen); + wlr_xdg_surface_schedule_configure(toplevel->xdg_toplevel->base); +} + +static void xdg_popup_commit(struct wl_listener *listener, void *data) +{ + /* Called when a new surface state is committed. */ + struct montis_popup *popup = wl_container_of(listener, popup, commit); + + if (popup->xdg_popup->base->initial_commit) { + /* When an xdg_surface performs an initial commit, the compositor must + * reply with a configure so the client can map the surface. + * montis sends an empty configure. A more sophisticated compositor + * might change an xdg_popup's geometry to ensure it's not positioned + * off-screen, for example. */ + wlr_xdg_surface_schedule_configure(popup->xdg_popup->base); + } +} + +static void xdg_popup_destroy(struct wl_listener *listener, void *data) +{ + /* Called when the xdg_popup is destroyed. */ + struct montis_popup *popup = wl_container_of(listener, popup, destroy); + + wl_list_remove(&popup->commit.link); + wl_list_remove(&popup->destroy.link); + + free(popup); +} + +static void server_new_xdg_popup(struct wl_listener *listener, void *data) +{ + /* This event is raised when a client creates a new popup. */ + struct wlr_xdg_popup *xdg_popup = data; + + struct montis_popup *popup = calloc(1, sizeof(*popup)); + popup->xdg_popup = xdg_popup; + + /* We must add xdg popups to the scene graph so they get rendered. The + * wlroots scene graph provides a helper for this, but to use it we must + * provide the proper parent scene node of the xdg popup. To enable this, + * we always set the user data field of xdg_surfaces to the corresponding + * scene node. */ + struct wlr_xdg_surface *parent = + wlr_xdg_surface_try_from_wlr_surface(xdg_popup->parent); + assert(parent != NULL); + struct wlr_scene_tree *parent_tree = parent->data; + xdg_popup->base->data = + wlr_scene_xdg_surface_create(parent_tree, xdg_popup->base); + + popup->commit.notify = xdg_popup_commit; + wl_signal_add(&xdg_popup->base->surface->events.commit, &popup->commit); + + popup->destroy.notify = xdg_popup_destroy; + wl_signal_add(&xdg_popup->events.destroy, &popup->destroy); +} + +static void xdg_decoration_request_mode(struct wl_listener *listener, + void *data) +{ + /* Clients can request a decoration mode; we always enforce server-side. */ + struct montis_xdg_decoration *dec = + wl_container_of(listener, dec, request_mode); + wlr_xdg_toplevel_decoration_v1_set_mode( + dec->decoration, WLR_XDG_TOPLEVEL_DECORATION_V1_MODE_SERVER_SIDE); +} + +static void xdg_decoration_destroy(struct wl_listener *listener, void *data) +{ + struct montis_xdg_decoration *dec = + wl_container_of(listener, dec, destroy); + wl_list_remove(&dec->request_mode.link); + wl_list_remove(&dec->destroy.link); + free(dec); +} + +static void server_new_xdg_decoration(struct wl_listener *listener, void *data) +{ + /* Force server-side decorations to disable client-side frames. */ + struct wlr_xdg_toplevel_decoration_v1 *decoration = data; + struct montis_xdg_decoration *dec = calloc(1, sizeof(*dec)); + dec->decoration = decoration; + + dec->request_mode.notify = xdg_decoration_request_mode; + wl_signal_add(&decoration->events.request_mode, &dec->request_mode); + dec->destroy.notify = xdg_decoration_destroy; + wl_signal_add(&decoration->events.destroy, &dec->destroy); + + wlr_xdg_toplevel_decoration_v1_set_mode( + decoration, WLR_XDG_TOPLEVEL_DECORATION_V1_MODE_SERVER_SIDE); +} + +static void xdg_toplevel_commit(struct wl_listener *listener, void *data) +{ + /* Called when a new surface state is committed. */ + struct montis_toplevel *toplevel = + wl_container_of(listener, toplevel, commit); + + if (toplevel->xdg_toplevel->base->initial_commit) { + /* When an xdg_surface performs an initial commit, the compositor must + * reply with a configure so the client can map the surface. montis + * configures the xdg_toplevel with 0,0 size to let the client pick the + * dimensions itself. */ + wlr_xdg_toplevel_set_size(toplevel->xdg_toplevel, 0, 0); + } +} + +static void server_new_xdg_toplevel(struct wl_listener *listener, void *data) +{ + /* This event is raised when a client creates a new toplevel (application + * window). */ + struct montis_server *server = + wl_container_of(listener, server, new_xdg_toplevel); + struct wlr_xdg_toplevel *xdg_toplevel = data; + + /* Allocate a montis_toplevel for this surface */ + struct montis_toplevel *toplevel = calloc(1, sizeof(*toplevel)); + toplevel->server = server; + toplevel->xdg_toplevel = xdg_toplevel; + toplevel->scene_tree = wlr_scene_xdg_surface_create( + &toplevel->server->scene->tree, xdg_toplevel->base); + toplevel->scene_tree->node.data = toplevel; + xdg_toplevel->base->data = toplevel->scene_tree; + + /* Listen to the various events it can emit */ + toplevel->map.notify = xdg_toplevel_map; + wl_signal_add(&xdg_toplevel->base->surface->events.map, &toplevel->map); + toplevel->unmap.notify = xdg_toplevel_unmap; + wl_signal_add(&xdg_toplevel->base->surface->events.unmap, &toplevel->unmap); + toplevel->commit.notify = xdg_toplevel_commit; + wl_signal_add(&xdg_toplevel->base->surface->events.commit, &toplevel->commit); + + toplevel->destroy.notify = xdg_toplevel_destroy; + wl_signal_add(&xdg_toplevel->events.destroy, &toplevel->destroy); + + /* cotd */ + toplevel->request_move.notify = xdg_toplevel_request_move; + wl_signal_add(&xdg_toplevel->events.request_move, &toplevel->request_move); + toplevel->request_resize.notify = xdg_toplevel_request_resize; + wl_signal_add(&xdg_toplevel->events.request_resize, + &toplevel->request_resize); + toplevel->request_maximize.notify = xdg_toplevel_request_maximize; + wl_signal_add(&xdg_toplevel->events.request_maximize, + &toplevel->request_maximize); + toplevel->request_fullscreen.notify = xdg_toplevel_request_fullscreen; + wl_signal_add(&xdg_toplevel->events.request_fullscreen, + &toplevel->request_fullscreen); +} + +int main(int argc, char *argv[]) +{ + wlr_log_init(WLR_DEBUG, NULL); + char *startup_cmd = NULL; + char *plugin = NULL; + + int c; + while ((c = getopt(argc, argv, "s:p:h")) != -1) { + switch (c) { + case 's': + startup_cmd = optarg; + break; + case 'p': + plugin = optarg; + break; + default: + printf("Usage: %s -p [plugin] [-s startup command]\n", argv[0]); + return 0; + } + } + if (optind < argc || !plugin) { + printf("Usage: %s -p [plugin] [-s startup command]\n", argv[0]); + return 0; + } + + struct montis_server server = {0}; + + if (load_plugin_from_file(argc, argv, plugin, &server.plugin)) { + fprintf(stderr, "Failed to read plugin from file.\n"); + return 1; + } + + plugin_cold_start(&server.plugin); + + /* The Wayland display is managed by libwayland. It handles accepting + * clients from the Unix socket, manging Wayland globals, and so on. */ + server.wl_display = wl_display_create(); + /* The backend is a wlroots feature which abstracts the underlying input and + * output hardware. The autocreate option will choose the most suitable + * backend based on the current environment, such as opening an X11 window + * if an X11 server is running. */ + server.backend = wlr_backend_autocreate( + wl_display_get_event_loop(server.wl_display), &server.session); + if (server.backend == NULL) { + wlr_log(WLR_ERROR, "failed to create wlr_backend"); + return 1; + } + + /* Autocreates a renderer, either Pixman, GLES2 or Vulkan for us. The user + * can also specify a renderer using the WLR_RENDERER env var. + * The renderer is responsible for defining the various pixel formats it + * supports for shared memory, this configures that for clients. */ + server.renderer = wlr_renderer_autocreate(server.backend); + if (server.renderer == NULL) { + wlr_log(WLR_ERROR, "failed to create wlr_renderer"); + return 1; + } + + wlr_renderer_init_wl_display(server.renderer, server.wl_display); + + /* Autocreates an allocator for us. + * The allocator is the bridge between the renderer and the backend. It + * handles the buffer creation, allowing wlroots to render onto the + * screen */ + server.allocator = wlr_allocator_autocreate(server.backend, server.renderer); + if (server.allocator == NULL) { + wlr_log(WLR_ERROR, "failed to create wlr_allocator"); + return 1; + } + + /* This creates some hands-off wlroots interfaces. The compositor is + * necessary for clients to allocate surfaces, the subcompositor allows to + * assign the role of subsurfaces to surfaces and the data device manager + * handles the clipboard. Each of these wlroots interfaces has room for you + * to dig your fingers in and play with their behavior if you want. Note that + * the clients cannot set the selection directly without compositor approval, + * see the handling of the request_set_selection event below.*/ + wlr_compositor_create(server.wl_display, 5, server.renderer); + wlr_subcompositor_create(server.wl_display); + wlr_data_device_manager_create(server.wl_display); + + /* Creates an output layout, which a wlroots utility for working with an + * arrangement of screens in a physical layout. */ + server.output_layout = wlr_output_layout_create(server.wl_display); + + /* Configure a listener to be notified when new outputs are available on the + * backend. */ + wl_list_init(&server.outputs); + server.new_output.notify = server_new_output; + wl_signal_add(&server.backend->events.new_output, &server.new_output); + + /* Create a scene graph. This is a wlroots abstraction that handles all + * rendering and damage tracking. All the compositor author needs to do + * is add things that should be rendered to the scene graph at the proper + * positions and then call wlr_scene_output_commit() to render a frame if + * necessary. + */ + server.scene = wlr_scene_create(); + server.scene_layout = + wlr_scene_attach_output_layout(server.scene, server.output_layout); + + /* Set up xdg-shell version 3. The xdg-shell is a Wayland protocol which is + * used for application windows. For more detail on shells, refer to + * https://drewdevault.com/2018/07/29/Wayland-shells.html. + */ + wl_list_init(&server.toplevels); + server.xdg_shell = wlr_xdg_shell_create(server.wl_display, 3); + server.new_xdg_toplevel.notify = server_new_xdg_toplevel; + wl_signal_add(&server.xdg_shell->events.new_toplevel, + &server.new_xdg_toplevel); + server.new_xdg_popup.notify = server_new_xdg_popup; + wl_signal_add(&server.xdg_shell->events.new_popup, &server.new_xdg_popup); + + /* Request server-side decorations for xdg-toplevel surfaces. */ + server.xdg_decoration_manager = + wlr_xdg_decoration_manager_v1_create(server.wl_display); + if (server.xdg_decoration_manager != NULL) { + server.new_xdg_decoration.notify = server_new_xdg_decoration; + wl_signal_add( + &server.xdg_decoration_manager->events.new_toplevel_decoration, + &server.new_xdg_decoration); + } + + /* + * Creates a cursor, which is a wlroots utility for tracking the cursor + * image shown on screen. + */ + server.cursor = wlr_cursor_create(); + wlr_cursor_attach_output_layout(server.cursor, server.output_layout); + + /* Creates an xcursor manager, another wlroots utility which loads up + * Xcursor themes to source cursor images from and makes sure that cursor + * images are available at all scale factors on the screen (necessary for + * HiDPI support). */ + server.cursor_mgr = wlr_xcursor_manager_create(NULL, 24); + + /* + * wlr_cursor *only* displays an image on screen. It does not move around + * when the pointer moves. However, we can attach input devices to it, and + * it will generate aggregate events for all of them. In these events, we + * can choose how we want to process them, forwarding them to clients and + * moving the cursor around. More detail on this process is described in + * https://drewdevault.com/2018/07/17/Input-handling-in-wlroots.html. + * + * And more comments are sprinkled throughout the notify functions above. + */ + server.cursor_mode = TINYWL_CURSOR_PASSTHROUGH; + server.cursor_motion.notify = server_cursor_motion; + wl_signal_add(&server.cursor->events.motion, &server.cursor_motion); + server.cursor_motion_absolute.notify = server_cursor_motion_absolute; + wl_signal_add(&server.cursor->events.motion_absolute, + &server.cursor_motion_absolute); + server.cursor_button.notify = server_cursor_button; + wl_signal_add(&server.cursor->events.button, &server.cursor_button); + server.cursor_axis.notify = server_cursor_axis; + wl_signal_add(&server.cursor->events.axis, &server.cursor_axis); + server.cursor_frame.notify = server_cursor_frame; + wl_signal_add(&server.cursor->events.frame, &server.cursor_frame); + + /* + * Configures a seat, which is a single "seat" at which a user sits and + * operates the computer. This conceptually includes up to one keyboard, + * pointer, touch, and drawing tablet device. We also rig up a listener to + * let us know when new input devices are available on the backend. + */ + wl_list_init(&server.keyboards); + server.new_input.notify = server_new_input; + wl_signal_add(&server.backend->events.new_input, &server.new_input); + server.seat = wlr_seat_create(server.wl_display, "seat0"); + server.request_cursor.notify = seat_request_cursor; + wl_signal_add(&server.seat->events.request_set_cursor, + &server.request_cursor); + server.request_set_selection.notify = seat_request_set_selection; + wl_signal_add(&server.seat->events.request_set_selection, + &server.request_set_selection); + + /* Add a Unix socket to the Wayland display. */ + const char *socket = wl_display_add_socket_auto(server.wl_display); + if (!socket) { + wlr_backend_destroy(server.backend); + return 1; + } + + /* Start the backend. This will enumerate outputs and inputs, become the DRM + * master, etc */ + if (!wlr_backend_start(server.backend)) { + wlr_backend_destroy(server.backend); + wl_display_destroy(server.wl_display); + return 1; + } + + /* Set the WAYLAND_DISPLAY environment variable to our socket and run the + * startup command if requested. */ + setenv("WAYLAND_DISPLAY", socket, true); + if (startup_cmd) { + if (fork() == 0) { + execl("/bin/sh", "/bin/sh", "-c", startup_cmd, (void *)NULL); + } + } + /* Run the Wayland event loop. This does not return until you exit the + * compositor. Starting the backend rigged up all of the necessary event + * loop configuration to listen to libinput events, DRM events, generate + * frame events at the refresh rate, and so on. */ + wlr_log(WLR_INFO, "Running Wayland compositor on WAYLAND_DISPLAY=%s", socket); + wl_display_run(server.wl_display); + + /* Once wl_display_run returns, we destroy all clients then shut down the + * server. */ + wl_display_destroy_clients(server.wl_display); + wlr_scene_node_destroy(&server.scene->tree.node); + wlr_xcursor_manager_destroy(server.cursor_mgr); + wlr_output_layout_destroy(server.output_layout); + wl_display_destroy(server.wl_display); + return 0; +} diff --git a/arken/tools/genbuild.pl b/arken/tools/genbuild.pl new file mode 100644 index 0000000..1acabc0 --- /dev/null +++ b/arken/tools/genbuild.pl @@ -0,0 +1,48 @@ +#!/usr/bin/env perl + +$comment=""; + +print "#include \n"; +print "#include \n"; +print "#include \n"; +print "#include \n"; +print "#include \"plugin.h\"\n\n"; + +print "int load_plugin_from_dl_(dlhandle_t dl, plugin_t* plug)\n"; +print "{\n"; +print " void* ptr;\n"; +print " int ret = 0;\n"; +print "\n"; +print " const char** name = dlsym(dl, \"plugin_name\");\n"; +print " memset(plug, 0, sizeof(*plug));\n"; +print " if (name) {\n"; +print " plug->plugin_name = *name;\n"; +print " } else {\n"; +print " plug->plugin_name = NULL;\n"; +print " }\n"; +print " plug->state = NULL;\n"; +print " plug->library_handle = dl;\n"; +print "\n"; +while (<>) { + if (/^\s*EXPORT/) { + my $line = "$_"; + while (not ($line =~ /;$/)) { + my $nextline = ; + last unless defined $nextline; + + $line="$line$nextline"; + } + if ($line =~ /^\s*EXPORT\(\s*((?:\w|\s*\*\s*)+)\s*\(\*(\w+)\)\s*\((.*)\)\);/s) { + print "\n"; + print " ptr = dlsym(dl, \"$2\");\n"; + print " if (!ptr) {\n"; + print " fprintf(stderr, \"Plugin missing %s\\n\", \"$2\");\n"; + print " ret |= 1;\n"; + print " }\n"; + print " plug->$2 = ptr;\n"; + $comment=""; + } + } +} +print "\n return ret;\n"; +print "}\n"; diff --git a/arken/tools/genintf.pl b/arken/tools/genintf.pl new file mode 100644 index 0000000..794f966 --- /dev/null +++ b/arken/tools/genintf.pl @@ -0,0 +1,42 @@ +#!/usr/bin/env perl + +$comment=""; + +print "#ifndef _PLUG_INTF\n"; +print "#define _PLUG_INTF\n"; +print "\n#include \n"; +print "\n#include \n"; + +while () { + if (/^\s*\/\*/) { + $_ =~ s/^\s*//; + $comment="$_"; + next; + } + + if (/^\s*\*/) { + $_ =~ s/^\s*/ /; + $comment="$comment$_"; + next; + } + + if (/^\s*EXPORT_INCLUDE\((.*)\)/) { + print "#include $1\n"; + } elsif (/^\s*EXPORT/) { + my $line = "$_"; + while (not ($line =~ /;$/)) { + my $nextline = ; + last unless defined $nextline; + + $line="$line$nextline"; + } + if ($line =~ /^\s*EXPORT\(\s*((?:\w|\s*\*\s*)+)\s*\(\*(\w+)\)\s*\((.*)\)\);/s) { + print "$comment"; + print "$1 $2($3);\n\n"; + $comment=""; + } elsif ($line =~ /^\s*EXPORT\((.*)\);/s) { + print "$1\n"; + } + } +} +print "#endif /* _PLUG_INTF */\n"; diff --git a/montis/README.md b/montis/README.md new file mode 100644 index 0000000..5592f08 --- /dev/null +++ b/montis/README.md @@ -0,0 +1 @@ +The Plugin for the Montis Runtime. diff --git a/montis/package.yaml b/montis/package.yaml new file mode 100644 index 0000000..c381197 --- /dev/null +++ b/montis/package.yaml @@ -0,0 +1,87 @@ +name: montis + +github: "jrahm/montis" +license: BSD-3-Clause +author: "Author name here" +maintainer: "example@example.com" +copyright: "2024 Author name here" + +extra-source-files: +- README.md + +# Metadata used when publishing your package +# synopsis: Short description of your package +# category: Web + +# To avoid duplicated efforts in documentation and dealing with the +# complications of embedding Haddock markup inside cabal files, it is +# common to point users to the README.md file. +description: Please see the README on GitHub at + + +dependencies: +- base >= 4.7 && < 5 +- mtl +- bytestring +- containers +- data-default-class +- transformers +- monad-loops +- singletons + + +ghc-options: +- -Wall +- -Wcompat +- -Widentities +- -Wincomplete-record-updates +- -Wincomplete-uni-patterns +- -Wmissing-export-lists +- -Wmissing-home-modules +- -Wpartial-fields +- -Wredundant-constraints +- -XGHC2021 +- -XTypeFamilies +- -XUndecidableInstances +- -XGADTs +- -XFunctionalDependencies +- -XUndecidableSuperClasses +- -XDefaultSignatures +- -XViewPatterns +- -XDerivingVia +- -XDisambiguateRecordFields +- -XLambdaCase +- -XDataKinds +- -fPIC + +executables: + montis.so: + main: Config.hs + source-dirs: src + c-sources: src/harness_adapter.c + ghc-options: + - -shared + - -dynamic + - -no-hs-main + - -lHSrts-1.0.2-ghc9.4.7 + - -O3 + cc-options: + - -g3 + - -O2 + - -shared + - -I../build/ + - -I../arken/include/ + - -I../build/wlroots/include + - -I../build/wlroots-src/include + - -DWLR_USE_UNSTABLE + +tests: + montis-test: + main: Spec.hs + source-dirs: test + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - montis diff --git a/montis/src/Config.hs b/montis/src/Config.hs new file mode 100644 index 0000000..8ec06dd --- /dev/null +++ b/montis/src/Config.hs @@ -0,0 +1,33 @@ +module Config (config) where + +import Control.Monad.IO.Class (liftIO) +import Data.Bits (shiftL, (.&.)) +import Data.Word (Word32) +import Montis.Core +import Montis.Core.Runtime (warpCursor) +import Montis.Standard.Drag (DragConfig (DragConfig)) +import Montis.Standard.Keys (KeysConfig (KeysConfig), subkeys) +import Montis.Standard.Mouse (MouseConfig (MouseConfig)) + +keys :: KeyEvent -> Montis Bool +keys ev + | keyEvent_modifiers ev .&. mod1Mask == 0 = return False + | otherwise = case keyEvent_codepoint ev of + 'j' -> do + liftIO (putStrLn "j was pressed!") + subkeys $ \ev -> case keyEvent_codepoint ev of + 'k' -> do + liftIO (putStrLn "k was pressed after j!") + warpCursor 0 0 + return True + _ -> return False + _ -> return False + +mod1Mask :: Word32 +mod1Mask = 1 `shiftL` 3 -- WLR_MODIFIER_ALT + +config :: MontisConfig +config = + install MouseConfig $ + install (DragConfig mod1Mask) $ + install (KeysConfig keys) defaultConfig diff --git a/montis/src/Link.hs b/montis/src/Link.hs new file mode 100644 index 0000000..4ac3f5c --- /dev/null +++ b/montis/src/Link.hs @@ -0,0 +1,18 @@ +-- | Module that provides the start hooks using the config required to link the +-- plugin's shared library. +module Link () where + +import Config (config) +import Montis.Core + +foreign export ccall "plugin_cold_start" + coldStart :: MontisColdStart + +foreign export ccall "plugin_hot_start" + hotStart :: MontisHotStart + +coldStart :: MontisColdStart +coldStart = coldStartMontis config + +hotStart :: MontisHotStart +hotStart = hotStartMontis config diff --git a/montis/src/Montis/Base/Foreign/Runtime.hs b/montis/src/Montis/Base/Foreign/Runtime.hs new file mode 100644 index 0000000..427545a --- /dev/null +++ b/montis/src/Montis/Base/Foreign/Runtime.hs @@ -0,0 +1,37 @@ +module Montis.Base.Foreign.Runtime where + +import Data.Void +import Foreign.C (CInt (..), CString, CDouble (..)) +import Foreign.Ptr + +data ForeignMontisToplevel + +foreign import ccall "montis_do_request_hot_reload" foreign_doRequestHotReload :: Ptr Void -> IO () + +foreign import ccall "montis_do_request_log" foreign_doRequestLog :: Ptr Void -> CString -> IO () + +foreign import ccall "montis_do_request_exit" foreign_doRequestExit :: Ptr Void -> CInt -> IO () + +foreign import ccall "montis_plugin_get_seat" foreign_getSeat :: Ptr Void -> IO (Ptr Void) + +foreign import ccall "montis_plugin_toplevel_at" + foreign_toplevelAt :: Ptr Void -> CDouble -> CDouble -> IO (Ptr ForeignMontisToplevel) + +foreign import ccall "montis_plugin_get_toplevel_position" + foreign_getToplevelPosition :: Ptr ForeignMontisToplevel -> Ptr CDouble -> Ptr CDouble -> IO () + +foreign import ccall "montis_plugin_set_toplevel_position" + foreign_setToplevelPosition :: Ptr ForeignMontisToplevel -> CDouble -> CDouble -> IO () + +foreign import ccall "montis_plugin_get_toplevel_geometry" + foreign_getToplevelGeometry :: + Ptr ForeignMontisToplevel -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> IO () + +foreign import ccall "montis_plugin_set_toplevel_geometry" + foreign_setToplevelGeometry :: Ptr ForeignMontisToplevel -> CDouble -> CDouble -> CDouble -> CDouble -> IO () + +foreign import ccall "montis_plugin_focus_toplevel" + foreign_focusToplevel :: Ptr ForeignMontisToplevel -> IO () + +foreign import ccall "montis_plugin_warp_cursor" + foreign_warpCursor :: Ptr Void -> CDouble -> CDouble -> IO () diff --git a/montis/src/Montis/Base/Foreign/WlRoots.hs b/montis/src/Montis/Base/Foreign/WlRoots.hs new file mode 100644 index 0000000..272567f --- /dev/null +++ b/montis/src/Montis/Base/Foreign/WlRoots.hs @@ -0,0 +1,44 @@ +-- | Contains functions and thin wrappers via ffi to the wlroots API. +module Montis.Base.Foreign.WlRoots where + +import Foreign (Ptr, Word32, nullPtr) +import Montis.Base.Foreign.WlRoots.Types + +-- | Converts a null pointer into 'Nothing' to avoid dangling FFI handles. +guardNull :: Ptr a -> Maybe (Ptr a) +guardNull p | p == nullPtr = Nothing +guardNull p = Just p + +foreign import ccall "wlr_seat_set_keyboard" + foreign_wlrSetSeatKeyboard :: + Ptr ForeignWlrSeat -> Ptr ForeignWlrInputDevice -> IO () + +-- | Binds the given input device as the active keyboard for a seat. +setSeatKeyboard :: WlrSeat -> WlrInputDevice -> IO () +setSeatKeyboard (WlrSeat p1) (WlrInputDevice p2) = + foreign_wlrSetSeatKeyboard p1 p2 + +foreign import ccall "wlr_seat_get_keyboard" + foreign_wlrSeatGetKeyboard :: + Ptr ForeignWlrSeat -> IO (Ptr ForeignWlrKeyboard) + +-- | Looks up the current keyboard for a seat, if one exists. +getSeatKeyboard :: WlrSeat -> IO (Maybe WlrKeyboard) +getSeatKeyboard (WlrSeat p) = + fmap WlrKeyboard . guardNull <$> foreign_wlrSeatGetKeyboard p + +foreign import ccall "wlr_keyboard_get_modifiers" + foreign_wlrKeyboardGetModifiers :: + Ptr ForeignWlrKeyboard -> IO Word32 + +-- | Returns the current keyboard modifier mask for the keyboard. +getKeyboardModifiers :: WlrKeyboard -> IO Word32 +getKeyboardModifiers (WlrKeyboard p) = foreign_wlrKeyboardGetModifiers p + +foreign import ccall "wlr_seat_keyboard_notify_key" + foreign_wlrSeatKeyboardNotifyKey :: + Ptr ForeignWlrSeat -> Word32 -> Word32 -> Word32 -> IO () + +-- | Forwards a key event to the seat with time, keycode, and state. +seatKeyboardNotifyKey :: WlrSeat -> Word32 -> Word32 -> Word32 -> IO () +seatKeyboardNotifyKey (WlrSeat p) = foreign_wlrSeatKeyboardNotifyKey p diff --git a/montis/src/Montis/Base/Foreign/WlRoots/Types.hs b/montis/src/Montis/Base/Foreign/WlRoots/Types.hs new file mode 100644 index 0000000..c109653 --- /dev/null +++ b/montis/src/Montis/Base/Foreign/WlRoots/Types.hs @@ -0,0 +1,99 @@ +module Montis.Base.Foreign.WlRoots.Types where + +import Foreign (IntPtr, Ptr, intPtrToPtr, ptrToIntPtr) +import Text.Read + +-- | Opaque foreign type for a wlroots keyboard. +data ForeignWlrKeyboard + +newtype WlrKeyboard where + WlrKeyboard :: Ptr ForeignWlrKeyboard -> WlrKeyboard + deriving (Show, Ord, Eq) + +-- | Opaque foreign type for a wlroots pointer. +data ForeignWlrPointer + +newtype WlrPointer where + WlrPointer :: Ptr ForeignWlrPointer -> WlrPointer + deriving (Show, Ord, Eq) + +-- | Opaque foreign type for wlroots pointer button events. +data ForeignWlrPointerButtonEvent + +newtype WlrPointerButtonEvent where + WlrPointerButtonEvent :: Ptr ForeignWlrPointerButtonEvent -> WlrPointerButtonEvent + deriving (Show, Ord, Eq) + +-- | Opaque foreign type for wlroots pointer motion events. +data ForeignWlrPointerMotionEvent + +newtype WlrPointerMotionEvent where + WlrPointerMotionEvent :: Ptr ForeignWlrPointerMotionEvent -> WlrPointerMotionEvent + deriving (Show, Ord, Eq) + +-- | Opaque foreign type for wlroots absolute pointer motion events. +data ForeignWlrPointerMotionAbsoluteEvent + +newtype WlrPointerMotionAbsoluteEvent where + WlrPointerMotionAbsoluteEvent :: Ptr ForeignWlrPointerMotionAbsoluteEvent -> WlrPointerMotionAbsoluteEvent + deriving (Show, Ord, Eq) + +-- | Opaque foreign type for a wlroots seat. +data ForeignWlrSeat + +newtype WlrSeat where + WlrSeat :: Ptr ForeignWlrSeat -> WlrSeat + deriving (Show, Ord, Eq) + +-- | Opaque foreign type for a wlroots input device. +data ForeignWlrInputDevice + +newtype WlrInputDevice where + WlrInputDevice :: Ptr ForeignWlrInputDevice -> WlrInputDevice + deriving (Show, Ord, Eq) + +-- | Opaque foreign type for wlroots keyboard key events. +data ForeignWlrEventKeyboardKey + +newtype WlrEventKeyboardKey where + WlrEventKeyboardKey :: Ptr ForeignWlrEventKeyboardKey -> WlrEventKeyboardKey + deriving (Show, Ord, Eq) + +-- | Opaque foreign type for xdg-shell surfaces. +data ForeignWlrXdgSurface + +-- | Opaque foreign type for XWayland surfaces. +data ForeignWlrXWaylandSurface + +-- | Tagged wrapper over surface pointer variants. +data Surface where + XdgSurface :: Ptr ForeignWlrXdgSurface -> Surface + XWaylandSurface :: Ptr ForeignWlrXWaylandSurface -> Surface + deriving (Ord, Eq) + +instance Show Surface where + show (XdgSurface p) = show (XdgSerializeSurface (ptrToIntPtr p)) + show (XWaylandSurface p) = show (XWaylandSerializeSurface (ptrToIntPtr p)) + +instance Read Surface where + readPrec = fmap toSurf readPrec + where + -- Rebuild constructors from serialized pointers. + toSurf (XdgSerializeSurface ip) = XdgSurface (intPtrToPtr ip) + toSurf (XWaylandSerializeSurface ip) = XWaylandSurface (intPtrToPtr ip) + +-- | Serializable version of 'Surface' to enable Read/Show. +data SerializableSurface + = XdgSerializeSurface IntPtr + | XWaylandSerializeSurface IntPtr + deriving (Read, Show) + +class ForeignSurface a where + -- | Converts a foreign surface pointer into the tagged wrapper. + toSurface :: Ptr a -> Surface + +instance ForeignSurface ForeignWlrXdgSurface where + toSurface = XdgSurface + +instance ForeignSurface ForeignWlrXWaylandSurface where + toSurface = XWaylandSurface diff --git a/montis/src/Montis/Core.hs b/montis/src/Montis/Core.hs new file mode 100644 index 0000000..5399f1e --- /dev/null +++ b/montis/src/Montis/Core.hs @@ -0,0 +1,10 @@ +module Montis.Core + ( module X, + ) +where + +import Montis.Core.Events as X +import Montis.Core.Monad as X +import Montis.Core.Runtime as X +import Montis.Core.Start as X +import Montis.Core.State as X diff --git a/montis/src/Montis/Core/Events.hs b/montis/src/Montis/Core/Events.hs new file mode 100644 index 0000000..91b8618 --- /dev/null +++ b/montis/src/Montis/Core/Events.hs @@ -0,0 +1,46 @@ +module Montis.Core.Events where + +import Data.Word (Word32) +import Montis.Base.Foreign.WlRoots.Types + +data KeyState = KeyPressed | KeyReleased deriving (Show, Read, Eq, Enum, Ord) + +data KeyEvent = KeyEvent + { keyEvent_timeMs :: Word32, + keyEvent_keycode :: Word32, + keyEvent_state :: KeyState, + keyEvent_modifiers :: Word32, + keyEvent_keysym :: Word32, + keyEvent_codepoint :: Char, + keyEvent_device :: WlrInputDevice + } + deriving (Show, Ord, Eq) + +data ButtonState = ButtonReleased | ButtonPressed deriving (Show, Read, Eq, Enum, Ord) + +data ButtonEvent = ButtonEvent + { buttonEvent_pointer :: WlrPointer, + buttonEvent_timeMs :: Word32, + buttonEvent_button :: Word32, + buttonEvent_modifiers :: Word32, + buttonEvent_state :: ButtonState + } + deriving (Eq, Show, Ord) + +data MotionEvent = MotionEvent + { motionEvent_pointer :: WlrPointer, + motionEvent_timeMs :: Word32, + motionEvent_modifiers :: Word32, + motionEvent_absolute :: (Double, Double), + motionEvent_raw :: (Double, Double) + } + deriving (Eq, Show, Ord) + +data SurfaceState = Map | Unmap | Destroy + deriving (Eq, Ord, Show, Read, Enum) + +data SurfaceEvent = SurfaceEvent + { surfaceEvent_state :: SurfaceState, + surfaceEvent_surface :: Surface + } + deriving (Eq, Ord, Show) diff --git a/montis/src/Montis/Core/Extensions.hs b/montis/src/Montis/Core/Extensions.hs new file mode 100644 index 0000000..0e8384f --- /dev/null +++ b/montis/src/Montis/Core/Extensions.hs @@ -0,0 +1,30 @@ +module Montis.Core.Extensions where + +import Data.Data + ( Typeable, + tyConModule, + tyConName, + tyConPackage, + ) +import Data.Kind (Constraint, Type) +import Text.Printf (printf) +import Type.Reflection (someTypeRep, someTypeRepTyCon) + +-- | A key to key into the Extension maps. +data ExtensionKey where + ExtensionKey :: {extensionKeyValue :: String} -> ExtensionKey + deriving (Eq, Ord, Show) + +data Extension (c :: Type -> Constraint) where + Extension :: (Typeable a, c a) => a -> Extension c + +class Nil a +instance Nil a + +-- | Produces a string representation of a type used to key into the extensible +-- state map. +typeRepr :: forall proxy a. (Typeable a) => proxy a -> ExtensionKey +typeRepr proxy = ExtensionKey $ tyconToStr $ someTypeRepTyCon (someTypeRep proxy) + where + tyconToStr tc = + printf "%s.%s.%s" (tyConPackage tc) (tyConModule tc) (tyConName tc) diff --git a/montis/src/Montis/Core/Internal/Foreign/Export.hs b/montis/src/Montis/Core/Internal/Foreign/Export.hs new file mode 100644 index 0000000..faa1964 --- /dev/null +++ b/montis/src/Montis/Core/Internal/Foreign/Export.hs @@ -0,0 +1,226 @@ +-- | This module has no public functions, but provides the surface interface +-- between the Montis runtime and the plugin. +module Montis.Core.Internal.Foreign.Export () where + +import Control.Monad (forM_) +import Control.Monad.State (MonadIO (liftIO), gets) +import Data.ByteString qualified as BS +import Data.ByteString.Char8 qualified as CH +import Data.Singletons.Decide (Void) +import Foreign + ( Ptr, + Storable (poke, pokeByteOff), + Word32, + Word8, + deRefStablePtr, + freeStablePtr, + mallocBytes, + newStablePtr, + ) +import Foreign.C (CChar, CDouble (..), CInt (..)) +import Foreign.Ptr (castPtr) +import Montis.Base.Foreign.WlRoots.Types + ( ForeignSurface (toSurface), + ForeignWlrInputDevice, + ForeignWlrPointer, + ForeignWlrXWaylandSurface, + ForeignWlrXdgSurface, + WlrEventKeyboardKey, + WlrInputDevice (WlrInputDevice), + WlrPointer (WlrPointer), + WlrPointerButtonEvent, + ) +import Montis.Core +import Montis.Core.State +import Montis.Core.State.Marshal (marshalState) +import Montis.Foreign.Marshal (Demarshal (Demarshal), demarshal, runDemarshal) + +-- | Helpers to unpack the opaque state, run a Montis action, and re-wrap it. +-- Each call consumes the old stable pointer and returns a fresh one. +runForeign :: + Montis () -> + OpqStT -> + IO OpqStT +runForeign fn stableptr = do + (ctx, st) <- deRefStablePtr stableptr + freeStablePtr stableptr + (_, state') <- runMontis ctx st fn + newStablePtr (ctx, state') + +runForeignWithReturn :: + (Storable a) => + Montis a -> + Ptr a -> + OpqStT -> + IO OpqStT +runForeignWithReturn fn outptr stableptr = do + (ctx, st) <- deRefStablePtr stableptr + freeStablePtr stableptr + (val, state') <- runMontis ctx st fn + poke outptr val + newStablePtr (ctx, state') + +-- ---------------------------------------------------------------------- +-- State marshal/export + +-- | Marshals the opaque state to a C-style byte array and size pointer. +foreign export ccall "plugin_marshal_state" + pluginMarshalState :: OpqStT -> Ptr Word32 -> IO (Ptr Word8) + +pluginMarshalState :: OpqStT -> Ptr Word32 -> IO (Ptr Word8) +pluginMarshalState opqStT outlen = do + (_, st) <- deRefStablePtr opqStT + let bs = CH.pack (marshalState st) + ret <- mallocBytes (BS.length bs) + poke outlen (fromIntegral $ BS.length bs) + forM_ (zip [0 ..] (BS.unpack bs)) $ \(off, w8) -> do + pokeByteOff ret off w8 + return ret + +-- ---------------------------------------------------------------------- +-- Input handlers + +foreign export ccall "plugin_handle_button" + pluginHandleButton :: Ptr WlrPointerButtonEvent -> Word32 -> OpqStT -> IO OpqStT + +pluginHandleButton :: Ptr WlrPointerButtonEvent -> Word32 -> OpqStT -> IO OpqStT +pluginHandleButton eventPtr modifiers = + runForeign $ do + s <- gets currentHooks + event <- liftIO $ + runDemarshal eventPtr $ do + -- Follows struct wlr_pointer_button_event field order. + pointerPtr <- demarshal :: Demarshal (Ptr ForeignWlrPointer) + tMs <- demarshal + button <- demarshal + state <- demarshal :: Demarshal Word8 + return $ + ButtonEvent + (WlrPointer pointerPtr) + tMs + button + modifiers + (if state == (0 :: Word8) then ButtonReleased else ButtonPressed) + + buttonHook s event + +-- ---------------------------------------------------------------------- +-- Keybinding handler + +foreign export ccall "plugin_handle_keybinding" + pluginHandleKeybinding :: + Ptr ForeignWlrInputDevice -> + Ptr WlrEventKeyboardKey -> + Word32 -> + Word32 -> + Word32 -> + Ptr CInt -> + OpqStT -> + IO OpqStT + +pluginHandleKeybinding :: + Ptr ForeignWlrInputDevice -> + Ptr WlrEventKeyboardKey -> + Word32 -> + Word32 -> + Word32 -> + Ptr CInt -> + OpqStT -> + IO OpqStT +pluginHandleKeybinding inputDevicePtr eventPtr mods sym cp = + runForeignWithReturn $ do + s <- gets currentHooks + event <- liftIO $ + runDemarshal eventPtr $ do + -- Matches struct wlr_keyboard_key_event in wlroots. + tMs <- demarshal + kc <- demarshal + _ <- (demarshal :: Demarshal Word32) + keyState <- demarshal + return $ + KeyEvent + tMs + kc + (if keyState == (0 :: Word8) then KeyReleased else KeyPressed) + mods + sym + (toEnum $ fromIntegral cp) + (WlrInputDevice inputDevicePtr) + + keyHook s event + return 1 + +-- ---------------------------------------------------------------------- +-- Motion handler + +foreign export ccall "plugin_handle_motion" + pluginHandleMotion :: Ptr Void -> Word32 -> Word32 -> CDouble -> CDouble -> OpqStT -> IO OpqStT + +pluginHandleMotion :: Ptr Void -> Word32 -> Word32 -> CDouble -> CDouble -> OpqStT -> IO OpqStT +pluginHandleMotion eventPtr modifiers isAbsolute lx ly = + runForeign $ do + s <- gets currentHooks + event <- liftIO $ + if isAbsolute == 0 + then + runDemarshal (castPtr eventPtr) $ do + pointerPtr <- demarshal :: Demarshal (Ptr ForeignWlrPointer) + tMs <- demarshal + _ <- demarshal :: Demarshal Word32 + _ <- demarshal :: Demarshal Double + _ <- demarshal :: Demarshal Double + _ <- demarshal :: Demarshal Double + _ <- demarshal :: Demarshal Double + return $ + MotionEvent + (WlrPointer pointerPtr) + tMs + modifiers + (realToFrac lx, realToFrac ly) + (0, 0) + else + runDemarshal (castPtr eventPtr) $ do + -- After time_msec, wlroots pads to 8-byte alignment for doubles. + pointerPtr <- demarshal :: Demarshal (Ptr ForeignWlrPointer) + tMs <- demarshal + _ <- demarshal :: Demarshal Word32 + rawX <- demarshal + rawY <- demarshal + return $ + MotionEvent + (WlrPointer pointerPtr) + tMs + modifiers + (realToFrac lx, realToFrac ly) + (rawX, rawY) + + motionHook s event + +-- ---------------------------------------------------------------------- +-- Surface handlers + +-- | Function exported to the harness to handle the mapping/unmapping/deletion +-- of an XDG surface. +foreign export ccall "plugin_handle_surface" + pluginHandleSurface :: + Ptr ForeignWlrXdgSurface -> CInt -> OpqStT -> IO OpqStT + +pluginHandleSurface :: + Ptr ForeignWlrXdgSurface -> CInt -> OpqStT -> IO OpqStT +pluginHandleSurface p t = + runForeign $ do + s <- gets currentHooks + surfaceHook s (SurfaceEvent (toEnum $ fromIntegral t) (toSurface p)) + +-- | Function exported to the harness to handle the mapping/unmapping/deletion +-- of an XWayland surface. +foreign export ccall "plugin_handle_xwayland_surface" + pluginHandleXWaylandSurface :: + Ptr ForeignWlrXWaylandSurface -> CInt -> OpqStT -> IO OpqStT + +pluginHandleXWaylandSurface :: + Ptr ForeignWlrXWaylandSurface -> CInt -> OpqStT -> IO OpqStT +pluginHandleXWaylandSurface p t = + runForeign $ do + s <- gets currentHooks + surfaceHook s (SurfaceEvent (toEnum $ fromIntegral t) (toSurface p)) diff --git a/montis/src/Montis/Core/Monad.hs b/montis/src/Montis/Core/Monad.hs new file mode 100644 index 0000000..b7d1633 --- /dev/null +++ b/montis/src/Montis/Core/Monad.hs @@ -0,0 +1,125 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Montis.Core.Monad where + +import Control.Monad.Identity (Identity (Identity)) +import Control.Monad.Reader +import Control.Monad.State (MonadState, StateT (runStateT), gets, modify') +import Data.Default.Class (Default (def)) +import Data.Map qualified as Map +import Data.Maybe (fromMaybe) +import Data.Typeable +import Foreign (StablePtr) +import Montis.Core.Extensions (Extension (Extension), typeRepr) +import Montis.Core.State + +-- | A Config type for the Montis monad. +type MontisConfig = Config Montis + +-- | A Context type specific for the Montis monad. +type MontisContext = Context Montis + +-- | A State type for the Montis monad. +type MontisState = State Montis + +-- | The Opaque State Type passed between the plugin and the runtime. The +-- OpqStT *is* the opq_st_t from the runtime code. +type OpqStT = StablePtr (MontisContext, MontisState) + +-- | The Montis monad is a Reader over an immutable context plus a State over +-- mutable runtime state, all ultimately running in IO for host effects. +newtype Montis a where + Montis :: (ReaderT MontisContext (StateT MontisState IO) a) -> Montis a + deriving (Functor, Applicative, Monad, MonadState MontisState, MonadIO) + +-- | Reader access is scoped to the config portion of the full context; this +-- keeps plugin code from mutating the context while still allowing read-only +-- access to configuration. +instance MonadReader MontisConfig Montis where + ask :: Montis MontisConfig + ask = Montis $ asks ctxConfig + + reader :: (MontisConfig -> a) -> Montis a + reader fn = Montis $ asks (fn . ctxConfig) + + local :: (MontisConfig -> MontisConfig) -> Montis a -> Montis a + local cfn (Montis fn) = + Montis $ local (\ctx -> ctx {ctxConfig = cfn (ctxConfig ctx)}) fn + +-- | Access the plugin self pointer stored in the context. +getSelfPtr :: Montis SelfPtr +getSelfPtr = Montis $ asks ctxSelfPtr + +-- | Run a Montis action with a fixed context and initial state, returning the +-- result value and the updated state. +runMontis :: MontisContext -> MontisState -> Montis a -> IO (a, MontisState) +runMontis ctx initState (Montis m) = runStateT (runReaderT m ctx) initState + +-- | The standard default config. +defaultConfig :: MontisConfig +defaultConfig = + Config + { startingHooks = + Hooks + { keyHook = const (return ()), + surfaceHook = const (return ()), + buttonHook = const (return ()), + motionHook = const (return ()) + }, + -- Default hooks are no-ops except for basic printing, which makes the + -- system usable without extra wiring during development. + startupHook = return (), + resetHook = return (), + -- Extensions start empty; callers can register config extensions as needed. + configExtensions = mempty + } + +-- | Store a typed extension in the extensible state map under its TypeRep. +-- The value is wrapped so the map remains heterogeneously typed. +xStatePut :: forall a. (StateExtension a) => a -> Montis () +xStatePut xst = do + modify' + ( \st -> + st + { extensibleState = + Map.insert + (typeRepr (Identity xst)) + (Right (Extension xst)) + (extensibleState st) + } + ) + +-- | Retrieve a typed extension, demarshalling it if needed and caching it back. +-- When the extension is stored in marshalled form, it is decoded and then +-- reinserted so future lookups are fast. +xStateGet :: forall a. (StateExtension a) => Montis a +xStateGet = do + mp <- gets extensibleState + case lookupByType (Proxy :: Proxy a) mp of + Nothing -> return initialValue + Just (Right (Extension v)) -> return $ fromMaybe initialValue (cast v) + Just (Left s) -> do + let x = (demarshalExtension s :: Maybe a) + in forM_ x xStatePut >> return (fromMaybe initialValue x) + +-- | Modifies the typed extension bi the given function. +xStateModify :: forall a. (StateExtension a) => (a -> a) -> Montis () +xStateModify fn = do + s <- xStateGet + (xStatePut . fn) s + +xStateModifyM :: forall a. (StateExtension a) => (a -> Montis a) -> Montis () +xStateModifyM fn = do + s <- xStateGet + xStatePut =<< fn s + +-- | Retrieve a typed configuration extension or return the default +-- instance if the extension had not been configured. +xConfigGet :: forall a. (Typeable a, Default a) => Montis a +xConfigGet = do + exts <- asks configExtensions + return $ + fromMaybe def $ + Map.lookup (typeRepr (Proxy :: Proxy a)) exts + >>= (\(Extension a) -> cast a) diff --git a/montis/src/Montis/Core/Plugin/Interface.hs b/montis/src/Montis/Core/Plugin/Interface.hs new file mode 100644 index 0000000..73c0371 --- /dev/null +++ b/montis/src/Montis/Core/Plugin/Interface.hs @@ -0,0 +1,20 @@ +-- | Provides the plugin interface through foreign exports. +module Montis.Core.Plugin.Interface where + +import Data.ByteString (ByteString) +import Data.Data (Typeable) +import Data.Singletons.Decide (Void) +import Foreign (Ptr, StablePtr, Word32) +import Foreign.C (CChar) +import Montis.Core.State (SelfPtr) + +-- type OpqStT l w = StablePtr (Context l w, State l w) + +class OpaqueState s where + hotStart :: SelfPtr -> ByteString -> IO s + + coldStart :: SelfPtr -> IO s + + marshalState :: s -> ByteString + + teardown :: s -> IO () diff --git a/montis/src/Montis/Core/Runtime.hs b/montis/src/Montis/Core/Runtime.hs new file mode 100644 index 0000000..0d4c905 --- /dev/null +++ b/montis/src/Montis/Core/Runtime.hs @@ -0,0 +1,82 @@ +module Montis.Core.Runtime + ( ToplevelHandle, + focusToplevel, + getSeat, + getToplevelGeometry, + setToplevelGeometry, + setToplevelPosition, + toplevelAt, + warpCursor, + ) +where + +import Control.Monad.IO.Class (liftIO) +import Data.Void (Void) +import Foreign (Ptr) +import Foreign.C (CDouble (..)) +import Foreign.Marshal.Alloc (alloca) +import Foreign.Ptr (castPtr, nullPtr) +import Foreign.Storable (peek) +import Montis.Base.Foreign.Runtime +import Montis.Base.Foreign.WlRoots.Types (ForeignWlrSeat, WlrSeat (WlrSeat)) +import Montis.Core.Monad (Montis, getSelfPtr) +import Montis.Core.State (SelfPtr (..)) + +type ToplevelHandle = Ptr ForeignMontisToplevel + +unwrapSelf :: SelfPtr -> Ptr Void +unwrapSelf (SelfPtr p) = p + +getSeat :: Montis (Maybe WlrSeat) +getSeat = do + self <- getSelfPtr + seatPtr <- liftIO $ foreign_getSeat (unwrapSelf self) + if seatPtr == nullPtr + then return Nothing + else return $ Just (WlrSeat (castPtr seatPtr :: Ptr ForeignWlrSeat)) + +toplevelAt :: Double -> Double -> Montis (Maybe ToplevelHandle) +toplevelAt lx ly = do + self <- getSelfPtr + tl <- liftIO $ foreign_toplevelAt (unwrapSelf self) (realToFrac lx) (realToFrac ly) + if tl == nullPtr + then return Nothing + else return (Just tl) + +getToplevelGeometry :: ToplevelHandle -> Montis (Double, Double, Double, Double) +getToplevelGeometry tl = + liftIO $ + alloca $ \xPtr -> alloca $ \yPtr -> alloca $ \wPtr -> alloca $ \hPtr -> do + foreign_getToplevelGeometry tl xPtr yPtr wPtr hPtr + x <- peek xPtr + y <- peek yPtr + w <- peek wPtr + h <- peek hPtr + return + ( realToFrac (x :: CDouble), + realToFrac (y :: CDouble), + realToFrac (w :: CDouble), + realToFrac (h :: CDouble) + ) + +setToplevelGeometry :: ToplevelHandle -> Double -> Double -> Double -> Double -> Montis () +setToplevelGeometry tl x y w h = + liftIO $ + foreign_setToplevelGeometry + tl + (realToFrac x) + (realToFrac y) + (realToFrac w) + (realToFrac h) + +setToplevelPosition :: ToplevelHandle -> Double -> Double -> Montis () +setToplevelPosition tl x y = + liftIO $ foreign_setToplevelPosition tl (realToFrac x) (realToFrac y) + +focusToplevel :: ToplevelHandle -> Montis () +focusToplevel tl = liftIO $ foreign_focusToplevel tl + +warpCursor :: Double -> Double -> Montis () +warpCursor lx ly = do + self <- getSelfPtr + liftIO $ foreign_warpCursor (unwrapSelf self) (realToFrac lx) (realToFrac ly) diff --git a/montis/src/Montis/Core/Start.hs b/montis/src/Montis/Core/Start.hs new file mode 100644 index 0000000..54ec8c5 --- /dev/null +++ b/montis/src/Montis/Core/Start.hs @@ -0,0 +1,38 @@ +module Montis.Core.Start where + +import Data.ByteString qualified as BS +import Data.ByteString.Char8 qualified as CH +import Data.Void +import Foreign (Word32, newStablePtr) +import Foreign.C (CChar) +import Foreign.Ptr +import Montis.Core.Monad +import Montis.Core.State +import Montis.Core.State.Marshal (demarshalState) + +type MontisColdStart = Ptr Void -> IO OpqStT + +type MontisHotStart = Ptr Void -> Ptr CChar -> Word32 -> IO OpqStT + +hotStartMontis :: MontisConfig -> MontisHotStart +hotStartMontis config self chars len = do + bs <- BS.packCStringLen (chars, fromIntegral len) + + let ctx = Context config (SelfPtr self) + st = demarshalState config (CH.unpack bs) + + ((), st') <- runMontis ctx st (resetHook config) + newStablePtr (ctx, st') + +-- Used to start montis given the provided config. +coldStartMontis :: MontisConfig -> MontisColdStart +coldStartMontis conf selfPtr = + let ctx = Context conf (SelfPtr selfPtr) + st = + State + { currentHooks = startingHooks conf, + extensibleState = mempty + } + in do + ((), st') <- runMontis ctx st (startupHook conf) + newStablePtr (ctx, st') diff --git a/montis/src/Montis/Core/State.hs b/montis/src/Montis/Core/State.hs new file mode 100644 index 0000000..ce8f903 --- /dev/null +++ b/montis/src/Montis/Core/State.hs @@ -0,0 +1,116 @@ +-- | Definitions of montis core state. +module Montis.Core.State where + +import Data.Data (Proxy (Proxy), Typeable) +import Data.Default.Class (Default, def) +import Data.Map qualified as M +import Data.Void (Void) +import Foreign (Ptr) +import Montis.Core.Events +import Montis.Core.Extensions +import Text.Read (readMaybe) + +-- | An opaque type used for the plugin's self-reference. +newtype SelfPtr where + SelfPtr :: Ptr Void -> SelfPtr + +-- | This is the context the plugin operates under. The context contains data +-- which must be provided by the runtime or the configuration. This data may not +-- be cold-created. +-- +-- Parameters: +-- `m` the monad for this Context. This is typically W. +data Context m where + Context :: + { ctxConfig :: Config m, + ctxSelfPtr :: SelfPtr + } -> + Context m + +-- | Montis configuration. This is the structure that defines the user-written +-- configuration, which is linked in. +data Config m where + Config :: + { startingHooks :: Hooks m, + startupHook :: m (), + resetHook :: m (), + configExtensions :: M.Map ExtensionKey (Extension Nil) + } -> + Config m + +-- | Hooks the runtime can call. +data Hooks m where + Hooks :: + { keyHook :: KeyEvent -> m (), + surfaceHook :: SurfaceEvent -> m (), + buttonHook :: ButtonEvent -> m (), + motionHook :: MotionEvent -> m () + } -> + Hooks m + +-- | Class for a configurable model. +class (Typeable a) => ConfigModule m a where + alterConfig :: a -> Config m -> Config m + +-- | Configures a typed configuration extension. +install :: forall a m. (ConfigModule m a) => a -> Config m -> Config m +install a c = + alterConfig a $ + c + { configExtensions = + M.insert + (typeRepr (Proxy :: Proxy a)) + (Extension a) + (configExtensions c) + } + +-- | Typeclass defining the set of types which can be used as state extensions +-- to the W monad. These state extensions may be persistent or not. +-- +-- There are default implementations for all methods if the type implements +-- Read, Show and Default, +class (Typeable a) => StateExtension a where + -- | The initial value used for the first time an extension is 'gotten' or + -- demarshalling fails. + initialValue :: a + + -- | Transforms a type into a string. If the type cannot be marshalled, this + -- function should return Nothing. + -- + -- If a type cannot be marshalled, it cannot persist across hot reloads. + marshalExtension :: a -> Maybe String + + -- | Reads an extension from a string. If this type is not marshallable or + -- reading fails, this function should return Nothing. + demarshalExtension :: String -> Maybe a + + -- | If the type implements Default, use the default implementation. + default initialValue :: (Default a) => a + initialValue = def + + -- | If the type implements Show, use show for the marshalling. + default marshalExtension :: (Show a) => a -> Maybe String + marshalExtension = Just . show + + -- | If the type implements Read, use read for the demarshalling. + default demarshalExtension :: (Read a) => String -> Maybe a + demarshalExtension = readMaybe + +-- | State type. This type contains changeable data. +data State m where + State :: + { -- The datastructure containing the state of the windows. + + -- | Current set of hooks. The initial hooks are provided by the + -- configuration, but the hooks can change during operation. This is how + -- key sequences can be mapped. + currentHooks :: Hooks m, + -- | Map from the typerep string to the state extension. + extensibleState :: + M.Map ExtensionKey (Either String (Extension StateExtension)) + } -> + State m + +-- | Lookup from an extension map by type. +lookupByType :: (Typeable a) => proxy a -> M.Map ExtensionKey b -> Maybe b +lookupByType pxy = M.lookup (typeRepr pxy) diff --git a/montis/src/Montis/Core/State/Marshal.hs b/montis/src/Montis/Core/State/Marshal.hs new file mode 100644 index 0000000..04a2a57 --- /dev/null +++ b/montis/src/Montis/Core/State/Marshal.hs @@ -0,0 +1,44 @@ +module Montis.Core.State.Marshal (marshalState, demarshalState) where + +import Data.Map qualified as M +import Data.Maybe (mapMaybe) +import Montis.Core.Extensions +import Montis.Core.State + +data MarshalledState where + MarshalledState :: + [(String, String)] -> + MarshalledState + deriving (Show, Read) + +-- | Marshals the serializable parts of the state to a string. This happens +-- during a hot-reload where some state must be saved to persist across hot +-- reloads. +-- Only the extensible state is persisted; hooks and other runtime data are +-- reconstructed from the config on restart. +marshalState :: State m -> String +marshalState + ( State + { extensibleState = xs + } + ) = + show $ + MarshalledState + (mapMaybe (\(k, v) -> (extensionKeyValue k,) <$> doMarshalEx v) (M.toList xs)) + where + -- Left values are already marshalled; Right values are re-encoded here. + doMarshalEx :: Either String (Extension StateExtension) -> Maybe String + doMarshalEx (Left s) = Just s + doMarshalEx (Right (Extension a)) = marshalExtension a + +-- | Demarshals the string from "marshalState" into a state. Uses the provided +-- config to fill out non-persistent parts of the state. +-- The extensible map is rehydrated as marshalled strings so decoding can be +-- deferred until a specific extension is requested. +demarshalState :: Config m -> String -> State m +demarshalState Config {startingHooks = hooks} str = + State hooks xs + where + ( MarshalledState + (M.mapKeys ExtensionKey . fmap Left . M.fromList -> xs) + ) = read str diff --git a/montis/src/Montis/Foreign/Marshal.hs b/montis/src/Montis/Foreign/Marshal.hs new file mode 100644 index 0000000..157d928 --- /dev/null +++ b/montis/src/Montis/Foreign/Marshal.hs @@ -0,0 +1,20 @@ +module Montis.Foreign.Marshal where + +import Control.Monad.State +import Data.Word +import Foreign (Ptr, Storable (peek, sizeOf), castPtr, plusPtr) + +type Offset = Word32 + +newtype Demarshal a = Demarshal (StateT (Ptr ()) IO a) + deriving (Functor, Monad, Applicative, MonadState (Ptr ())) + +runDemarshal :: Ptr b -> Demarshal a -> IO a +runDemarshal p (Demarshal dm) = evalStateT dm (castPtr p) + +demarshal :: (Storable a) => Demarshal a +demarshal = do + ptr <- get + val <- Demarshal $ lift $ peek $ castPtr ptr + put (plusPtr ptr (sizeOf val)) + return val diff --git a/montis/src/Montis/Standard/Drag.hs b/montis/src/Montis/Standard/Drag.hs new file mode 100644 index 0000000..a6ee878 --- /dev/null +++ b/montis/src/Montis/Standard/Drag.hs @@ -0,0 +1,123 @@ +module Montis.Standard.Drag where + +import Data.Bits ((.&.)) +import Data.Data (Typeable) +import Data.Word (Word32) +import Montis.Core +import Montis.Core.Runtime +import Montis.Core.State + ( Config (startingHooks), + ConfigModule (..), + Hooks (buttonHook, motionHook), + StateExtension (..), + ) +import Montis.Standard.Mouse (CursorPosition (CursorPosition)) + +data DragConfig where + DragConfig :: + { dragModifierMask :: Word32 + } -> + DragConfig + deriving (Typeable) + +instance ConfigModule Montis DragConfig where + alterConfig cfg c = + let ohb = buttonHook (startingHooks c) + ohm = motionHook (startingHooks c) + in c + { startingHooks = + (startingHooks c) + { buttonHook = \ev -> onButton (dragModifierMask cfg) ev >> ohb ev, + motionHook = \ev -> onMotion ev >> ohm ev + } + } + +data DragState = DragState + { dragToplevel :: ToplevelHandle, + dragOffsetX :: Double, + dragOffsetY :: Double + } + deriving (Typeable) + +data ResizeState = ResizeState + { resizeToplevel :: ToplevelHandle, + resizeStartX :: Double, + resizeStartY :: Double, + resizeStartW :: Double, + resizeStartH :: Double, + resizeStartCursorX :: Double, + resizeStartCursorY :: Double + } + deriving (Typeable) + +data DragAction + = DragMove DragState + | DragResize ResizeState + deriving (Typeable) + +newtype Dragging = Dragging (Maybe DragAction) + deriving (Typeable) + +instance StateExtension Dragging where + initialValue = Dragging Nothing + marshalExtension _ = Nothing + demarshalExtension _ = Nothing + +leftButton :: Word32 +leftButton = 272 -- BTN_LEFT + +rightButton :: Word32 +rightButton = 273 -- BTN_RIGHT + +onButton :: Word32 -> ButtonEvent -> Montis () +onButton modMask ev + | buttonEvent_button ev /= leftButton && buttonEvent_button ev /= rightButton = return () + | buttonEvent_state ev == ButtonPressed = do + if buttonEvent_modifiers ev .&. modMask == 0 + then return () + else do + CursorPosition (x, y) <- xStateGet + mtl <- toplevelAt x y + case mtl of + Nothing -> xStatePut (Dragging Nothing) + Just tl -> do + (tx, ty, tw, th) <- getToplevelGeometry tl + if buttonEvent_button ev == rightButton + then do + let warpX = tx + tw + warpY = ty + th + warpCursor warpX warpY + xStatePut (CursorPosition (warpX, warpY)) + xStatePut $ + Dragging + ( Just + ( DragResize + (ResizeState tl tx ty tw th warpX warpY) + ) + ) + else + xStatePut $ + Dragging + (Just (DragMove (DragState tl (x - tx) (y - ty)))) + | buttonEvent_state ev == ButtonReleased = + xStatePut (Dragging Nothing) + | otherwise = return () + +onMotion :: MotionEvent -> Montis () +onMotion ev = do + let (x, y) = motionEvent_absolute ev + xStatePut (CursorPosition (x, y)) + Dragging mdrag <- xStateGet + case mdrag of + Nothing -> return () + Just (DragMove (DragState tl dx dy)) -> + setToplevelPosition tl (x - dx) (y - dy) + Just (DragResize rs) -> do + let newW = max 1 (resizeStartW rs + (x - resizeStartCursorX rs)) + newH = max 1 (resizeStartH rs + (y - resizeStartCursorY rs)) + setToplevelGeometry + (resizeToplevel rs) + (resizeStartX rs) + (resizeStartY rs) + newW + newH diff --git a/montis/src/Montis/Standard/Keys.hs b/montis/src/Montis/Standard/Keys.hs new file mode 100644 index 0000000..0b670eb --- /dev/null +++ b/montis/src/Montis/Standard/Keys.hs @@ -0,0 +1,110 @@ +module Montis.Standard.Keys where + +import Control.Monad (when) +import Control.Monad.IO.Class (liftIO) +import Data.Data (Typeable) +import Data.Default.Class (Default (..)) +import Data.Set qualified as Set +import Data.Word (Word32) +import Montis.Base.Foreign.WlRoots (seatKeyboardNotifyKey) +import Montis.Core.Events (KeyEvent (..), KeyState (..)) +import Montis.Core.Monad (Montis, xConfigGet, xStateGet, xStateModify) +import Montis.Core.Runtime (getSeat) +import Montis.Core.State + ( Config (startingHooks), + ConfigModule (..), + Hooks (keyHook), + StateExtension (..), + ) + +-- | Configuration for the keybindings. +data KeysConfig where + KeysConfig :: + { startCont :: KeyEvent -> Montis Bool + } -> + KeysConfig + deriving (Typeable) + +instance Default KeysConfig where + def = KeysConfig $ \_ -> return False + +subkeys :: (KeyEvent -> Montis Bool) -> Montis Bool +subkeys fn = do + xStateModify $ \keyState -> + keyState + { awaiting = Just fn + } + return True + +-- | State of the keys right now. +data KeysState where + KeysState :: + { awaiting :: Maybe (KeyEvent -> Montis Bool), + ignoredKeys :: Set.Set Word32 + } -> + KeysState + +instance StateExtension KeysState where + initialValue = KeysState Nothing Set.empty + marshalExtension = const Nothing + demarshalExtension = const Nothing + +-- | Configurable module for keys. +instance ConfigModule Montis KeysConfig where + alterConfig _ c = + let oh = keyHook (startingHooks c) + in c + { startingHooks = + (startingHooks c) + { keyHook = \ev -> runEv ev >> oh ev + } + } + where + isKeyPress ev = keyEvent_state ev == KeyPressed + isKeyRelease ev = keyEvent_state ev == KeyReleased + shouldIgnoreEvent ev = do + KeysState {ignoredKeys} <- xStateGet + return $ Set.member (keyEvent_keycode ev) ignoredKeys + runEv ev = do + shouldIgnore <- shouldIgnoreEvent ev + if isKeyRelease ev && shouldIgnore + then xStateModify $ \ks -> + ks {ignoredKeys = Set.delete (keyEvent_keycode ev) (ignoredKeys ks)} + else do + handled <- + if isKeyPress ev + then do + handler' <- awaiting <$> xStateGet + handler <- maybe (startCont <$> xConfigGet) return handler' + -- Reset the hadler. + xStateModify $ \st -> + st {awaiting = Nothing} + handler ev + else return False + + if not handled + then forwardKeyToSeat ev + else when (isKeyPress ev) $ + xStateModify $ + \ks -> + ks + { ignoredKeys = + Set.insert (keyEvent_keycode ev) (ignoredKeys ks) + } + +forwardKeyToSeat :: KeyEvent -> Montis () +forwardKeyToSeat ev = do + mseat <- getSeat + case mseat of + Nothing -> return () + Just seat -> + liftIO $ + seatKeyboardNotifyKey + seat + (keyEvent_timeMs ev) + (keyEvent_keycode ev) + (keyStateToWord32 (keyEvent_state ev)) + +keyStateToWord32 :: KeyState -> Word32 +keyStateToWord32 KeyReleased = 0 +keyStateToWord32 KeyPressed = 1 diff --git a/montis/src/Montis/Standard/Mouse.hs b/montis/src/Montis/Standard/Mouse.hs new file mode 100644 index 0000000..933a2f4 --- /dev/null +++ b/montis/src/Montis/Standard/Mouse.hs @@ -0,0 +1,50 @@ +module Montis.Standard.Mouse where + +import Data.Data (Typeable) +import Montis.Core +import Montis.Core.Runtime (focusToplevel, toplevelAt) +import Montis.Core.State + ( Config (startingHooks), + ConfigModule (..), + Hooks (buttonHook, motionHook), + StateExtension (..), + ) + +data MouseConfig where + MouseConfig :: MouseConfig + deriving (Typeable) + +instance ConfigModule Montis MouseConfig where + alterConfig _ c = + let ohb = buttonHook (startingHooks c) + ohm = motionHook (startingHooks c) + in c + { startingHooks = + (startingHooks c) + { buttonHook = \ev -> onButton ev >> ohb ev, + motionHook = \ev -> onMotion ev >> ohm ev + } + } + +newtype CursorPosition = CursorPosition (Double, Double) + deriving (Typeable) + +instance StateExtension CursorPosition where + initialValue = CursorPosition (0, 0) + marshalExtension _ = Nothing + demarshalExtension _ = Nothing + +onMotion :: MotionEvent -> Montis () +onMotion ev = do + let (x, y) = motionEvent_absolute ev + xStatePut (CursorPosition (x, y)) + +onButton :: ButtonEvent -> Montis () +onButton ev + | buttonEvent_state ev /= ButtonPressed = return () + | otherwise = do + CursorPosition (x, y) <- xStateGet + mtl <- toplevelAt x y + case mtl of + Nothing -> return () + Just tl -> focusToplevel tl diff --git a/montis/src/harness_adapter.c b/montis/src/harness_adapter.c new file mode 100644 index 0000000..db5e7ce --- /dev/null +++ b/montis/src/harness_adapter.c @@ -0,0 +1,73 @@ +// This file provides functions for the wetterhorn harness that are not +// expressible directly in haskell. +// +// Currently these functions exclusively enable/disable the Haskell runtime. + +#include "HsFFI.h" +#include "plugin_interface.h" +#include +#include +#include + +const char *plugin_name = "Montis"; + +extern void performMajorGC(); + +void plugin_metaload(int argc, char** argv) +{ + // hs_init(&argc, &argv); +} + +void plugin_load(int argc, char **argv) { + hs_init(&argc, &argv); +} + +void plugin_teardown(opqst_t st) { + hs_exit(); +} + +void shell_exec(const char* cmd) { + if (fork() == 0) { + execl("/bin/sh", "/bin/sh", "-c", cmd, NULL); + exit(1); + } +} + +static const char msg[] = + "Montis Plugin v 0.01\n\n" + "Welcome, and thank you for your interest.\n\n" + "This is merely a plugin to the Montis Compositor and not meant to be\n" + "executed as a standalone binary. This plugin requires a harness to run\n" + "To use this file, please use './wtr_harness [full-path-to-wtr.so]'\n" + "That will allow you to see how this compositor works in all its glory!\n"; +static const int msg_sz = sizeof(msg); + +/* + * Implemens a basic _start that prints inforamtion and exits for users on an + * x86_64 system. + */ +__attribute__((naked)) void _start() +{ + + // Make system call to print the message + asm( + // Load the address of the string into rsi + "mov %0, %%rsi\n" + // Load the string length into edx + "mov %1, %%edx\n" + // Load the file descriptor for stdout into edi + "mov $1, %%edi\n" + // Load the syscall number for sys_write into eax + "mov $1, %%eax\n" + // Make the syscall + "syscall\n" + + // Exit the program. + "mov $0, %%rdi\n" + "mov $60, %%rax\n" + "syscall\n" + : + : "r"(msg), "r"(msg_sz) // Input: address of msg + : "%rsi", "%edx", "%edi" // Clobbered registers + ); +} diff --git a/montis/stack.yaml b/montis/stack.yaml new file mode 100644 index 0000000..0faf47c --- /dev/null +++ b/montis/stack.yaml @@ -0,0 +1,67 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# https://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +resolver: lts-21.21 +# ghc-9.6.4 +# lts-21.21 +# resolver: nightly-2023-09-24 +# resolver: ghc-9.6.2 +# +# The location of a snapshot can be provided as a file or url. Stack assumes +# a snapshot provided as a file might change, whereas a url resource does not. +# +# resolver: ./custom-snapshot.yaml +# resolver: https://example.com/snapshots/2023-01-01.yaml + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# subdirs: +# - auto-update +# - wai +packages: +- . +# Dependency packages to be pulled from upstream that are not in the resolver. +# These entries can reference officially published versions as well as +# forks / in-progress versions pinned to a git hash. For example: +# +# extra-deps: +# - acme-missiles-0.3 +# - git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# +# extra-deps: [] + +# Override default flag values for local packages and extra-deps +# flags: {} + +# Extra package databases containing global packages +# extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of Stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=2.13" +# +# Override the architecture used by Stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by Stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor diff --git a/montis/test/Spec.hs b/montis/test/Spec.hs new file mode 100644 index 0000000..cd4753f --- /dev/null +++ b/montis/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented" diff --git a/plug/README.md b/plug/README.md deleted file mode 100644 index 5592f08..0000000 --- a/plug/README.md +++ /dev/null @@ -1 +0,0 @@ -The Plugin for the Montis Runtime. diff --git a/plug/package.yaml b/plug/package.yaml deleted file mode 100644 index bd42ced..0000000 --- a/plug/package.yaml +++ /dev/null @@ -1,87 +0,0 @@ -name: montis - -github: "jrahm/montis" -license: BSD-3-Clause -author: "Author name here" -maintainer: "example@example.com" -copyright: "2024 Author name here" - -extra-source-files: -- README.md - -# Metadata used when publishing your package -# synopsis: Short description of your package -# category: Web - -# To avoid duplicated efforts in documentation and dealing with the -# complications of embedding Haddock markup inside cabal files, it is -# common to point users to the README.md file. -description: Please see the README on GitHub at - - -dependencies: -- base >= 4.7 && < 5 -- mtl -- bytestring -- containers -- data-default-class -- transformers -- monad-loops -- singletons - - -ghc-options: -- -Wall -- -Wcompat -- -Widentities -- -Wincomplete-record-updates -- -Wincomplete-uni-patterns -- -Wmissing-export-lists -- -Wmissing-home-modules -- -Wpartial-fields -- -Wredundant-constraints -- -XGHC2021 -- -XTypeFamilies -- -XUndecidableInstances -- -XGADTs -- -XFunctionalDependencies -- -XUndecidableSuperClasses -- -XDefaultSignatures -- -XViewPatterns -- -XDerivingVia -- -XDisambiguateRecordFields -- -XLambdaCase -- -XDataKinds -- -fPIC - -executables: - montis.so: - main: Config.hs - source-dirs: src - c-sources: src/harness_adapter.c - ghc-options: - - -shared - - -dynamic - - -no-hs-main - - -lHSrts-1.0.2-ghc9.4.7 - - -O3 - cc-options: - - -g3 - - -O2 - - -shared - - -I../build/ - - -I../rt/include/ - - -I../build/wlroots/include - - -I../build/wlroots-src/include - - -DWLR_USE_UNSTABLE - -tests: - montis-test: - main: Spec.hs - source-dirs: test - ghc-options: - - -threaded - - -rtsopts - - -with-rtsopts=-N - dependencies: - - montis diff --git a/plug/src/Config.hs b/plug/src/Config.hs deleted file mode 100644 index 8ec06dd..0000000 --- a/plug/src/Config.hs +++ /dev/null @@ -1,33 +0,0 @@ -module Config (config) where - -import Control.Monad.IO.Class (liftIO) -import Data.Bits (shiftL, (.&.)) -import Data.Word (Word32) -import Montis.Core -import Montis.Core.Runtime (warpCursor) -import Montis.Standard.Drag (DragConfig (DragConfig)) -import Montis.Standard.Keys (KeysConfig (KeysConfig), subkeys) -import Montis.Standard.Mouse (MouseConfig (MouseConfig)) - -keys :: KeyEvent -> Montis Bool -keys ev - | keyEvent_modifiers ev .&. mod1Mask == 0 = return False - | otherwise = case keyEvent_codepoint ev of - 'j' -> do - liftIO (putStrLn "j was pressed!") - subkeys $ \ev -> case keyEvent_codepoint ev of - 'k' -> do - liftIO (putStrLn "k was pressed after j!") - warpCursor 0 0 - return True - _ -> return False - _ -> return False - -mod1Mask :: Word32 -mod1Mask = 1 `shiftL` 3 -- WLR_MODIFIER_ALT - -config :: MontisConfig -config = - install MouseConfig $ - install (DragConfig mod1Mask) $ - install (KeysConfig keys) defaultConfig diff --git a/plug/src/Link.hs b/plug/src/Link.hs deleted file mode 100644 index 4ac3f5c..0000000 --- a/plug/src/Link.hs +++ /dev/null @@ -1,18 +0,0 @@ --- | Module that provides the start hooks using the config required to link the --- plugin's shared library. -module Link () where - -import Config (config) -import Montis.Core - -foreign export ccall "plugin_cold_start" - coldStart :: MontisColdStart - -foreign export ccall "plugin_hot_start" - hotStart :: MontisHotStart - -coldStart :: MontisColdStart -coldStart = coldStartMontis config - -hotStart :: MontisHotStart -hotStart = hotStartMontis config diff --git a/plug/src/Montis/Base/Foreign/Runtime.hs b/plug/src/Montis/Base/Foreign/Runtime.hs deleted file mode 100644 index 427545a..0000000 --- a/plug/src/Montis/Base/Foreign/Runtime.hs +++ /dev/null @@ -1,37 +0,0 @@ -module Montis.Base.Foreign.Runtime where - -import Data.Void -import Foreign.C (CInt (..), CString, CDouble (..)) -import Foreign.Ptr - -data ForeignMontisToplevel - -foreign import ccall "montis_do_request_hot_reload" foreign_doRequestHotReload :: Ptr Void -> IO () - -foreign import ccall "montis_do_request_log" foreign_doRequestLog :: Ptr Void -> CString -> IO () - -foreign import ccall "montis_do_request_exit" foreign_doRequestExit :: Ptr Void -> CInt -> IO () - -foreign import ccall "montis_plugin_get_seat" foreign_getSeat :: Ptr Void -> IO (Ptr Void) - -foreign import ccall "montis_plugin_toplevel_at" - foreign_toplevelAt :: Ptr Void -> CDouble -> CDouble -> IO (Ptr ForeignMontisToplevel) - -foreign import ccall "montis_plugin_get_toplevel_position" - foreign_getToplevelPosition :: Ptr ForeignMontisToplevel -> Ptr CDouble -> Ptr CDouble -> IO () - -foreign import ccall "montis_plugin_set_toplevel_position" - foreign_setToplevelPosition :: Ptr ForeignMontisToplevel -> CDouble -> CDouble -> IO () - -foreign import ccall "montis_plugin_get_toplevel_geometry" - foreign_getToplevelGeometry :: - Ptr ForeignMontisToplevel -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> IO () - -foreign import ccall "montis_plugin_set_toplevel_geometry" - foreign_setToplevelGeometry :: Ptr ForeignMontisToplevel -> CDouble -> CDouble -> CDouble -> CDouble -> IO () - -foreign import ccall "montis_plugin_focus_toplevel" - foreign_focusToplevel :: Ptr ForeignMontisToplevel -> IO () - -foreign import ccall "montis_plugin_warp_cursor" - foreign_warpCursor :: Ptr Void -> CDouble -> CDouble -> IO () diff --git a/plug/src/Montis/Base/Foreign/WlRoots.hs b/plug/src/Montis/Base/Foreign/WlRoots.hs deleted file mode 100644 index 272567f..0000000 --- a/plug/src/Montis/Base/Foreign/WlRoots.hs +++ /dev/null @@ -1,44 +0,0 @@ --- | Contains functions and thin wrappers via ffi to the wlroots API. -module Montis.Base.Foreign.WlRoots where - -import Foreign (Ptr, Word32, nullPtr) -import Montis.Base.Foreign.WlRoots.Types - --- | Converts a null pointer into 'Nothing' to avoid dangling FFI handles. -guardNull :: Ptr a -> Maybe (Ptr a) -guardNull p | p == nullPtr = Nothing -guardNull p = Just p - -foreign import ccall "wlr_seat_set_keyboard" - foreign_wlrSetSeatKeyboard :: - Ptr ForeignWlrSeat -> Ptr ForeignWlrInputDevice -> IO () - --- | Binds the given input device as the active keyboard for a seat. -setSeatKeyboard :: WlrSeat -> WlrInputDevice -> IO () -setSeatKeyboard (WlrSeat p1) (WlrInputDevice p2) = - foreign_wlrSetSeatKeyboard p1 p2 - -foreign import ccall "wlr_seat_get_keyboard" - foreign_wlrSeatGetKeyboard :: - Ptr ForeignWlrSeat -> IO (Ptr ForeignWlrKeyboard) - --- | Looks up the current keyboard for a seat, if one exists. -getSeatKeyboard :: WlrSeat -> IO (Maybe WlrKeyboard) -getSeatKeyboard (WlrSeat p) = - fmap WlrKeyboard . guardNull <$> foreign_wlrSeatGetKeyboard p - -foreign import ccall "wlr_keyboard_get_modifiers" - foreign_wlrKeyboardGetModifiers :: - Ptr ForeignWlrKeyboard -> IO Word32 - --- | Returns the current keyboard modifier mask for the keyboard. -getKeyboardModifiers :: WlrKeyboard -> IO Word32 -getKeyboardModifiers (WlrKeyboard p) = foreign_wlrKeyboardGetModifiers p - -foreign import ccall "wlr_seat_keyboard_notify_key" - foreign_wlrSeatKeyboardNotifyKey :: - Ptr ForeignWlrSeat -> Word32 -> Word32 -> Word32 -> IO () - --- | Forwards a key event to the seat with time, keycode, and state. -seatKeyboardNotifyKey :: WlrSeat -> Word32 -> Word32 -> Word32 -> IO () -seatKeyboardNotifyKey (WlrSeat p) = foreign_wlrSeatKeyboardNotifyKey p diff --git a/plug/src/Montis/Base/Foreign/WlRoots/Types.hs b/plug/src/Montis/Base/Foreign/WlRoots/Types.hs deleted file mode 100644 index c109653..0000000 --- a/plug/src/Montis/Base/Foreign/WlRoots/Types.hs +++ /dev/null @@ -1,99 +0,0 @@ -module Montis.Base.Foreign.WlRoots.Types where - -import Foreign (IntPtr, Ptr, intPtrToPtr, ptrToIntPtr) -import Text.Read - --- | Opaque foreign type for a wlroots keyboard. -data ForeignWlrKeyboard - -newtype WlrKeyboard where - WlrKeyboard :: Ptr ForeignWlrKeyboard -> WlrKeyboard - deriving (Show, Ord, Eq) - --- | Opaque foreign type for a wlroots pointer. -data ForeignWlrPointer - -newtype WlrPointer where - WlrPointer :: Ptr ForeignWlrPointer -> WlrPointer - deriving (Show, Ord, Eq) - --- | Opaque foreign type for wlroots pointer button events. -data ForeignWlrPointerButtonEvent - -newtype WlrPointerButtonEvent where - WlrPointerButtonEvent :: Ptr ForeignWlrPointerButtonEvent -> WlrPointerButtonEvent - deriving (Show, Ord, Eq) - --- | Opaque foreign type for wlroots pointer motion events. -data ForeignWlrPointerMotionEvent - -newtype WlrPointerMotionEvent where - WlrPointerMotionEvent :: Ptr ForeignWlrPointerMotionEvent -> WlrPointerMotionEvent - deriving (Show, Ord, Eq) - --- | Opaque foreign type for wlroots absolute pointer motion events. -data ForeignWlrPointerMotionAbsoluteEvent - -newtype WlrPointerMotionAbsoluteEvent where - WlrPointerMotionAbsoluteEvent :: Ptr ForeignWlrPointerMotionAbsoluteEvent -> WlrPointerMotionAbsoluteEvent - deriving (Show, Ord, Eq) - --- | Opaque foreign type for a wlroots seat. -data ForeignWlrSeat - -newtype WlrSeat where - WlrSeat :: Ptr ForeignWlrSeat -> WlrSeat - deriving (Show, Ord, Eq) - --- | Opaque foreign type for a wlroots input device. -data ForeignWlrInputDevice - -newtype WlrInputDevice where - WlrInputDevice :: Ptr ForeignWlrInputDevice -> WlrInputDevice - deriving (Show, Ord, Eq) - --- | Opaque foreign type for wlroots keyboard key events. -data ForeignWlrEventKeyboardKey - -newtype WlrEventKeyboardKey where - WlrEventKeyboardKey :: Ptr ForeignWlrEventKeyboardKey -> WlrEventKeyboardKey - deriving (Show, Ord, Eq) - --- | Opaque foreign type for xdg-shell surfaces. -data ForeignWlrXdgSurface - --- | Opaque foreign type for XWayland surfaces. -data ForeignWlrXWaylandSurface - --- | Tagged wrapper over surface pointer variants. -data Surface where - XdgSurface :: Ptr ForeignWlrXdgSurface -> Surface - XWaylandSurface :: Ptr ForeignWlrXWaylandSurface -> Surface - deriving (Ord, Eq) - -instance Show Surface where - show (XdgSurface p) = show (XdgSerializeSurface (ptrToIntPtr p)) - show (XWaylandSurface p) = show (XWaylandSerializeSurface (ptrToIntPtr p)) - -instance Read Surface where - readPrec = fmap toSurf readPrec - where - -- Rebuild constructors from serialized pointers. - toSurf (XdgSerializeSurface ip) = XdgSurface (intPtrToPtr ip) - toSurf (XWaylandSerializeSurface ip) = XWaylandSurface (intPtrToPtr ip) - --- | Serializable version of 'Surface' to enable Read/Show. -data SerializableSurface - = XdgSerializeSurface IntPtr - | XWaylandSerializeSurface IntPtr - deriving (Read, Show) - -class ForeignSurface a where - -- | Converts a foreign surface pointer into the tagged wrapper. - toSurface :: Ptr a -> Surface - -instance ForeignSurface ForeignWlrXdgSurface where - toSurface = XdgSurface - -instance ForeignSurface ForeignWlrXWaylandSurface where - toSurface = XWaylandSurface diff --git a/plug/src/Montis/Core.hs b/plug/src/Montis/Core.hs deleted file mode 100644 index 5399f1e..0000000 --- a/plug/src/Montis/Core.hs +++ /dev/null @@ -1,10 +0,0 @@ -module Montis.Core - ( module X, - ) -where - -import Montis.Core.Events as X -import Montis.Core.Monad as X -import Montis.Core.Runtime as X -import Montis.Core.Start as X -import Montis.Core.State as X diff --git a/plug/src/Montis/Core/Events.hs b/plug/src/Montis/Core/Events.hs deleted file mode 100644 index 91b8618..0000000 --- a/plug/src/Montis/Core/Events.hs +++ /dev/null @@ -1,46 +0,0 @@ -module Montis.Core.Events where - -import Data.Word (Word32) -import Montis.Base.Foreign.WlRoots.Types - -data KeyState = KeyPressed | KeyReleased deriving (Show, Read, Eq, Enum, Ord) - -data KeyEvent = KeyEvent - { keyEvent_timeMs :: Word32, - keyEvent_keycode :: Word32, - keyEvent_state :: KeyState, - keyEvent_modifiers :: Word32, - keyEvent_keysym :: Word32, - keyEvent_codepoint :: Char, - keyEvent_device :: WlrInputDevice - } - deriving (Show, Ord, Eq) - -data ButtonState = ButtonReleased | ButtonPressed deriving (Show, Read, Eq, Enum, Ord) - -data ButtonEvent = ButtonEvent - { buttonEvent_pointer :: WlrPointer, - buttonEvent_timeMs :: Word32, - buttonEvent_button :: Word32, - buttonEvent_modifiers :: Word32, - buttonEvent_state :: ButtonState - } - deriving (Eq, Show, Ord) - -data MotionEvent = MotionEvent - { motionEvent_pointer :: WlrPointer, - motionEvent_timeMs :: Word32, - motionEvent_modifiers :: Word32, - motionEvent_absolute :: (Double, Double), - motionEvent_raw :: (Double, Double) - } - deriving (Eq, Show, Ord) - -data SurfaceState = Map | Unmap | Destroy - deriving (Eq, Ord, Show, Read, Enum) - -data SurfaceEvent = SurfaceEvent - { surfaceEvent_state :: SurfaceState, - surfaceEvent_surface :: Surface - } - deriving (Eq, Ord, Show) diff --git a/plug/src/Montis/Core/Extensions.hs b/plug/src/Montis/Core/Extensions.hs deleted file mode 100644 index 0e8384f..0000000 --- a/plug/src/Montis/Core/Extensions.hs +++ /dev/null @@ -1,30 +0,0 @@ -module Montis.Core.Extensions where - -import Data.Data - ( Typeable, - tyConModule, - tyConName, - tyConPackage, - ) -import Data.Kind (Constraint, Type) -import Text.Printf (printf) -import Type.Reflection (someTypeRep, someTypeRepTyCon) - --- | A key to key into the Extension maps. -data ExtensionKey where - ExtensionKey :: {extensionKeyValue :: String} -> ExtensionKey - deriving (Eq, Ord, Show) - -data Extension (c :: Type -> Constraint) where - Extension :: (Typeable a, c a) => a -> Extension c - -class Nil a -instance Nil a - --- | Produces a string representation of a type used to key into the extensible --- state map. -typeRepr :: forall proxy a. (Typeable a) => proxy a -> ExtensionKey -typeRepr proxy = ExtensionKey $ tyconToStr $ someTypeRepTyCon (someTypeRep proxy) - where - tyconToStr tc = - printf "%s.%s.%s" (tyConPackage tc) (tyConModule tc) (tyConName tc) diff --git a/plug/src/Montis/Core/Internal/Foreign/Export.hs b/plug/src/Montis/Core/Internal/Foreign/Export.hs deleted file mode 100644 index faa1964..0000000 --- a/plug/src/Montis/Core/Internal/Foreign/Export.hs +++ /dev/null @@ -1,226 +0,0 @@ --- | This module has no public functions, but provides the surface interface --- between the Montis runtime and the plugin. -module Montis.Core.Internal.Foreign.Export () where - -import Control.Monad (forM_) -import Control.Monad.State (MonadIO (liftIO), gets) -import Data.ByteString qualified as BS -import Data.ByteString.Char8 qualified as CH -import Data.Singletons.Decide (Void) -import Foreign - ( Ptr, - Storable (poke, pokeByteOff), - Word32, - Word8, - deRefStablePtr, - freeStablePtr, - mallocBytes, - newStablePtr, - ) -import Foreign.C (CChar, CDouble (..), CInt (..)) -import Foreign.Ptr (castPtr) -import Montis.Base.Foreign.WlRoots.Types - ( ForeignSurface (toSurface), - ForeignWlrInputDevice, - ForeignWlrPointer, - ForeignWlrXWaylandSurface, - ForeignWlrXdgSurface, - WlrEventKeyboardKey, - WlrInputDevice (WlrInputDevice), - WlrPointer (WlrPointer), - WlrPointerButtonEvent, - ) -import Montis.Core -import Montis.Core.State -import Montis.Core.State.Marshal (marshalState) -import Montis.Foreign.Marshal (Demarshal (Demarshal), demarshal, runDemarshal) - --- | Helpers to unpack the opaque state, run a Montis action, and re-wrap it. --- Each call consumes the old stable pointer and returns a fresh one. -runForeign :: - Montis () -> - OpqStT -> - IO OpqStT -runForeign fn stableptr = do - (ctx, st) <- deRefStablePtr stableptr - freeStablePtr stableptr - (_, state') <- runMontis ctx st fn - newStablePtr (ctx, state') - -runForeignWithReturn :: - (Storable a) => - Montis a -> - Ptr a -> - OpqStT -> - IO OpqStT -runForeignWithReturn fn outptr stableptr = do - (ctx, st) <- deRefStablePtr stableptr - freeStablePtr stableptr - (val, state') <- runMontis ctx st fn - poke outptr val - newStablePtr (ctx, state') - --- ---------------------------------------------------------------------- --- State marshal/export - --- | Marshals the opaque state to a C-style byte array and size pointer. -foreign export ccall "plugin_marshal_state" - pluginMarshalState :: OpqStT -> Ptr Word32 -> IO (Ptr Word8) - -pluginMarshalState :: OpqStT -> Ptr Word32 -> IO (Ptr Word8) -pluginMarshalState opqStT outlen = do - (_, st) <- deRefStablePtr opqStT - let bs = CH.pack (marshalState st) - ret <- mallocBytes (BS.length bs) - poke outlen (fromIntegral $ BS.length bs) - forM_ (zip [0 ..] (BS.unpack bs)) $ \(off, w8) -> do - pokeByteOff ret off w8 - return ret - --- ---------------------------------------------------------------------- --- Input handlers - -foreign export ccall "plugin_handle_button" - pluginHandleButton :: Ptr WlrPointerButtonEvent -> Word32 -> OpqStT -> IO OpqStT - -pluginHandleButton :: Ptr WlrPointerButtonEvent -> Word32 -> OpqStT -> IO OpqStT -pluginHandleButton eventPtr modifiers = - runForeign $ do - s <- gets currentHooks - event <- liftIO $ - runDemarshal eventPtr $ do - -- Follows struct wlr_pointer_button_event field order. - pointerPtr <- demarshal :: Demarshal (Ptr ForeignWlrPointer) - tMs <- demarshal - button <- demarshal - state <- demarshal :: Demarshal Word8 - return $ - ButtonEvent - (WlrPointer pointerPtr) - tMs - button - modifiers - (if state == (0 :: Word8) then ButtonReleased else ButtonPressed) - - buttonHook s event - --- ---------------------------------------------------------------------- --- Keybinding handler - -foreign export ccall "plugin_handle_keybinding" - pluginHandleKeybinding :: - Ptr ForeignWlrInputDevice -> - Ptr WlrEventKeyboardKey -> - Word32 -> - Word32 -> - Word32 -> - Ptr CInt -> - OpqStT -> - IO OpqStT - -pluginHandleKeybinding :: - Ptr ForeignWlrInputDevice -> - Ptr WlrEventKeyboardKey -> - Word32 -> - Word32 -> - Word32 -> - Ptr CInt -> - OpqStT -> - IO OpqStT -pluginHandleKeybinding inputDevicePtr eventPtr mods sym cp = - runForeignWithReturn $ do - s <- gets currentHooks - event <- liftIO $ - runDemarshal eventPtr $ do - -- Matches struct wlr_keyboard_key_event in wlroots. - tMs <- demarshal - kc <- demarshal - _ <- (demarshal :: Demarshal Word32) - keyState <- demarshal - return $ - KeyEvent - tMs - kc - (if keyState == (0 :: Word8) then KeyReleased else KeyPressed) - mods - sym - (toEnum $ fromIntegral cp) - (WlrInputDevice inputDevicePtr) - - keyHook s event - return 1 - --- ---------------------------------------------------------------------- --- Motion handler - -foreign export ccall "plugin_handle_motion" - pluginHandleMotion :: Ptr Void -> Word32 -> Word32 -> CDouble -> CDouble -> OpqStT -> IO OpqStT - -pluginHandleMotion :: Ptr Void -> Word32 -> Word32 -> CDouble -> CDouble -> OpqStT -> IO OpqStT -pluginHandleMotion eventPtr modifiers isAbsolute lx ly = - runForeign $ do - s <- gets currentHooks - event <- liftIO $ - if isAbsolute == 0 - then - runDemarshal (castPtr eventPtr) $ do - pointerPtr <- demarshal :: Demarshal (Ptr ForeignWlrPointer) - tMs <- demarshal - _ <- demarshal :: Demarshal Word32 - _ <- demarshal :: Demarshal Double - _ <- demarshal :: Demarshal Double - _ <- demarshal :: Demarshal Double - _ <- demarshal :: Demarshal Double - return $ - MotionEvent - (WlrPointer pointerPtr) - tMs - modifiers - (realToFrac lx, realToFrac ly) - (0, 0) - else - runDemarshal (castPtr eventPtr) $ do - -- After time_msec, wlroots pads to 8-byte alignment for doubles. - pointerPtr <- demarshal :: Demarshal (Ptr ForeignWlrPointer) - tMs <- demarshal - _ <- demarshal :: Demarshal Word32 - rawX <- demarshal - rawY <- demarshal - return $ - MotionEvent - (WlrPointer pointerPtr) - tMs - modifiers - (realToFrac lx, realToFrac ly) - (rawX, rawY) - - motionHook s event - --- ---------------------------------------------------------------------- --- Surface handlers - --- | Function exported to the harness to handle the mapping/unmapping/deletion --- of an XDG surface. -foreign export ccall "plugin_handle_surface" - pluginHandleSurface :: - Ptr ForeignWlrXdgSurface -> CInt -> OpqStT -> IO OpqStT - -pluginHandleSurface :: - Ptr ForeignWlrXdgSurface -> CInt -> OpqStT -> IO OpqStT -pluginHandleSurface p t = - runForeign $ do - s <- gets currentHooks - surfaceHook s (SurfaceEvent (toEnum $ fromIntegral t) (toSurface p)) - --- | Function exported to the harness to handle the mapping/unmapping/deletion --- of an XWayland surface. -foreign export ccall "plugin_handle_xwayland_surface" - pluginHandleXWaylandSurface :: - Ptr ForeignWlrXWaylandSurface -> CInt -> OpqStT -> IO OpqStT - -pluginHandleXWaylandSurface :: - Ptr ForeignWlrXWaylandSurface -> CInt -> OpqStT -> IO OpqStT -pluginHandleXWaylandSurface p t = - runForeign $ do - s <- gets currentHooks - surfaceHook s (SurfaceEvent (toEnum $ fromIntegral t) (toSurface p)) diff --git a/plug/src/Montis/Core/Monad.hs b/plug/src/Montis/Core/Monad.hs deleted file mode 100644 index b7d1633..0000000 --- a/plug/src/Montis/Core/Monad.hs +++ /dev/null @@ -1,125 +0,0 @@ -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module Montis.Core.Monad where - -import Control.Monad.Identity (Identity (Identity)) -import Control.Monad.Reader -import Control.Monad.State (MonadState, StateT (runStateT), gets, modify') -import Data.Default.Class (Default (def)) -import Data.Map qualified as Map -import Data.Maybe (fromMaybe) -import Data.Typeable -import Foreign (StablePtr) -import Montis.Core.Extensions (Extension (Extension), typeRepr) -import Montis.Core.State - --- | A Config type for the Montis monad. -type MontisConfig = Config Montis - --- | A Context type specific for the Montis monad. -type MontisContext = Context Montis - --- | A State type for the Montis monad. -type MontisState = State Montis - --- | The Opaque State Type passed between the plugin and the runtime. The --- OpqStT *is* the opq_st_t from the runtime code. -type OpqStT = StablePtr (MontisContext, MontisState) - --- | The Montis monad is a Reader over an immutable context plus a State over --- mutable runtime state, all ultimately running in IO for host effects. -newtype Montis a where - Montis :: (ReaderT MontisContext (StateT MontisState IO) a) -> Montis a - deriving (Functor, Applicative, Monad, MonadState MontisState, MonadIO) - --- | Reader access is scoped to the config portion of the full context; this --- keeps plugin code from mutating the context while still allowing read-only --- access to configuration. -instance MonadReader MontisConfig Montis where - ask :: Montis MontisConfig - ask = Montis $ asks ctxConfig - - reader :: (MontisConfig -> a) -> Montis a - reader fn = Montis $ asks (fn . ctxConfig) - - local :: (MontisConfig -> MontisConfig) -> Montis a -> Montis a - local cfn (Montis fn) = - Montis $ local (\ctx -> ctx {ctxConfig = cfn (ctxConfig ctx)}) fn - --- | Access the plugin self pointer stored in the context. -getSelfPtr :: Montis SelfPtr -getSelfPtr = Montis $ asks ctxSelfPtr - --- | Run a Montis action with a fixed context and initial state, returning the --- result value and the updated state. -runMontis :: MontisContext -> MontisState -> Montis a -> IO (a, MontisState) -runMontis ctx initState (Montis m) = runStateT (runReaderT m ctx) initState - --- | The standard default config. -defaultConfig :: MontisConfig -defaultConfig = - Config - { startingHooks = - Hooks - { keyHook = const (return ()), - surfaceHook = const (return ()), - buttonHook = const (return ()), - motionHook = const (return ()) - }, - -- Default hooks are no-ops except for basic printing, which makes the - -- system usable without extra wiring during development. - startupHook = return (), - resetHook = return (), - -- Extensions start empty; callers can register config extensions as needed. - configExtensions = mempty - } - --- | Store a typed extension in the extensible state map under its TypeRep. --- The value is wrapped so the map remains heterogeneously typed. -xStatePut :: forall a. (StateExtension a) => a -> Montis () -xStatePut xst = do - modify' - ( \st -> - st - { extensibleState = - Map.insert - (typeRepr (Identity xst)) - (Right (Extension xst)) - (extensibleState st) - } - ) - --- | Retrieve a typed extension, demarshalling it if needed and caching it back. --- When the extension is stored in marshalled form, it is decoded and then --- reinserted so future lookups are fast. -xStateGet :: forall a. (StateExtension a) => Montis a -xStateGet = do - mp <- gets extensibleState - case lookupByType (Proxy :: Proxy a) mp of - Nothing -> return initialValue - Just (Right (Extension v)) -> return $ fromMaybe initialValue (cast v) - Just (Left s) -> do - let x = (demarshalExtension s :: Maybe a) - in forM_ x xStatePut >> return (fromMaybe initialValue x) - --- | Modifies the typed extension bi the given function. -xStateModify :: forall a. (StateExtension a) => (a -> a) -> Montis () -xStateModify fn = do - s <- xStateGet - (xStatePut . fn) s - -xStateModifyM :: forall a. (StateExtension a) => (a -> Montis a) -> Montis () -xStateModifyM fn = do - s <- xStateGet - xStatePut =<< fn s - --- | Retrieve a typed configuration extension or return the default --- instance if the extension had not been configured. -xConfigGet :: forall a. (Typeable a, Default a) => Montis a -xConfigGet = do - exts <- asks configExtensions - return $ - fromMaybe def $ - Map.lookup (typeRepr (Proxy :: Proxy a)) exts - >>= (\(Extension a) -> cast a) diff --git a/plug/src/Montis/Core/Plugin/Interface.hs b/plug/src/Montis/Core/Plugin/Interface.hs deleted file mode 100644 index 73c0371..0000000 --- a/plug/src/Montis/Core/Plugin/Interface.hs +++ /dev/null @@ -1,20 +0,0 @@ --- | Provides the plugin interface through foreign exports. -module Montis.Core.Plugin.Interface where - -import Data.ByteString (ByteString) -import Data.Data (Typeable) -import Data.Singletons.Decide (Void) -import Foreign (Ptr, StablePtr, Word32) -import Foreign.C (CChar) -import Montis.Core.State (SelfPtr) - --- type OpqStT l w = StablePtr (Context l w, State l w) - -class OpaqueState s where - hotStart :: SelfPtr -> ByteString -> IO s - - coldStart :: SelfPtr -> IO s - - marshalState :: s -> ByteString - - teardown :: s -> IO () diff --git a/plug/src/Montis/Core/Runtime.hs b/plug/src/Montis/Core/Runtime.hs deleted file mode 100644 index 0d4c905..0000000 --- a/plug/src/Montis/Core/Runtime.hs +++ /dev/null @@ -1,82 +0,0 @@ -module Montis.Core.Runtime - ( ToplevelHandle, - focusToplevel, - getSeat, - getToplevelGeometry, - setToplevelGeometry, - setToplevelPosition, - toplevelAt, - warpCursor, - ) -where - -import Control.Monad.IO.Class (liftIO) -import Data.Void (Void) -import Foreign (Ptr) -import Foreign.C (CDouble (..)) -import Foreign.Marshal.Alloc (alloca) -import Foreign.Ptr (castPtr, nullPtr) -import Foreign.Storable (peek) -import Montis.Base.Foreign.Runtime -import Montis.Base.Foreign.WlRoots.Types (ForeignWlrSeat, WlrSeat (WlrSeat)) -import Montis.Core.Monad (Montis, getSelfPtr) -import Montis.Core.State (SelfPtr (..)) - -type ToplevelHandle = Ptr ForeignMontisToplevel - -unwrapSelf :: SelfPtr -> Ptr Void -unwrapSelf (SelfPtr p) = p - -getSeat :: Montis (Maybe WlrSeat) -getSeat = do - self <- getSelfPtr - seatPtr <- liftIO $ foreign_getSeat (unwrapSelf self) - if seatPtr == nullPtr - then return Nothing - else return $ Just (WlrSeat (castPtr seatPtr :: Ptr ForeignWlrSeat)) - -toplevelAt :: Double -> Double -> Montis (Maybe ToplevelHandle) -toplevelAt lx ly = do - self <- getSelfPtr - tl <- liftIO $ foreign_toplevelAt (unwrapSelf self) (realToFrac lx) (realToFrac ly) - if tl == nullPtr - then return Nothing - else return (Just tl) - -getToplevelGeometry :: ToplevelHandle -> Montis (Double, Double, Double, Double) -getToplevelGeometry tl = - liftIO $ - alloca $ \xPtr -> alloca $ \yPtr -> alloca $ \wPtr -> alloca $ \hPtr -> do - foreign_getToplevelGeometry tl xPtr yPtr wPtr hPtr - x <- peek xPtr - y <- peek yPtr - w <- peek wPtr - h <- peek hPtr - return - ( realToFrac (x :: CDouble), - realToFrac (y :: CDouble), - realToFrac (w :: CDouble), - realToFrac (h :: CDouble) - ) - -setToplevelGeometry :: ToplevelHandle -> Double -> Double -> Double -> Double -> Montis () -setToplevelGeometry tl x y w h = - liftIO $ - foreign_setToplevelGeometry - tl - (realToFrac x) - (realToFrac y) - (realToFrac w) - (realToFrac h) - -setToplevelPosition :: ToplevelHandle -> Double -> Double -> Montis () -setToplevelPosition tl x y = - liftIO $ foreign_setToplevelPosition tl (realToFrac x) (realToFrac y) - -focusToplevel :: ToplevelHandle -> Montis () -focusToplevel tl = liftIO $ foreign_focusToplevel tl - -warpCursor :: Double -> Double -> Montis () -warpCursor lx ly = do - self <- getSelfPtr - liftIO $ foreign_warpCursor (unwrapSelf self) (realToFrac lx) (realToFrac ly) diff --git a/plug/src/Montis/Core/Start.hs b/plug/src/Montis/Core/Start.hs deleted file mode 100644 index 54ec8c5..0000000 --- a/plug/src/Montis/Core/Start.hs +++ /dev/null @@ -1,38 +0,0 @@ -module Montis.Core.Start where - -import Data.ByteString qualified as BS -import Data.ByteString.Char8 qualified as CH -import Data.Void -import Foreign (Word32, newStablePtr) -import Foreign.C (CChar) -import Foreign.Ptr -import Montis.Core.Monad -import Montis.Core.State -import Montis.Core.State.Marshal (demarshalState) - -type MontisColdStart = Ptr Void -> IO OpqStT - -type MontisHotStart = Ptr Void -> Ptr CChar -> Word32 -> IO OpqStT - -hotStartMontis :: MontisConfig -> MontisHotStart -hotStartMontis config self chars len = do - bs <- BS.packCStringLen (chars, fromIntegral len) - - let ctx = Context config (SelfPtr self) - st = demarshalState config (CH.unpack bs) - - ((), st') <- runMontis ctx st (resetHook config) - newStablePtr (ctx, st') - --- Used to start montis given the provided config. -coldStartMontis :: MontisConfig -> MontisColdStart -coldStartMontis conf selfPtr = - let ctx = Context conf (SelfPtr selfPtr) - st = - State - { currentHooks = startingHooks conf, - extensibleState = mempty - } - in do - ((), st') <- runMontis ctx st (startupHook conf) - newStablePtr (ctx, st') diff --git a/plug/src/Montis/Core/State.hs b/plug/src/Montis/Core/State.hs deleted file mode 100644 index ce8f903..0000000 --- a/plug/src/Montis/Core/State.hs +++ /dev/null @@ -1,116 +0,0 @@ --- | Definitions of montis core state. -module Montis.Core.State where - -import Data.Data (Proxy (Proxy), Typeable) -import Data.Default.Class (Default, def) -import Data.Map qualified as M -import Data.Void (Void) -import Foreign (Ptr) -import Montis.Core.Events -import Montis.Core.Extensions -import Text.Read (readMaybe) - --- | An opaque type used for the plugin's self-reference. -newtype SelfPtr where - SelfPtr :: Ptr Void -> SelfPtr - --- | This is the context the plugin operates under. The context contains data --- which must be provided by the runtime or the configuration. This data may not --- be cold-created. --- --- Parameters: --- `m` the monad for this Context. This is typically W. -data Context m where - Context :: - { ctxConfig :: Config m, - ctxSelfPtr :: SelfPtr - } -> - Context m - --- | Montis configuration. This is the structure that defines the user-written --- configuration, which is linked in. -data Config m where - Config :: - { startingHooks :: Hooks m, - startupHook :: m (), - resetHook :: m (), - configExtensions :: M.Map ExtensionKey (Extension Nil) - } -> - Config m - --- | Hooks the runtime can call. -data Hooks m where - Hooks :: - { keyHook :: KeyEvent -> m (), - surfaceHook :: SurfaceEvent -> m (), - buttonHook :: ButtonEvent -> m (), - motionHook :: MotionEvent -> m () - } -> - Hooks m - --- | Class for a configurable model. -class (Typeable a) => ConfigModule m a where - alterConfig :: a -> Config m -> Config m - --- | Configures a typed configuration extension. -install :: forall a m. (ConfigModule m a) => a -> Config m -> Config m -install a c = - alterConfig a $ - c - { configExtensions = - M.insert - (typeRepr (Proxy :: Proxy a)) - (Extension a) - (configExtensions c) - } - --- | Typeclass defining the set of types which can be used as state extensions --- to the W monad. These state extensions may be persistent or not. --- --- There are default implementations for all methods if the type implements --- Read, Show and Default, -class (Typeable a) => StateExtension a where - -- | The initial value used for the first time an extension is 'gotten' or - -- demarshalling fails. - initialValue :: a - - -- | Transforms a type into a string. If the type cannot be marshalled, this - -- function should return Nothing. - -- - -- If a type cannot be marshalled, it cannot persist across hot reloads. - marshalExtension :: a -> Maybe String - - -- | Reads an extension from a string. If this type is not marshallable or - -- reading fails, this function should return Nothing. - demarshalExtension :: String -> Maybe a - - -- | If the type implements Default, use the default implementation. - default initialValue :: (Default a) => a - initialValue = def - - -- | If the type implements Show, use show for the marshalling. - default marshalExtension :: (Show a) => a -> Maybe String - marshalExtension = Just . show - - -- | If the type implements Read, use read for the demarshalling. - default demarshalExtension :: (Read a) => String -> Maybe a - demarshalExtension = readMaybe - --- | State type. This type contains changeable data. -data State m where - State :: - { -- The datastructure containing the state of the windows. - - -- | Current set of hooks. The initial hooks are provided by the - -- configuration, but the hooks can change during operation. This is how - -- key sequences can be mapped. - currentHooks :: Hooks m, - -- | Map from the typerep string to the state extension. - extensibleState :: - M.Map ExtensionKey (Either String (Extension StateExtension)) - } -> - State m - --- | Lookup from an extension map by type. -lookupByType :: (Typeable a) => proxy a -> M.Map ExtensionKey b -> Maybe b -lookupByType pxy = M.lookup (typeRepr pxy) diff --git a/plug/src/Montis/Core/State/Marshal.hs b/plug/src/Montis/Core/State/Marshal.hs deleted file mode 100644 index 04a2a57..0000000 --- a/plug/src/Montis/Core/State/Marshal.hs +++ /dev/null @@ -1,44 +0,0 @@ -module Montis.Core.State.Marshal (marshalState, demarshalState) where - -import Data.Map qualified as M -import Data.Maybe (mapMaybe) -import Montis.Core.Extensions -import Montis.Core.State - -data MarshalledState where - MarshalledState :: - [(String, String)] -> - MarshalledState - deriving (Show, Read) - --- | Marshals the serializable parts of the state to a string. This happens --- during a hot-reload where some state must be saved to persist across hot --- reloads. --- Only the extensible state is persisted; hooks and other runtime data are --- reconstructed from the config on restart. -marshalState :: State m -> String -marshalState - ( State - { extensibleState = xs - } - ) = - show $ - MarshalledState - (mapMaybe (\(k, v) -> (extensionKeyValue k,) <$> doMarshalEx v) (M.toList xs)) - where - -- Left values are already marshalled; Right values are re-encoded here. - doMarshalEx :: Either String (Extension StateExtension) -> Maybe String - doMarshalEx (Left s) = Just s - doMarshalEx (Right (Extension a)) = marshalExtension a - --- | Demarshals the string from "marshalState" into a state. Uses the provided --- config to fill out non-persistent parts of the state. --- The extensible map is rehydrated as marshalled strings so decoding can be --- deferred until a specific extension is requested. -demarshalState :: Config m -> String -> State m -demarshalState Config {startingHooks = hooks} str = - State hooks xs - where - ( MarshalledState - (M.mapKeys ExtensionKey . fmap Left . M.fromList -> xs) - ) = read str diff --git a/plug/src/Montis/Foreign/Marshal.hs b/plug/src/Montis/Foreign/Marshal.hs deleted file mode 100644 index 157d928..0000000 --- a/plug/src/Montis/Foreign/Marshal.hs +++ /dev/null @@ -1,20 +0,0 @@ -module Montis.Foreign.Marshal where - -import Control.Monad.State -import Data.Word -import Foreign (Ptr, Storable (peek, sizeOf), castPtr, plusPtr) - -type Offset = Word32 - -newtype Demarshal a = Demarshal (StateT (Ptr ()) IO a) - deriving (Functor, Monad, Applicative, MonadState (Ptr ())) - -runDemarshal :: Ptr b -> Demarshal a -> IO a -runDemarshal p (Demarshal dm) = evalStateT dm (castPtr p) - -demarshal :: (Storable a) => Demarshal a -demarshal = do - ptr <- get - val <- Demarshal $ lift $ peek $ castPtr ptr - put (plusPtr ptr (sizeOf val)) - return val diff --git a/plug/src/Montis/Standard/Drag.hs b/plug/src/Montis/Standard/Drag.hs deleted file mode 100644 index a6ee878..0000000 --- a/plug/src/Montis/Standard/Drag.hs +++ /dev/null @@ -1,123 +0,0 @@ -module Montis.Standard.Drag where - -import Data.Bits ((.&.)) -import Data.Data (Typeable) -import Data.Word (Word32) -import Montis.Core -import Montis.Core.Runtime -import Montis.Core.State - ( Config (startingHooks), - ConfigModule (..), - Hooks (buttonHook, motionHook), - StateExtension (..), - ) -import Montis.Standard.Mouse (CursorPosition (CursorPosition)) - -data DragConfig where - DragConfig :: - { dragModifierMask :: Word32 - } -> - DragConfig - deriving (Typeable) - -instance ConfigModule Montis DragConfig where - alterConfig cfg c = - let ohb = buttonHook (startingHooks c) - ohm = motionHook (startingHooks c) - in c - { startingHooks = - (startingHooks c) - { buttonHook = \ev -> onButton (dragModifierMask cfg) ev >> ohb ev, - motionHook = \ev -> onMotion ev >> ohm ev - } - } - -data DragState = DragState - { dragToplevel :: ToplevelHandle, - dragOffsetX :: Double, - dragOffsetY :: Double - } - deriving (Typeable) - -data ResizeState = ResizeState - { resizeToplevel :: ToplevelHandle, - resizeStartX :: Double, - resizeStartY :: Double, - resizeStartW :: Double, - resizeStartH :: Double, - resizeStartCursorX :: Double, - resizeStartCursorY :: Double - } - deriving (Typeable) - -data DragAction - = DragMove DragState - | DragResize ResizeState - deriving (Typeable) - -newtype Dragging = Dragging (Maybe DragAction) - deriving (Typeable) - -instance StateExtension Dragging where - initialValue = Dragging Nothing - marshalExtension _ = Nothing - demarshalExtension _ = Nothing - -leftButton :: Word32 -leftButton = 272 -- BTN_LEFT - -rightButton :: Word32 -rightButton = 273 -- BTN_RIGHT - -onButton :: Word32 -> ButtonEvent -> Montis () -onButton modMask ev - | buttonEvent_button ev /= leftButton && buttonEvent_button ev /= rightButton = return () - | buttonEvent_state ev == ButtonPressed = do - if buttonEvent_modifiers ev .&. modMask == 0 - then return () - else do - CursorPosition (x, y) <- xStateGet - mtl <- toplevelAt x y - case mtl of - Nothing -> xStatePut (Dragging Nothing) - Just tl -> do - (tx, ty, tw, th) <- getToplevelGeometry tl - if buttonEvent_button ev == rightButton - then do - let warpX = tx + tw - warpY = ty + th - warpCursor warpX warpY - xStatePut (CursorPosition (warpX, warpY)) - xStatePut $ - Dragging - ( Just - ( DragResize - (ResizeState tl tx ty tw th warpX warpY) - ) - ) - else - xStatePut $ - Dragging - (Just (DragMove (DragState tl (x - tx) (y - ty)))) - | buttonEvent_state ev == ButtonReleased = - xStatePut (Dragging Nothing) - | otherwise = return () - -onMotion :: MotionEvent -> Montis () -onMotion ev = do - let (x, y) = motionEvent_absolute ev - xStatePut (CursorPosition (x, y)) - Dragging mdrag <- xStateGet - case mdrag of - Nothing -> return () - Just (DragMove (DragState tl dx dy)) -> - setToplevelPosition tl (x - dx) (y - dy) - Just (DragResize rs) -> do - let newW = max 1 (resizeStartW rs + (x - resizeStartCursorX rs)) - newH = max 1 (resizeStartH rs + (y - resizeStartCursorY rs)) - setToplevelGeometry - (resizeToplevel rs) - (resizeStartX rs) - (resizeStartY rs) - newW - newH diff --git a/plug/src/Montis/Standard/Keys.hs b/plug/src/Montis/Standard/Keys.hs deleted file mode 100644 index 0b670eb..0000000 --- a/plug/src/Montis/Standard/Keys.hs +++ /dev/null @@ -1,110 +0,0 @@ -module Montis.Standard.Keys where - -import Control.Monad (when) -import Control.Monad.IO.Class (liftIO) -import Data.Data (Typeable) -import Data.Default.Class (Default (..)) -import Data.Set qualified as Set -import Data.Word (Word32) -import Montis.Base.Foreign.WlRoots (seatKeyboardNotifyKey) -import Montis.Core.Events (KeyEvent (..), KeyState (..)) -import Montis.Core.Monad (Montis, xConfigGet, xStateGet, xStateModify) -import Montis.Core.Runtime (getSeat) -import Montis.Core.State - ( Config (startingHooks), - ConfigModule (..), - Hooks (keyHook), - StateExtension (..), - ) - --- | Configuration for the keybindings. -data KeysConfig where - KeysConfig :: - { startCont :: KeyEvent -> Montis Bool - } -> - KeysConfig - deriving (Typeable) - -instance Default KeysConfig where - def = KeysConfig $ \_ -> return False - -subkeys :: (KeyEvent -> Montis Bool) -> Montis Bool -subkeys fn = do - xStateModify $ \keyState -> - keyState - { awaiting = Just fn - } - return True - --- | State of the keys right now. -data KeysState where - KeysState :: - { awaiting :: Maybe (KeyEvent -> Montis Bool), - ignoredKeys :: Set.Set Word32 - } -> - KeysState - -instance StateExtension KeysState where - initialValue = KeysState Nothing Set.empty - marshalExtension = const Nothing - demarshalExtension = const Nothing - --- | Configurable module for keys. -instance ConfigModule Montis KeysConfig where - alterConfig _ c = - let oh = keyHook (startingHooks c) - in c - { startingHooks = - (startingHooks c) - { keyHook = \ev -> runEv ev >> oh ev - } - } - where - isKeyPress ev = keyEvent_state ev == KeyPressed - isKeyRelease ev = keyEvent_state ev == KeyReleased - shouldIgnoreEvent ev = do - KeysState {ignoredKeys} <- xStateGet - return $ Set.member (keyEvent_keycode ev) ignoredKeys - runEv ev = do - shouldIgnore <- shouldIgnoreEvent ev - if isKeyRelease ev && shouldIgnore - then xStateModify $ \ks -> - ks {ignoredKeys = Set.delete (keyEvent_keycode ev) (ignoredKeys ks)} - else do - handled <- - if isKeyPress ev - then do - handler' <- awaiting <$> xStateGet - handler <- maybe (startCont <$> xConfigGet) return handler' - -- Reset the hadler. - xStateModify $ \st -> - st {awaiting = Nothing} - handler ev - else return False - - if not handled - then forwardKeyToSeat ev - else when (isKeyPress ev) $ - xStateModify $ - \ks -> - ks - { ignoredKeys = - Set.insert (keyEvent_keycode ev) (ignoredKeys ks) - } - -forwardKeyToSeat :: KeyEvent -> Montis () -forwardKeyToSeat ev = do - mseat <- getSeat - case mseat of - Nothing -> return () - Just seat -> - liftIO $ - seatKeyboardNotifyKey - seat - (keyEvent_timeMs ev) - (keyEvent_keycode ev) - (keyStateToWord32 (keyEvent_state ev)) - -keyStateToWord32 :: KeyState -> Word32 -keyStateToWord32 KeyReleased = 0 -keyStateToWord32 KeyPressed = 1 diff --git a/plug/src/Montis/Standard/Mouse.hs b/plug/src/Montis/Standard/Mouse.hs deleted file mode 100644 index 933a2f4..0000000 --- a/plug/src/Montis/Standard/Mouse.hs +++ /dev/null @@ -1,50 +0,0 @@ -module Montis.Standard.Mouse where - -import Data.Data (Typeable) -import Montis.Core -import Montis.Core.Runtime (focusToplevel, toplevelAt) -import Montis.Core.State - ( Config (startingHooks), - ConfigModule (..), - Hooks (buttonHook, motionHook), - StateExtension (..), - ) - -data MouseConfig where - MouseConfig :: MouseConfig - deriving (Typeable) - -instance ConfigModule Montis MouseConfig where - alterConfig _ c = - let ohb = buttonHook (startingHooks c) - ohm = motionHook (startingHooks c) - in c - { startingHooks = - (startingHooks c) - { buttonHook = \ev -> onButton ev >> ohb ev, - motionHook = \ev -> onMotion ev >> ohm ev - } - } - -newtype CursorPosition = CursorPosition (Double, Double) - deriving (Typeable) - -instance StateExtension CursorPosition where - initialValue = CursorPosition (0, 0) - marshalExtension _ = Nothing - demarshalExtension _ = Nothing - -onMotion :: MotionEvent -> Montis () -onMotion ev = do - let (x, y) = motionEvent_absolute ev - xStatePut (CursorPosition (x, y)) - -onButton :: ButtonEvent -> Montis () -onButton ev - | buttonEvent_state ev /= ButtonPressed = return () - | otherwise = do - CursorPosition (x, y) <- xStateGet - mtl <- toplevelAt x y - case mtl of - Nothing -> return () - Just tl -> focusToplevel tl diff --git a/plug/src/harness_adapter.c b/plug/src/harness_adapter.c deleted file mode 100644 index db5e7ce..0000000 --- a/plug/src/harness_adapter.c +++ /dev/null @@ -1,73 +0,0 @@ -// This file provides functions for the wetterhorn harness that are not -// expressible directly in haskell. -// -// Currently these functions exclusively enable/disable the Haskell runtime. - -#include "HsFFI.h" -#include "plugin_interface.h" -#include -#include -#include - -const char *plugin_name = "Montis"; - -extern void performMajorGC(); - -void plugin_metaload(int argc, char** argv) -{ - // hs_init(&argc, &argv); -} - -void plugin_load(int argc, char **argv) { - hs_init(&argc, &argv); -} - -void plugin_teardown(opqst_t st) { - hs_exit(); -} - -void shell_exec(const char* cmd) { - if (fork() == 0) { - execl("/bin/sh", "/bin/sh", "-c", cmd, NULL); - exit(1); - } -} - -static const char msg[] = - "Montis Plugin v 0.01\n\n" - "Welcome, and thank you for your interest.\n\n" - "This is merely a plugin to the Montis Compositor and not meant to be\n" - "executed as a standalone binary. This plugin requires a harness to run\n" - "To use this file, please use './wtr_harness [full-path-to-wtr.so]'\n" - "That will allow you to see how this compositor works in all its glory!\n"; -static const int msg_sz = sizeof(msg); - -/* - * Implemens a basic _start that prints inforamtion and exits for users on an - * x86_64 system. - */ -__attribute__((naked)) void _start() -{ - - // Make system call to print the message - asm( - // Load the address of the string into rsi - "mov %0, %%rsi\n" - // Load the string length into edx - "mov %1, %%edx\n" - // Load the file descriptor for stdout into edi - "mov $1, %%edi\n" - // Load the syscall number for sys_write into eax - "mov $1, %%eax\n" - // Make the syscall - "syscall\n" - - // Exit the program. - "mov $0, %%rdi\n" - "mov $60, %%rax\n" - "syscall\n" - : - : "r"(msg), "r"(msg_sz) // Input: address of msg - : "%rsi", "%edx", "%edi" // Clobbered registers - ); -} diff --git a/plug/stack.yaml b/plug/stack.yaml deleted file mode 100644 index 0faf47c..0000000 --- a/plug/stack.yaml +++ /dev/null @@ -1,67 +0,0 @@ -# This file was automatically generated by 'stack init' -# -# Some commonly used options have been documented as comments in this file. -# For advanced use and comprehensive documentation of the format, please see: -# https://docs.haskellstack.org/en/stable/yaml_configuration/ - -# Resolver to choose a 'specific' stackage snapshot or a compiler version. -# A snapshot resolver dictates the compiler version and the set of packages -# to be used for project dependencies. For example: -# -resolver: lts-21.21 -# ghc-9.6.4 -# lts-21.21 -# resolver: nightly-2023-09-24 -# resolver: ghc-9.6.2 -# -# The location of a snapshot can be provided as a file or url. Stack assumes -# a snapshot provided as a file might change, whereas a url resource does not. -# -# resolver: ./custom-snapshot.yaml -# resolver: https://example.com/snapshots/2023-01-01.yaml - -# User packages to be built. -# Various formats can be used as shown in the example below. -# -# packages: -# - some-directory -# - https://example.com/foo/bar/baz-0.0.2.tar.gz -# subdirs: -# - auto-update -# - wai -packages: -- . -# Dependency packages to be pulled from upstream that are not in the resolver. -# These entries can reference officially published versions as well as -# forks / in-progress versions pinned to a git hash. For example: -# -# extra-deps: -# - acme-missiles-0.3 -# - git: https://github.com/commercialhaskell/stack.git -# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a -# -# extra-deps: [] - -# Override default flag values for local packages and extra-deps -# flags: {} - -# Extra package databases containing global packages -# extra-package-dbs: [] - -# Control whether we use the GHC we find on the path -# system-ghc: true -# -# Require a specific version of Stack, using version ranges -# require-stack-version: -any # Default -# require-stack-version: ">=2.13" -# -# Override the architecture used by Stack, especially useful on Windows -# arch: i386 -# arch: x86_64 -# -# Extra directories used by Stack for building -# extra-include-dirs: [/path/to/dir] -# extra-lib-dirs: [/path/to/dir] -# -# Allow a newer minor version of GHC than the snapshot specifies -# compiler-check: newer-minor diff --git a/plug/test/Spec.hs b/plug/test/Spec.hs deleted file mode 100644 index cd4753f..0000000 --- a/plug/test/Spec.hs +++ /dev/null @@ -1,2 +0,0 @@ -main :: IO () -main = putStrLn "Test suite not yet implemented" diff --git a/rt/CMakeLists.txt b/rt/CMakeLists.txt deleted file mode 100644 index 742d2f0..0000000 --- a/rt/CMakeLists.txt +++ /dev/null @@ -1,149 +0,0 @@ -cmake_minimum_required(VERSION 3.10) -project ( - montis - VERSION 0.1 - LANGUAGES C) - -set(CMAKE_VERBOSE_MAKEFILE ON) -set(CMAKE_BUILD_TYPE Debug) - -set(WLROOTS_VERSION "0.18") -set(WLROOTS_URL "https://gitlab.freedesktop.org/wlroots/wlroots/-/archive/${WLROOTS_VERSION}/wlroots-${WLROOTS_VERSION}.tar.gz") -set(WLROOTS_TARBALL "${CMAKE_BINARY_DIR}/wlroots-${WLROOTS_VERSION}.tar.gz") -set(WLROOTS_SOURCE_DIR "${CMAKE_BINARY_DIR}/wlroots-src") -set(WLROOTS_BUILD_DIR "${CMAKE_BINARY_DIR}/wlroots") -set(WLROOTS_LIB_STATIC "${WLROOTS_BUILD_DIR}/libwlroots-${WLROOTS_VERSION}.a") -set(WLROOTS_LIB_LINK "${WLROOTS_BUILD_DIR}/libwlroots.a") - -add_custom_command( - OUTPUT "${WLROOTS_LIB_LINK}" - COMMAND sh -c "if [ ! -d \"$1\" ]; then mkdir -p \"$1\" && curl -L \"$2\" | tar xzf - --strip-components=1 -C \"$1\"; fi" sh "${WLROOTS_SOURCE_DIR}" "${WLROOTS_URL}" - COMMAND "${CMAKE_COMMAND}" -E make_directory "${WLROOTS_BUILD_DIR}" - COMMAND meson setup --reconfigure -Ddefault_library=static "${WLROOTS_BUILD_DIR}" "${WLROOTS_SOURCE_DIR}" - COMMAND meson compile -C "${WLROOTS_BUILD_DIR}" - COMMAND "${CMAKE_COMMAND}" -E create_symlink "${WLROOTS_LIB_STATIC}" "${WLROOTS_LIB_LINK}" - WORKING_DIRECTORY "${CMAKE_SOURCE_DIR}" - COMMENT "Building wlroots via Meson (static)" - VERBATIM -) - -include_directories(include/ /usr/include/pixman-1 - ${CMAKE_CURRENT_BINARY_DIR}/ - ${WLROOTS_SOURCE_DIR}/include - ${WLROOTS_BUILD_DIR}/include - ${WLROOTS_BUILD_DIR}/protocol -) - -add_definitions(-DWLR_USE_UNSTABLE) - -execute_process( - COMMAND pkg-config --variable=pkgdatadir wayland-protocols - OUTPUT_VARIABLE WAYLAND_PROTOCOLS - RESULT_VARIABLE ec - OUTPUT_STRIP_TRAILING_WHITESPACE -) -if(${ec} EQUAL 0) -else() - message(FATAL_ERROR "Failed to execute pkg-config") -endif() - -execute_process( - COMMAND pkg-config --variable=wayland_scanner wayland-scanner - OUTPUT_VARIABLE WAYLAND_SCANNER - RESULT_VARIABLE ec - OUTPUT_STRIP_TRAILING_WHITESPACE -) -if(${ec} EQUAL 0) -else() - message(FATAL_ERROR "Failed to execute pkg-config") -endif() - -set(PLUGIN_INTF ${CMAKE_BINARY_DIR}/plugin_interface.h) -add_custom_command( - OUTPUT ${PLUGIN_INTF} - COMMAND perl ${PROJECT_SOURCE_DIR}/tools/genintf.pl < - ${PROJECT_SOURCE_DIR}/include/plugin.h > ${PLUGIN_INTF} - DEPENDS ${PROJECT_SOURCE_DIR}/include/plugin.h - DEPENDS ${PROJECT_SOURCE_DIR}/tools/genintf.pl -) - -set(PLUGIN_LOAD ${CMAKE_BINARY_DIR}/gen_plugin_load.c) -add_custom_command( - OUTPUT ${PLUGIN_LOAD} - COMMAND perl ${PROJECT_SOURCE_DIR}/tools/genbuild.pl < - ${PROJECT_SOURCE_DIR}/include/plugin.h > ${PLUGIN_LOAD} - DEPENDS ${PROJECT_SOURCE_DIR}/include/plugin.h - DEPENDS ${PROJECT_SOURCE_DIR}/tools/genbuild.pl -) - -add_custom_command( - OUTPUT xdg-shell-protocol.h - COMMAND ${WAYLAND_SCANNER} server-header - ${WAYLAND_PROTOCOLS}/stable/xdg-shell/xdg-shell.xml - xdg-shell-protocol.h -) - -add_custom_command( - OUTPUT xdg-shell-protocol.c - COMMAND ${WAYLAND_SCANNER} private-code - ${WAYLAND_PROTOCOLS}/stable/xdg-shell/xdg-shell.xml - xdg-shell-protocol.c - DEPENDS xdg-shell-protocol.h -) - -file (GLOB_RECURSE SOURCES src/*.c) - -set(CMAKE_EXPORT_COMPILE_COMMANDS ON) - -add_executable (montis ${SOURCES} ${PLUGIN_LOAD} ${PLUGIN_INTF} ${WLROOTS_LIB_LINK} - xdg-shell-protocol.c) - -find_package(PkgConfig REQUIRED) - -pkg_check_modules(WLREQ REQUIRED IMPORTED_TARGET - wayland-server - wayland-client - wayland-egl - wayland-cursor - xkbcommon - pixman-1 - libinput - libudev - libseat - libdrm - gbm - egl - glesv2 -) - -target_link_libraries(montis PRIVATE PkgConfig::WLREQ dl pthread ${WLROOTS_LIB_LINK}) - -pkg_check_modules(WLOPT IMPORTED_TARGET - cairo - lcms2 - libdisplay-info - libliftoff - vulkan - xwayland - xcb - xcb-composite - xcb-dri3 - xcb-errors - xcb-ewmh - xcb-icccm - xcb-present - xcb-render - xcb-renderutil - xcb-res - xcb-shm - xcb-xfixes - xcb-xinput -) - -if(WLOPT_FOUND) - target_link_libraries(montis PRIVATE PkgConfig::WLOPT) -endif() - -target_link_directories(montis PUBLIC - "${WLROOTS_BUILD_DIR}") -target_link_options(montis PRIVATE -rdynamic) diff --git a/rt/include/plugin.h b/rt/include/plugin.h deleted file mode 100644 index 3098602..0000000 --- a/rt/include/plugin.h +++ /dev/null @@ -1,190 +0,0 @@ -#ifndef _PLUGIN_H_ -#define _PLUGIN_H_ - -#include -#include -#include -#include -#include -#include -#include - -#include "plugin_types.h" - -/* - * Marker macro to define what functions should be exported. This generates the - * interface which the plugin needs to implement. - */ -#define EXPORT(a) a - -#define EXPORT_INCLUDE(a) - -// clang-format off -EXPORT_INCLUDE() -EXPORT_INCLUDE() -EXPORT_INCLUDE() -// clang-format on - -#define MAX_QUEUED_ACTIONS 8 - -typedef void *dlhandle_t; - -/* Opaque state for a plugin. Not to be touched by the harness (not that it - * really can be.) */ - -struct PLUGIN; -/* This structure represents an action requested by the plugin for the harness. - */ -typedef struct { - int (*action)(struct PLUGIN *requester, void *arg); - void (*arg_dtor)(void *arg); - union { - void *ptr_arg; - int int_arg; - char *str_arg; - }; -} requested_action_t; - -/* - * Structure for the plugin. - */ -typedef struct PLUGIN { - /* The argc this plugin is loaded with. Typically the argc from main(). */ - int argc; - - /* The argv this plugin is loaded with. Typically the argv from main(). */ - char **argv; - - /* Filename the plugin is loaded from. */ - char filename[PATH_MAX]; - - /* Opaque state of this plugin. The state is usually some kind of pointer to - * the plugin state, but all the harness knows is the opaque state is a - * pointer-sized piece of data. - * - * This opaque state is used in a linear pattern where the handlers take the - * opaque state, maybe operate on it, and return a new opaque state, which is - * then passed to the next handler, etc. It is on the plugin to properly - * manager the memory for this state and to destroy it upon teardown. - * - * It's guaranteed that this state is used linearly, meaning the harness gives - * up all ownership to it once passed into a handler. */ - opqst_t state; - - /* This plugin's lock. This avoids potential issues with multiple threads - * trying to change the opaque state at once which can lead to undesireable - * outcomes. */ - pthread_mutex_t lock; - - /** Set to not-zero if this plugin is initialized, otherwise set to zero. */ - int initialized; - - /* The handle to the shared library. */ - dlhandle_t library_handle; - - /* Pointer to the plugin name. This is in the shared library and a - * null-terminated string. If the library does not have a plugin name, this - * will be NULL. */ - const char *plugin_name; - - /** - * Initializes the plugin on the first time, and only the first time, it is - * loaded. This is used to do things like setup a runtime that cannot be - * reliably torn down. It is up to the plugin to ensure this won't interfere - * with hot-reloading. - */ - EXPORT(void (*plugin_metaload)(int argc, char **argv)); - - /** Intializes the plugin with the given argc/argv. This is the first thing - * called on the plugin and is called immediately after the library is loaded. - */ - EXPORT(void (*plugin_load)(int argc, char **argv)); - - /* Start the plugin with the marshalled state from the previous plugin. - * - * This should return the opaque state from the mashalled_state. - * - * This function should not fail if the state cannot be demarshalled, rather a - * default state should be returned. This is because changing the plugin and - * hot-reloading can produce incompatibilities between the old state and the - * new state, and this should not cause a failure. - */ - EXPORT(opqst_t (*plugin_hot_start)(void *self, uint8_t *mashalled_state, - uint32_t n)); - - /* - * Starts the plugin without a marshalled state. Happens during the first boot - * when there is not state. - */ - EXPORT(opqst_t (*plugin_cold_start)(void* self)); - - /* - * Marshals the state to a bytestring. The returned pointer should be malloc'd - * on the heap. The harness takes ownership of the malloc'd pointer. - * - * This is usually called in preparation for a teardown followed by a - * hot-start. - */ - EXPORT(uint8_t *(*plugin_marshal_state)(opqst_t st, uint32_t *szout)); - - /* - * Teardown the plugin in preperation for the library's imminent unloading. - */ - EXPORT(void (*plugin_teardown)(opqst_t)); - - /* - * Handles a keybinding. - */ - EXPORT(opqst_t (*plugin_handle_keybinding)( - struct wlr_keyboard *keyboard, struct wlr_keyboard_key_event *event, - uint32_t modifiers, uint32_t keysym, uint32_t codepoint, int *out_handled, - opqst_t state)); - - EXPORT(opqst_t (*plugin_handle_button)(struct wlr_pointer_button_event *event, - uint32_t modifiers, opqst_t state)); - - /* Absolute motion only for now; relative motion stays in the runtime. */ - EXPORT(opqst_t (*plugin_handle_motion)(void *event, uint32_t modifiers, - uint32_t is_absolute, double lx, - double ly, opqst_t state)); - - /* - * Handles a surface being mapped, unmapped or destroyed. - */ - EXPORT(opqst_t (*plugin_handle_surface)(void *surface, surface_event_t event, - opqst_t)); - - /* List of requested actions by the plugin. Right now there is a maximum of 8 - * allowed at one time. That should be plenty. The actions should be flushed - * after each call to a handler anyway. */ - size_t n_requested_actions; - requested_action_t requested_actions[MAX_QUEUED_ACTIONS]; -} plugin_t; - -#undef EXPORT -#undef EXPORT_INCLUDE - -/* Reloads the plugin. This tears down the existing plugin, marshals the state - * for it and reloads it. - * - * This function will call dlclose on the plugin's library handle. - */ -int plugin_hot_reload(int argc, char **argv, const char *filepath, - plugin_t *plugin); - -/* - * Like hot-reload, but uses the same parameters the plugin was originally - * loaded with. - */ -int plugin_hot_reload_same_state(plugin_t *plugin); - -/* Starts a plugin in a cold state. Called after load_plugin_from_file. */ -void plugin_cold_start(plugin_t *plugin); - -/* Reads a plugin from a filename. */ -int load_plugin_from_file(int argc, char **argv, const char *filename, - plugin_t *plugin); - -void plugin_run_requested_actions(plugin_t *plugin); - -#endif /* _PLUGIN_H_ */ diff --git a/rt/include/plugin_types.h b/rt/include/plugin_types.h deleted file mode 100644 index df1eab5..0000000 --- a/rt/include/plugin_types.h +++ /dev/null @@ -1,9 +0,0 @@ -#pragma once - -typedef void *opqst_t; - -typedef enum { - SURFACE_MAP = 0, - SURFACE_UNMAP, - SURFACE_DELETE, -} surface_event_t; diff --git a/rt/include/util.h b/rt/include/util.h deleted file mode 100644 index 2ed2f70..0000000 --- a/rt/include/util.h +++ /dev/null @@ -1,19 +0,0 @@ -#ifndef MONTIS_UTIL_H -#define MONTIS_UTIL_H - -/* - * Runtime helpers exposed to plugins. These operate on compositor state and - * are intended for direct FFI use from the Haskell plugin. - */ - -void *montis_plugin_toplevel_at(void *ctx, double lx, double ly); -void montis_plugin_get_toplevel_position(void *toplevel, double *x, double *y); -void montis_plugin_set_toplevel_position(void *toplevel, double x, double y); -void montis_plugin_get_toplevel_geometry(void *toplevel, double *x, double *y, - double *w, double *h); -void montis_plugin_set_toplevel_geometry(void *toplevel, double x, double y, - double w, double h); -void montis_plugin_focus_toplevel(void *toplevel); -void montis_plugin_warp_cursor(void *ctx, double lx, double ly); - -#endif /* MONTIS_UTIL_H */ diff --git a/rt/include/wl.h b/rt/include/wl.h deleted file mode 100644 index f10ee7d..0000000 --- a/rt/include/wl.h +++ /dev/null @@ -1,125 +0,0 @@ -#pragma once - -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#include - -/* For brevity's sake, struct members are annotated where they are used. */ -enum montis_cursor_mode { - TINYWL_CURSOR_PASSTHROUGH, - TINYWL_CURSOR_MOVE, - TINYWL_CURSOR_RESIZE, -}; - -struct montis_server { - struct wl_display *wl_display; - struct wlr_backend *backend; - struct wlr_renderer *renderer; - struct wlr_allocator *allocator; - struct wlr_scene *scene; - struct wlr_scene_output_layout *scene_layout; - - struct wlr_xdg_shell *xdg_shell; - struct wl_listener new_xdg_toplevel; - struct wl_listener new_xdg_popup; - struct wl_list toplevels; - - struct wlr_xdg_decoration_manager_v1 *xdg_decoration_manager; - struct wl_listener new_xdg_decoration; - - struct wlr_cursor *cursor; - struct wlr_xcursor_manager *cursor_mgr; - struct wl_listener cursor_motion; - struct wl_listener cursor_motion_absolute; - struct wl_listener cursor_button; - struct wl_listener cursor_axis; - struct wl_listener cursor_frame; - - struct wlr_seat *seat; - struct wl_listener new_input; - struct wl_listener request_cursor; - struct wl_listener request_set_selection; - struct wl_list keyboards; - enum montis_cursor_mode cursor_mode; - struct montis_toplevel *grabbed_toplevel; - double grab_x, grab_y; - struct wlr_box grab_geobox; - uint32_t resize_edges; - - struct wlr_output_layout *output_layout; - struct wl_list outputs; - struct wl_listener new_output; - - struct wlr_session *session; - plugin_t plugin; -}; - -struct montis_output { - struct wl_list link; - struct montis_server *server; - struct wlr_output *wlr_output; - struct wl_listener frame; - struct wl_listener request_state; - struct wl_listener destroy; -}; - -struct montis_toplevel { - struct wl_list link; - struct montis_server *server; - struct wlr_xdg_toplevel *xdg_toplevel; - struct wlr_scene_tree *scene_tree; - struct wl_listener map; - struct wl_listener unmap; - struct wl_listener destroy; - struct wl_listener commit; - struct wl_listener request_move; - struct wl_listener request_resize; - struct wl_listener request_maximize; - struct wl_listener request_fullscreen; -}; - -struct montis_keyboard { - struct wl_list link; - struct montis_server *server; - struct wlr_keyboard *wlr_keyboard; - - struct wl_listener modifiers; - struct wl_listener key; - struct wl_listener destroy; -}; - -struct montis_popup { - struct wlr_xdg_popup *xdg_popup; - struct wl_listener commit; - struct wl_listener destroy; -}; - -struct montis_xdg_decoration { - struct wlr_xdg_toplevel_decoration_v1 *decoration; - struct wl_listener request_mode; - struct wl_listener destroy; -}; diff --git a/rt/src/plugin.c b/rt/src/plugin.c deleted file mode 100644 index 3edf486..0000000 --- a/rt/src/plugin.c +++ /dev/null @@ -1,260 +0,0 @@ -#include "plugin.h" -#include "wl.h" - -#include -#include -#include -#include -#include -#include -#include -#include - -/* Utility function for showing the marshalled states as hex code */ -static void shx(uint8_t *state, uint32_t sz) -{ - uint32_t i = 0; - while (i < sz) { - for (int j = 0; j < 16; ++j) { - if (i < sz) { - printf("%02x ", (unsigned int)state[i]); - } - else { - printf(" "); - } - ++i; - } - - i -= 16; - - printf(" "); - - for (int j = 0; j < 16; ++j) { - if (i < sz) { - if (isprint(state[i]) && !isspace(state[i])) { - printf("%c", state[i]); - } - else { - printf("."); - } - } - else { - printf(" "); - } - ++i; - } - printf("\n"); - } -} - -int load_plugin_from_dl_(dlhandle_t dl, plugin_t *plug); - -static void lock(plugin_t *plugin) { pthread_mutex_lock(&plugin->lock); }; - -static void unlock(plugin_t *plugin) { pthread_mutex_unlock(&plugin->lock); }; - -static int plugin_hot_reload_same_state_action_(plugin_t *plugin, void *ignore) -{ - return plugin_hot_reload_same_state(plugin); -} - -void montis_do_request_hot_reload(void *plugv) -{ - plugin_t *plugin = plugv; - - size_t n = plugin->n_requested_actions++; - if (n < 8) { - plugin->requested_actions[n].action = plugin_hot_reload_same_state_action_; - plugin->requested_actions[n].arg_dtor = NULL; - } -} - -static int plugin_do_log(plugin_t *plugin, void *chrs) -{ - char *str = chrs; - puts(str); - return 0; -} - -void montis_do_request_log(void *plugv, const char *str) -{ - plugin_t *plugin = plugv; - - size_t n = plugin->n_requested_actions++; - if (n < 8) { - plugin->requested_actions[n].action = plugin_do_log; - plugin->requested_actions[n].str_arg = strdup(str); - plugin->requested_actions[n].arg_dtor = free; - } -} - -static int montis_plugin_do_exit(void *plugv, int ec) -{ - exit(ec); - return 0; -} - -void montis_do_request_exit(void *plugv, int ec) -{ - plugin_t *plugin = plugv; - - size_t n = plugin->n_requested_actions++; - if (n < 8) { - plugin->requested_actions[n].action = - (int (*)(plugin_t *, void *))montis_plugin_do_exit; - plugin->requested_actions[n].int_arg = ec; - plugin->requested_actions[n].arg_dtor = NULL; - } -} - -void *montis_plugin_get_seat(void *ctx) -{ - struct montis_server *server = wl_container_of(ctx, server, plugin); - return server->seat; -} - -static int load_plugin_from_file_(int argc, char **argv, const char *filename, - plugin_t *plugin) -{ - dlhandle_t lib = dlopen(filename, RTLD_NOW | RTLD_GLOBAL); - int ec = 0; - - if (!lib) { - fprintf(stderr, "Failed to open library: %s: %s\n", filename, dlerror()); - ec = 1; - goto end; - } - - printf("Loading file.\n"); - ec = load_plugin_from_dl_(lib, plugin); - - if (ec) { - goto end; - } - - strncpy(plugin->filename, filename, sizeof(plugin->filename)); - plugin->argc = argc; - plugin->argv = argv; - - plugin->plugin_load(plugin->argc, plugin->argv); -end: - return ec; -} - -static void maybe_run_metaload(int argc, char **argv, plugin_t *plugin) -{ - static char *loaded_plugins[12]; - int i; - for (i = 0; i < 12 && loaded_plugins[i]; ++i) { - if (strcmp(loaded_plugins[i], plugin->plugin_name) == 0) { - return; // Plugin is already loaded - } - } - loaded_plugins[i] = strdup(plugin->plugin_name); - - printf("First time loading %s, running metaload.\n", plugin->plugin_name); - if (plugin->plugin_metaload) { - plugin->plugin_metaload(argc, argv); - } -} - -int load_plugin_from_file(int argc, char **argv, const char *filename, - plugin_t *plugin) -{ - memset(plugin, 0, sizeof(*plugin)); - - pthread_mutexattr_t attr; - if (pthread_mutexattr_init(&attr)) { - perror("pthread_mutexattr_init"); - return 1; - } - - if (pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE)) { - perror("pthread_mutexattr_settype"); - return 1; - } - - if (pthread_mutex_init(&plugin->lock, &attr)) { - pthread_mutexattr_destroy(&attr); - perror("pthread_mutexattr_init"); - return 1; - } - pthread_mutexattr_destroy(&attr); - int rc = load_plugin_from_file_(argc, argv, filename, plugin); - - if (rc == 0) { - maybe_run_metaload(argc, argv, plugin); - } - - return rc; -} - -int plugin_hot_reload_same_state(plugin_t *plugin) -{ - char filename_cpy[PATH_MAX]; - strncpy(filename_cpy, plugin->filename, sizeof(filename_cpy)); - return plugin_hot_reload(plugin->argc, plugin->argv, filename_cpy, plugin); -} - -int plugin_hot_reload(int argc, char **argv, const char *filepath, - plugin_t *plugin) -{ - int ec = 0; - uint32_t sz = 0; - uint8_t *marshalled_state = NULL; - - printf("Hot Reloading %s\n", plugin->plugin_name); - lock(plugin); - - printf("Marshalling state ...\n"); - marshalled_state = plugin->plugin_marshal_state(plugin->state, &sz); - - printf("Calling teardown ...\n"); - plugin->plugin_teardown(plugin->state); - - printf("State Marshalled:\n"); - shx(marshalled_state, sz); - - printf("Unloading old library handle.\n"); - if (dlclose(plugin->library_handle)) { - printf("Could not close library handle: %s\n", dlerror()); - } - - if ((ec = load_plugin_from_file_(argc, argv, filepath, plugin))) { - goto fail; - } - - printf("Hot starting plugin ...\n"); - plugin->state = plugin->plugin_hot_start(plugin, marshalled_state, sz); - -fail: - free(marshalled_state); - unlock(plugin); - return ec; -} - -void plugin_run_requested_actions(plugin_t *plugin) -{ - lock(plugin); - requested_action_t requested_actions[MAX_QUEUED_ACTIONS]; - size_t n_requested_actions = plugin->n_requested_actions; - memcpy(&requested_actions, plugin->requested_actions, - sizeof(requested_actions)); - plugin->n_requested_actions = 0; - unlock(plugin); - - size_t i; - for (i = 0; i < n_requested_actions; ++i) { - requested_actions[i].action(plugin, requested_actions[i].str_arg); - if (requested_actions[i].arg_dtor) { - requested_actions[i].arg_dtor(requested_actions[i].ptr_arg); - } - } -} - -void plugin_cold_start(plugin_t *plugin) -{ - lock(plugin); - plugin->state = plugin->plugin_cold_start(plugin); - unlock(plugin); -} diff --git a/rt/src/util.c b/rt/src/util.c deleted file mode 100644 index e09cff9..0000000 --- a/rt/src/util.c +++ /dev/null @@ -1,133 +0,0 @@ -#include "util.h" -#include "wl.h" - -#include -#include - -static struct montis_server *server_from_ctx(void *ctx) -{ - struct montis_server *server = wl_container_of(ctx, server, plugin); - return server; -} - -static struct montis_toplevel *toplevel_at(struct montis_server *server, - double lx, double ly) -{ - double sx = 0.0; - double sy = 0.0; - - struct wlr_scene_node *node = - wlr_scene_node_at(&server->scene->tree.node, lx, ly, &sx, &sy); - if (node == NULL || node->type != WLR_SCENE_NODE_BUFFER) { - return NULL; - } - struct wlr_scene_buffer *scene_buffer = wlr_scene_buffer_from_node(node); - struct wlr_scene_surface *scene_surface = - wlr_scene_surface_try_from_buffer(scene_buffer); - if (!scene_surface) { - return NULL; - } - - struct wlr_scene_tree *tree = node->parent; - while (tree != NULL && tree->node.data == NULL) { - tree = tree->node.parent; - } - return tree ? tree->node.data : NULL; -} - -void *montis_plugin_toplevel_at(void *ctx, double lx, double ly) -{ - if (!ctx) { - return NULL; - } - struct montis_server *server = server_from_ctx(ctx); - return toplevel_at(server, lx, ly); -} - -void montis_plugin_get_toplevel_position(void *toplevel, double *x, double *y) -{ - if (!toplevel || !x || !y) { - return; - } - struct montis_toplevel *tl = toplevel; - *x = tl->scene_tree->node.x; - *y = tl->scene_tree->node.y; -} - -void montis_plugin_set_toplevel_position(void *toplevel, double x, double y) -{ - if (!toplevel) { - return; - } - struct montis_toplevel *tl = toplevel; - wlr_scene_node_set_position(&tl->scene_tree->node, (int)x, (int)y); -} - -void montis_plugin_get_toplevel_geometry(void *toplevel, double *x, double *y, - double *w, double *h) -{ - if (!toplevel || !x || !y || !w || !h) { - return; - } - struct montis_toplevel *tl = toplevel; - struct wlr_box geo_box; - wlr_xdg_surface_get_geometry(tl->xdg_toplevel->base, &geo_box); - *x = tl->scene_tree->node.x; - *y = tl->scene_tree->node.y; - *w = geo_box.width; - *h = geo_box.height; -} - -void montis_plugin_set_toplevel_geometry(void *toplevel, double x, double y, - double w, double h) -{ - if (!toplevel) { - return; - } - struct montis_toplevel *tl = toplevel; - wlr_scene_node_set_position(&tl->scene_tree->node, (int)x, (int)y); - wlr_xdg_toplevel_set_size(tl->xdg_toplevel, (int)w, (int)h); -} - -void montis_plugin_warp_cursor(void *ctx, double lx, double ly) -{ - if (!ctx) { - return; - } - struct montis_server *server = server_from_ctx(ctx); - wlr_cursor_warp(server->cursor, NULL, lx, ly); -} - -void montis_plugin_focus_toplevel(void *toplevel) -{ - if (!toplevel) { - return; - } - struct montis_toplevel *tl = toplevel; - struct montis_server *server = tl->server; - struct wlr_seat *seat = server->seat; - struct wlr_surface *surface = tl->xdg_toplevel->base->surface; - struct wlr_surface *prev_surface = seat->keyboard_state.focused_surface; - - if (prev_surface == surface) { - return; - } - if (prev_surface) { - struct wlr_xdg_toplevel *prev_toplevel = - wlr_xdg_toplevel_try_from_wlr_surface(prev_surface); - if (prev_toplevel != NULL) { - wlr_xdg_toplevel_set_activated(prev_toplevel, false); - } - } - - struct wlr_keyboard *keyboard = wlr_seat_get_keyboard(seat); - wlr_scene_node_raise_to_top(&tl->scene_tree->node); - wl_list_remove(&tl->link); - wl_list_insert(&server->toplevels, &tl->link); - wlr_xdg_toplevel_set_activated(tl->xdg_toplevel, true); - if (keyboard != NULL) { - wlr_seat_keyboard_notify_enter(seat, surface, keyboard->keycodes, - keyboard->num_keycodes, - &keyboard->modifiers); - } -} diff --git a/rt/src/wl.c b/rt/src/wl.c deleted file mode 100644 index 8963e39..0000000 --- a/rt/src/wl.c +++ /dev/null @@ -1,1135 +0,0 @@ -#define _POSIX_C_SOURCE 200112L - -#include -#include -#include -#include - -#include - -#include "xdg-decoration-unstable-v1-client-protocol.h" - -// This macro is responsible for calling a handler on a plugin. This macro will -// acquire the plugin's lock, call the member with the arguments and update the -// state. -// -// This only works on function which have the format: -// -// opqst_t function(args ..., opqst_t state); -// -// Note that the state parameter is omitted from this macro. -#define plugin_call_update_state(plugin, member, ...) \ - do { \ - plugin_t *pl__ = &(plugin); \ - pthread_mutex_lock(&pl__->lock); \ - pl__->state = pl__->member(__VA_ARGS__, pl__->state); \ - pthread_mutex_unlock(&pl__->lock); \ - plugin_run_requested_actions(pl__); \ - } while (0) - -static void focus_toplevel(struct montis_toplevel *toplevel, - struct wlr_surface *surface) -{ - /* Note: this function only deals with keyboard focus. */ - if (toplevel == NULL) { - return; - } - struct montis_server *server = toplevel->server; - struct wlr_seat *seat = server->seat; - struct wlr_surface *prev_surface = seat->keyboard_state.focused_surface; - if (prev_surface == surface) { - /* Don't re-focus an already focused surface. */ - return; - } - if (prev_surface) { - /* - * Deactivate the previously focused surface. This lets the client know - * it no longer has focus and the client will repaint accordingly, e.g. - * stop displaying a caret. - */ - struct wlr_xdg_toplevel *prev_toplevel = - wlr_xdg_toplevel_try_from_wlr_surface(prev_surface); - if (prev_toplevel != NULL) { - wlr_xdg_toplevel_set_activated(prev_toplevel, false); - } - } - struct wlr_keyboard *keyboard = wlr_seat_get_keyboard(seat); - /* Move the toplevel to the front */ - wlr_scene_node_raise_to_top(&toplevel->scene_tree->node); - wl_list_remove(&toplevel->link); - wl_list_insert(&server->toplevels, &toplevel->link); - /* Activate the new surface */ - wlr_xdg_toplevel_set_activated(toplevel->xdg_toplevel, true); - /* - * Tell the seat to have the keyboard enter this surface. wlroots will keep - * track of this and automatically send key events to the appropriate - * clients without additional work on your part. - */ - if (keyboard != NULL) { - wlr_seat_keyboard_notify_enter(seat, toplevel->xdg_toplevel->base->surface, - keyboard->keycodes, keyboard->num_keycodes, - &keyboard->modifiers); - } -} - -static void keyboard_handle_modifiers(struct wl_listener *listener, void *data) -{ - /* This event is raised when a modifier key, such as shift or alt, is - * pressed. We simply communicate this to the client. */ - struct montis_keyboard *keyboard = - wl_container_of(listener, keyboard, modifiers); - /* - * A seat can only have one keyboard, but this is a limitation of the - * Wayland protocol - not wlroots. We assign all connected keyboards to the - * same seat. You can swap out the underlying wlr_keyboard like this and - * wlr_seat handles this transparently. - */ - wlr_seat_set_keyboard(keyboard->server->seat, keyboard->wlr_keyboard); - /* Send modifiers to the client. */ - wlr_seat_keyboard_notify_modifiers(keyboard->server->seat, - &keyboard->wlr_keyboard->modifiers); -} - -static void keyboard_handle_key(struct wl_listener *listener, void *data) -{ - /* This event is raised when a key is pressed or released. */ - struct montis_keyboard *keyboard = wl_container_of(listener, keyboard, key); - struct montis_server *server = keyboard->server; - struct wlr_keyboard_key_event *event = data; - struct wlr_seat *seat = server->seat; - - /* Translate libinput keycode -> xkbcommon */ - uint32_t keycode = event->keycode + 8; - /* Get a list of keysyms based on the keymap for this keyboard */ - const xkb_keysym_t *syms; - int nsyms = - xkb_state_key_get_syms(keyboard->wlr_keyboard->xkb_state, keycode, &syms); - - int handled = false; - uint32_t modifiers = wlr_keyboard_get_modifiers(keyboard->wlr_keyboard); - uint32_t codepoint; - int ec; - - if (nsyms > 0 && syms[0] >= XKB_KEY_XF86Switch_VT_1 && - syms[0] <= XKB_KEY_XF86Switch_VT_12) { - /* Escape-hatch to change sessions. These should always be available key - * bindings regardless of what the plugin dictates. This allows an escape - * hatch to edit the plugin in a different vterm and then use the escape - * hatch below to hot-restart the plugin if things get borked. */ - if (event->state == WL_KEYBOARD_KEY_STATE_PRESSED) { - wlr_session_change_vt(server->session, - syms[0] - XKB_KEY_XF86Switch_VT_1 + 1); - } - } - else if (modifiers == - (WLR_MODIFIER_SHIFT | WLR_MODIFIER_CTRL | WLR_MODIFIER_ALT) && - nsyms > 0 && syms[0] == XKB_KEY_Escape) { - /* Escape-hatch to hot-reload the plugin in case the plugin got borked and - * stops accepting keybindings. Ctrl+Shift+Alt+Escape will always reload the - * plugin.*/ - if (event->state == WL_KEYBOARD_KEY_STATE_PRESSED) { - if ((ec = plugin_hot_reload_same_state(&server->plugin)) != 0) { - fprintf(stderr, "Failed to hot reload plugin"); - exit(1); - } - } - } - else { - /* Pass the information along to the plugin for the plugin to handle. The - * plugin will return via 'handled' whether or not the key event was handled - * or not. */ - if (nsyms > 0) { - codepoint = - xkb_state_key_get_utf32(keyboard->wlr_keyboard->xkb_state, keycode); - plugin_call_update_state(server->plugin, plugin_handle_keybinding, - keyboard->wlr_keyboard, event, modifiers, - syms[0], codepoint, &handled); - } - } -} - -static void keyboard_handle_destroy(struct wl_listener *listener, void *data) -{ - /* This event is raised by the keyboard base wlr_input_device to signal - * the destruction of the wlr_keyboard. It will no longer receive events - * and should be destroyed. - */ - struct montis_keyboard *keyboard = - wl_container_of(listener, keyboard, destroy); - wl_list_remove(&keyboard->modifiers.link); - wl_list_remove(&keyboard->key.link); - wl_list_remove(&keyboard->destroy.link); - wl_list_remove(&keyboard->link); - free(keyboard); -} - -static void server_new_keyboard(struct montis_server *server, - struct wlr_input_device *device) -{ - struct wlr_keyboard *wlr_keyboard = wlr_keyboard_from_input_device(device); - - struct montis_keyboard *keyboard = calloc(1, sizeof(*keyboard)); - keyboard->server = server; - keyboard->wlr_keyboard = wlr_keyboard; - - struct xkb_rule_names names = (struct xkb_rule_names){0}; - names.layout = "jr"; - names.variant = "jdvprk"; - names.options = "numpad:mac"; - - /* We need to prepare an XKB keymap and assign it to the keyboard. This - * assumes the defaults (e.g. layout = "us"). */ - struct xkb_context *context = xkb_context_new(XKB_CONTEXT_NO_FLAGS); - struct xkb_keymap *keymap = - xkb_keymap_new_from_names(context, &names, XKB_KEYMAP_COMPILE_NO_FLAGS); - - if (!keymap) { - fprintf(stderr, "Unable to read keymap.\n"); - exit(1); - } - - wlr_keyboard_set_keymap(wlr_keyboard, keymap); - xkb_keymap_unref(keymap); - xkb_context_unref(context); - wlr_keyboard_set_repeat_info(wlr_keyboard, 25, 600); - - /* Here we set up listeners for keyboard events. */ - keyboard->modifiers.notify = keyboard_handle_modifiers; - wl_signal_add(&wlr_keyboard->events.modifiers, &keyboard->modifiers); - keyboard->key.notify = keyboard_handle_key; - wl_signal_add(&wlr_keyboard->events.key, &keyboard->key); - keyboard->destroy.notify = keyboard_handle_destroy; - wl_signal_add(&device->events.destroy, &keyboard->destroy); - - wlr_seat_set_keyboard(server->seat, keyboard->wlr_keyboard); - - /* And add the keyboard to our list of keyboards */ - wl_list_insert(&server->keyboards, &keyboard->link); -} - -static void server_new_pointer(struct montis_server *server, - struct wlr_input_device *device) -{ - /* We don't do anything special with pointers. All of our pointer handling - * is proxied through wlr_cursor. On another compositor, you might take this - * opportunity to do libinput configuration on the device to set - * acceleration, etc. */ - wlr_cursor_attach_input_device(server->cursor, device); -} - -static void server_new_input(struct wl_listener *listener, void *data) -{ - /* This event is raised by the backend when a new input device becomes - * available. */ - struct montis_server *server = wl_container_of(listener, server, new_input); - struct wlr_input_device *device = data; - switch (device->type) { - case WLR_INPUT_DEVICE_KEYBOARD: - server_new_keyboard(server, device); - break; - case WLR_INPUT_DEVICE_POINTER: - server_new_pointer(server, device); - break; - default: - break; - } - /* We need to let the wlr_seat know what our capabilities are, which is - * communiciated to the client. In TinyWL we always have a cursor, even if - * there are no pointer devices, so we always include that capability. */ - uint32_t caps = WL_SEAT_CAPABILITY_POINTER; - if (!wl_list_empty(&server->keyboards)) { - caps |= WL_SEAT_CAPABILITY_KEYBOARD; - } - wlr_seat_set_capabilities(server->seat, caps); -} - -static void seat_request_cursor(struct wl_listener *listener, void *data) -{ - struct montis_server *server = - wl_container_of(listener, server, request_cursor); - /* This event is raised by the seat when a client provides a cursor image */ - struct wlr_seat_pointer_request_set_cursor_event *event = data; - struct wlr_seat_client *focused_client = - server->seat->pointer_state.focused_client; - /* This can be sent by any client, so we check to make sure this one is - * actually has pointer focus first. */ - if (focused_client == event->seat_client) { - /* Once we've vetted the client, we can tell the cursor to use the - * provided surface as the cursor image. It will set the hardware cursor - * on the output that it's currently on and continue to do so as the - * cursor moves between outputs. */ - wlr_cursor_set_surface(server->cursor, event->surface, event->hotspot_x, - event->hotspot_y); - } -} - -static void seat_request_set_selection(struct wl_listener *listener, void *data) -{ - /* This event is raised by the seat when a client wants to set the selection, - * usually when the user copies something. wlroots allows compositors to - * ignore such requests if they so choose, but in montis we always honor - */ - struct montis_server *server = - wl_container_of(listener, server, request_set_selection); - struct wlr_seat_request_set_selection_event *event = data; - wlr_seat_set_selection(server->seat, event->source, event->serial); -} - -static struct montis_toplevel *desktop_toplevel_at(struct montis_server *server, - double lx, double ly, - struct wlr_surface **surface, - double *sx, double *sy) -{ - /* This returns the topmost node in the scene at the given layout coords. - * We only care about surface nodes as we are specifically looking for a - * surface in the surface tree of a montis_toplevel. */ - struct wlr_scene_node *node = - wlr_scene_node_at(&server->scene->tree.node, lx, ly, sx, sy); - if (node == NULL || node->type != WLR_SCENE_NODE_BUFFER) { - return NULL; - } - struct wlr_scene_buffer *scene_buffer = wlr_scene_buffer_from_node(node); - struct wlr_scene_surface *scene_surface = - wlr_scene_surface_try_from_buffer(scene_buffer); - if (!scene_surface) { - return NULL; - } - - *surface = scene_surface->surface; - /* Find the node corresponding to the montis_toplevel at the root of this - * surface tree, it is the only one for which we set the data field. */ - struct wlr_scene_tree *tree = node->parent; - while (tree != NULL && tree->node.data == NULL) { - tree = tree->node.parent; - } - return tree->node.data; -} - -static void reset_cursor_mode(struct montis_server *server) -{ - /* Reset the cursor mode to passthrough. */ - server->cursor_mode = TINYWL_CURSOR_PASSTHROUGH; - server->grabbed_toplevel = NULL; -} - -static void process_cursor_move(struct montis_server *server, uint32_t time) -{ - /* Move the grabbed toplevel to the new position. */ - struct montis_toplevel *toplevel = server->grabbed_toplevel; - wlr_scene_node_set_position(&toplevel->scene_tree->node, - server->cursor->x - server->grab_x, - server->cursor->y - server->grab_y); -} - -static void process_cursor_resize(struct montis_server *server, uint32_t time) -{ - /* - * Resizing the grabbed toplevel can be a little bit complicated, because we - * could be resizing from any corner or edge. This not only resizes the - * toplevel on one or two axes, but can also move the toplevel if you resize - * from the top or left edges (or top-left corner). - * - * Note that some shortcuts are taken here. In a more fleshed-out - * compositor, you'd wait for the client to prepare a buffer at the new - * size, then commit any movement that was prepared. - */ - struct montis_toplevel *toplevel = server->grabbed_toplevel; - double border_x = server->cursor->x - server->grab_x; - double border_y = server->cursor->y - server->grab_y; - int new_left = server->grab_geobox.x; - int new_right = server->grab_geobox.x + server->grab_geobox.width; - int new_top = server->grab_geobox.y; - int new_bottom = server->grab_geobox.y + server->grab_geobox.height; - - if (server->resize_edges & WLR_EDGE_TOP) { - new_top = border_y; - if (new_top >= new_bottom) { - new_top = new_bottom - 1; - } - } - else if (server->resize_edges & WLR_EDGE_BOTTOM) { - new_bottom = border_y; - if (new_bottom <= new_top) { - new_bottom = new_top + 1; - } - } - if (server->resize_edges & WLR_EDGE_LEFT) { - new_left = border_x; - if (new_left >= new_right) { - new_left = new_right - 1; - } - } - else if (server->resize_edges & WLR_EDGE_RIGHT) { - new_right = border_x; - if (new_right <= new_left) { - new_right = new_left + 1; - } - } - - struct wlr_box geo_box; - wlr_xdg_surface_get_geometry(toplevel->xdg_toplevel->base, &geo_box); - wlr_scene_node_set_position(&toplevel->scene_tree->node, new_left - geo_box.x, - new_top - geo_box.y); - - int new_width = new_right - new_left; - int new_height = new_bottom - new_top; - wlr_xdg_toplevel_set_size(toplevel->xdg_toplevel, new_width, new_height); -} - -static void process_cursor_motion(struct montis_server *server, uint32_t time) -{ - /* If the mode is non-passthrough, delegate to those functions. */ - if (server->cursor_mode == TINYWL_CURSOR_MOVE) { - process_cursor_move(server, time); - return; - } - else if (server->cursor_mode == TINYWL_CURSOR_RESIZE) { - process_cursor_resize(server, time); - return; - } - - /* Otherwise, find the toplevel under the pointer and send the event along. */ - double sx, sy; - struct wlr_seat *seat = server->seat; - struct wlr_surface *surface = NULL; - struct montis_toplevel *toplevel = desktop_toplevel_at( - server, server->cursor->x, server->cursor->y, &surface, &sx, &sy); - if (!toplevel) { - /* If there's no toplevel under the cursor, set the cursor image to a - * default. This is what makes the cursor image appear when you move it - * around the screen, not over any toplevels. */ - wlr_cursor_set_xcursor(server->cursor, server->cursor_mgr, "default"); - } - if (surface) { - /* - * Send pointer enter and motion events. - * - * The enter event gives the surface "pointer focus", which is distinct - * from keyboard focus. You get pointer focus by moving the pointer over - * a window. - * - * Note that wlroots will avoid sending duplicate enter/motion events if - * the surface has already has pointer focus or if the client is already - * aware of the coordinates passed. - */ - wlr_seat_pointer_notify_enter(seat, surface, sx, sy); - wlr_seat_pointer_notify_motion(seat, time, sx, sy); - } - else { - /* Clear pointer focus so future button events and such are not sent to - * the last client to have the cursor over it. */ - wlr_seat_pointer_clear_focus(seat); - } -} - -static void server_cursor_motion(struct wl_listener *listener, void *data) -{ - /* This event is forwarded by the cursor when a pointer emits a _relative_ - * pointer motion event (i.e. a delta) */ - struct montis_server *server = - wl_container_of(listener, server, cursor_motion); - struct wlr_pointer_motion_event *event = data; - struct wlr_seat *seat = server->seat; - struct wlr_keyboard *keyboard = wlr_seat_get_keyboard(seat); - uint32_t modifiers = keyboard ? wlr_keyboard_get_modifiers(keyboard) : 0; - /* The cursor doesn't move unless we tell it to. The cursor automatically - * handles constraining the motion to the output layout, as well as any - * special configuration applied for the specific input device which - * generated the event. You can pass NULL for the device if you want to move - * the cursor around without any input. */ - wlr_cursor_move(server->cursor, &event->pointer->base, event->delta_x, - event->delta_y); - process_cursor_motion(server, event->time_msec); - plugin_call_update_state(server->plugin, plugin_handle_motion, event, - modifiers, 0, server->cursor->x, server->cursor->y); -} - -static void server_cursor_motion_absolute(struct wl_listener *listener, - void *data) -{ - /* This event is forwarded by the cursor when a pointer emits an _absolute_ - * motion event, from 0..1 on each axis. This happens, for example, when - * wlroots is running under a Wayland window rather than KMS+DRM, and you - * move the mouse over the window. You could enter the window from any edge, - * so we have to warp the mouse there. There is also some hardware which - * emits these events. */ - struct montis_server *server = - wl_container_of(listener, server, cursor_motion_absolute); - struct wlr_pointer_motion_absolute_event *event = data; - - struct wlr_seat *seat = server->seat; - struct wlr_keyboard *keyboard = wlr_seat_get_keyboard(seat); - uint32_t modifiers = keyboard ? wlr_keyboard_get_modifiers(keyboard) : 0; - - wlr_cursor_warp_absolute(server->cursor, &event->pointer->base, event->x, - event->y); - process_cursor_motion(server, event->time_msec); - plugin_call_update_state(server->plugin, plugin_handle_motion, event, - modifiers, 1, server->cursor->x, server->cursor->y); -} - -static void server_cursor_button(struct wl_listener *listener, void *data) -{ - /* This event is forwarded by the cursor when a pointer emits a button - * event. */ - struct montis_server *server = - wl_container_of(listener, server, cursor_button); - struct wlr_pointer_button_event *event = data; - struct wlr_seat *seat = server->seat; - struct wlr_keyboard *keyboard = wlr_seat_get_keyboard(seat); - uint32_t modifiers = wlr_keyboard_get_modifiers(keyboard); - - plugin_call_update_state(server->plugin, plugin_handle_button, event, - modifiers); - - /* Notify the client with pointer focus that a button press has occurred */ - // wlr_seat_pointer_notify_button(server->seat, event->time_msec, - // event->button, - // event->state); - // double sx, sy; - // struct wlr_surface *surface = NULL; - // struct montis_toplevel *toplevel = desktop_toplevel_at( - // server, server->cursor->x, server->cursor->y, &surface, &sx, &sy); - // if (event->state == WLR_BUTTON_RELEASED) { - // /* If you released any buttons, we exit interactive move/resize mode. */ - // reset_cursor_mode(server); - // } - // else { - // /* Focus that client if the button was _pressed_ */ - // focus_toplevel(toplevel, surface); - // } -} - -static void server_cursor_axis(struct wl_listener *listener, void *data) -{ - /* This event is forwarded by the cursor when a pointer emits an axis event, - * for example when you move the scroll wheel. */ - struct montis_server *server = wl_container_of(listener, server, cursor_axis); - struct wlr_pointer_axis_event *event = data; - /* Notify the client with pointer focus of the axis event. */ - wlr_seat_pointer_notify_axis( - server->seat, event->time_msec, event->orientation, event->delta, - event->delta_discrete, event->source, event->relative_direction); -} - -static void server_cursor_frame(struct wl_listener *listener, void *data) -{ - /* This event is forwarded by the cursor when a pointer emits an frame - * event. Frame events are sent after regular pointer events to group - * multiple events together. For instance, two axis events may happen at the - * same time, in which case a frame event won't be sent in between. */ - struct montis_server *server = - wl_container_of(listener, server, cursor_frame); - /* Notify the client with pointer focus of the frame event. */ - wlr_seat_pointer_notify_frame(server->seat); -} - -static void output_frame(struct wl_listener *listener, void *data) -{ - /* This function is called every time an output is ready to display a frame, - * generally at the output's refresh rate (e.g. 60Hz). */ - struct montis_output *output = wl_container_of(listener, output, frame); - struct wlr_scene *scene = output->server->scene; - - struct wlr_scene_output *scene_output = - wlr_scene_get_scene_output(scene, output->wlr_output); - - /* Render the scene if needed and commit the output */ - wlr_scene_output_commit(scene_output, NULL); - - struct timespec now; - clock_gettime(CLOCK_MONOTONIC, &now); - wlr_scene_output_send_frame_done(scene_output, &now); -} - -static void output_request_state(struct wl_listener *listener, void *data) -{ - /* This function is called when the backend requests a new state for - * the output. For example, Wayland and X11 backends request a new mode - * when the output window is resized. */ - struct montis_output *output = - wl_container_of(listener, output, request_state); - const struct wlr_output_event_request_state *event = data; - wlr_output_commit_state(output->wlr_output, event->state); -} - -static void output_destroy(struct wl_listener *listener, void *data) -{ - struct montis_output *output = wl_container_of(listener, output, destroy); - - wl_list_remove(&output->frame.link); - wl_list_remove(&output->request_state.link); - wl_list_remove(&output->destroy.link); - wl_list_remove(&output->link); - free(output); -} - -static void server_new_output(struct wl_listener *listener, void *data) -{ - /* This event is raised by the backend when a new output (aka a display or - * monitor) becomes available. */ - struct montis_server *server = wl_container_of(listener, server, new_output); - struct wlr_output *wlr_output = data; - - /* Configures the output created by the backend to use our allocator - * and our renderer. Must be done once, before commiting the output */ - wlr_output_init_render(wlr_output, server->allocator, server->renderer); - - /* The output may be disabled, switch it on. */ - struct wlr_output_state state; - wlr_output_state_init(&state); - wlr_output_state_set_enabled(&state, true); - - /* Some backends don't have modes. DRM+KMS does, and we need to set a mode - * before we can use the output. The mode is a tuple of (width, height, - * refresh rate), and each monitor supports only a specific set of modes. We - * just pick the monitor's preferred mode, a more sophisticated compositor - * would let the user configure it. */ - struct wlr_output_mode *mode = wlr_output_preferred_mode(wlr_output); - if (mode != NULL) { - wlr_output_state_set_mode(&state, mode); - } - - /* Atomically applies the new output state. */ - wlr_output_commit_state(wlr_output, &state); - wlr_output_state_finish(&state); - - /* Allocates and configures our state for this output */ - struct montis_output *output = calloc(1, sizeof(*output)); - output->wlr_output = wlr_output; - output->server = server; - - /* Sets up a listener for the frame event. */ - output->frame.notify = output_frame; - wl_signal_add(&wlr_output->events.frame, &output->frame); - - /* Sets up a listener for the state request event. */ - output->request_state.notify = output_request_state; - wl_signal_add(&wlr_output->events.request_state, &output->request_state); - - /* Sets up a listener for the destroy event. */ - output->destroy.notify = output_destroy; - wl_signal_add(&wlr_output->events.destroy, &output->destroy); - - wl_list_insert(&server->outputs, &output->link); - - /* Adds this to the output layout. The add_auto function arranges outputs - * from left-to-right in the order they appear. A more sophisticated - * compositor would let the user configure the arrangement of outputs in the - * layout. - * - * The output layout utility automatically adds a wl_output global to the - * display, which Wayland clients can see to find out information about the - * output (such as DPI, scale factor, manufacturer, etc). - */ - struct wlr_output_layout_output *l_output = - wlr_output_layout_add_auto(server->output_layout, wlr_output); - struct wlr_scene_output *scene_output = - wlr_scene_output_create(server->scene, wlr_output); - wlr_scene_output_layout_add_output(server->scene_layout, l_output, - scene_output); -} - -static void xdg_toplevel_map(struct wl_listener *listener, void *data) -{ - /* Called when the surface is mapped, or ready to display on-screen. */ - struct montis_toplevel *toplevel = wl_container_of(listener, toplevel, map); - - wl_list_insert(&toplevel->server->toplevels, &toplevel->link); - - fprintf(stderr, "Surface map ...\n"); - plugin_call_update_state(toplevel->server->plugin, plugin_handle_surface, - toplevel, SURFACE_MAP); - fprintf(stderr, "/ Surface map ...\n"); - - focus_toplevel(toplevel, toplevel->xdg_toplevel->base->surface); -} - -static void xdg_toplevel_unmap(struct wl_listener *listener, void *data) -{ - /* Called when the surface is unmapped, and should no longer be shown. */ - struct montis_toplevel *toplevel = wl_container_of(listener, toplevel, unmap); - - /* Reset the cursor mode if the grabbed toplevel was unmapped. */ - if (toplevel == toplevel->server->grabbed_toplevel) { - reset_cursor_mode(toplevel->server); - } - - fprintf(stderr, "Surface unmap ...\n"); - plugin_call_update_state(toplevel->server->plugin, plugin_handle_surface, - toplevel, SURFACE_UNMAP); - fprintf(stderr, "/ Surface map ...\n"); - - wl_list_remove(&toplevel->link); -} - -static void xdg_toplevel_destroy(struct wl_listener *listener, void *data) -{ - /* Called when the xdg_toplevel is destroyed. */ - struct montis_toplevel *toplevel = - wl_container_of(listener, toplevel, destroy); - - wl_list_remove(&toplevel->map.link); - wl_list_remove(&toplevel->unmap.link); - wl_list_remove(&toplevel->destroy.link); - wl_list_remove(&toplevel->request_move.link); - wl_list_remove(&toplevel->request_resize.link); - wl_list_remove(&toplevel->request_maximize.link); - wl_list_remove(&toplevel->request_fullscreen.link); - - fprintf(stderr, "Surface destroy ...\n"); - plugin_call_update_state(toplevel->server->plugin, plugin_handle_surface, - toplevel, SURFACE_DELETE); - fprintf(stderr, "/ Surface destroy ...\n"); - - free(toplevel); -} - -static void begin_interactive(struct montis_toplevel *toplevel, - enum montis_cursor_mode mode, uint32_t edges) -{ - /* This function sets up an interactive move or resize operation, where the - * compositor stops propegating pointer events to clients and instead - * consumes them itself, to move or resize windows. */ - struct montis_server *server = toplevel->server; - struct wlr_surface *focused_surface = - server->seat->pointer_state.focused_surface; - if (toplevel->xdg_toplevel->base->surface != - wlr_surface_get_root_surface(focused_surface)) { - /* Deny move/resize requests from unfocused clients. */ - return; - } - server->grabbed_toplevel = toplevel; - server->cursor_mode = mode; - - if (mode == TINYWL_CURSOR_MOVE) { - server->grab_x = server->cursor->x - toplevel->scene_tree->node.x; - server->grab_y = server->cursor->y - toplevel->scene_tree->node.y; - } - else { - struct wlr_box geo_box; - wlr_xdg_surface_get_geometry(toplevel->xdg_toplevel->base, &geo_box); - - double border_x = (toplevel->scene_tree->node.x + geo_box.x) + - ((edges & WLR_EDGE_RIGHT) ? geo_box.width : 0); - double border_y = (toplevel->scene_tree->node.y + geo_box.y) + - ((edges & WLR_EDGE_BOTTOM) ? geo_box.height : 0); - server->grab_x = server->cursor->x - border_x; - server->grab_y = server->cursor->y - border_y; - - server->grab_geobox = geo_box; - server->grab_geobox.x += toplevel->scene_tree->node.x; - server->grab_geobox.y += toplevel->scene_tree->node.y; - - server->resize_edges = edges; - } -} - -static void xdg_toplevel_request_move(struct wl_listener *listener, void *data) -{ - /* This event is raised when a client would like to begin an interactive - * move, typically because the user clicked on their client-side - * decorations. Note that a more sophisticated compositor should check the - * provided serial against a list of button press serials sent to this - * client, to prevent the client from requesting this whenever they want. */ - struct montis_toplevel *toplevel = - wl_container_of(listener, toplevel, request_move); - begin_interactive(toplevel, TINYWL_CURSOR_MOVE, 0); -} - -static void xdg_toplevel_request_resize(struct wl_listener *listener, - void *data) -{ - /* This event is raised when a client would like to begin an interactive - * resize, typically because the user clicked on their client-side - * decorations. Note that a more sophisticated compositor should check the - * provided serial against a list of button press serials sent to this - * client, to prevent the client from requesting this whenever they want. */ - struct wlr_xdg_toplevel_resize_event *event = data; - struct montis_toplevel *toplevel = - wl_container_of(listener, toplevel, request_resize); - begin_interactive(toplevel, TINYWL_CURSOR_RESIZE, event->edges); -} - -static void xdg_toplevel_request_maximize(struct wl_listener *listener, - void *data) -{ - /* This event is raised when a client would like to maximize itself, - * typically because the user clicked on the maximize button on - * client-side decorations. montis doesn't support maximization, but - * to conform to xdg-shell protocol we still must send a configure. - * wlr_xdg_surface_schedule_configure() is used to send an empty reply. */ - struct montis_toplevel *toplevel = - wl_container_of(listener, toplevel, request_maximize); - wlr_xdg_surface_schedule_configure(toplevel->xdg_toplevel->base); -} - -static void xdg_toplevel_request_fullscreen(struct wl_listener *listener, - void *data) -{ - /* Just as with request_maximize, we must send a configure here. */ - struct montis_toplevel *toplevel = - wl_container_of(listener, toplevel, request_fullscreen); - wlr_xdg_surface_schedule_configure(toplevel->xdg_toplevel->base); -} - -static void xdg_popup_commit(struct wl_listener *listener, void *data) -{ - /* Called when a new surface state is committed. */ - struct montis_popup *popup = wl_container_of(listener, popup, commit); - - if (popup->xdg_popup->base->initial_commit) { - /* When an xdg_surface performs an initial commit, the compositor must - * reply with a configure so the client can map the surface. - * montis sends an empty configure. A more sophisticated compositor - * might change an xdg_popup's geometry to ensure it's not positioned - * off-screen, for example. */ - wlr_xdg_surface_schedule_configure(popup->xdg_popup->base); - } -} - -static void xdg_popup_destroy(struct wl_listener *listener, void *data) -{ - /* Called when the xdg_popup is destroyed. */ - struct montis_popup *popup = wl_container_of(listener, popup, destroy); - - wl_list_remove(&popup->commit.link); - wl_list_remove(&popup->destroy.link); - - free(popup); -} - -static void server_new_xdg_popup(struct wl_listener *listener, void *data) -{ - /* This event is raised when a client creates a new popup. */ - struct wlr_xdg_popup *xdg_popup = data; - - struct montis_popup *popup = calloc(1, sizeof(*popup)); - popup->xdg_popup = xdg_popup; - - /* We must add xdg popups to the scene graph so they get rendered. The - * wlroots scene graph provides a helper for this, but to use it we must - * provide the proper parent scene node of the xdg popup. To enable this, - * we always set the user data field of xdg_surfaces to the corresponding - * scene node. */ - struct wlr_xdg_surface *parent = - wlr_xdg_surface_try_from_wlr_surface(xdg_popup->parent); - assert(parent != NULL); - struct wlr_scene_tree *parent_tree = parent->data; - xdg_popup->base->data = - wlr_scene_xdg_surface_create(parent_tree, xdg_popup->base); - - popup->commit.notify = xdg_popup_commit; - wl_signal_add(&xdg_popup->base->surface->events.commit, &popup->commit); - - popup->destroy.notify = xdg_popup_destroy; - wl_signal_add(&xdg_popup->events.destroy, &popup->destroy); -} - -static void xdg_decoration_request_mode(struct wl_listener *listener, - void *data) -{ - /* Clients can request a decoration mode; we always enforce server-side. */ - struct montis_xdg_decoration *dec = - wl_container_of(listener, dec, request_mode); - wlr_xdg_toplevel_decoration_v1_set_mode( - dec->decoration, WLR_XDG_TOPLEVEL_DECORATION_V1_MODE_SERVER_SIDE); -} - -static void xdg_decoration_destroy(struct wl_listener *listener, void *data) -{ - struct montis_xdg_decoration *dec = - wl_container_of(listener, dec, destroy); - wl_list_remove(&dec->request_mode.link); - wl_list_remove(&dec->destroy.link); - free(dec); -} - -static void server_new_xdg_decoration(struct wl_listener *listener, void *data) -{ - /* Force server-side decorations to disable client-side frames. */ - struct wlr_xdg_toplevel_decoration_v1 *decoration = data; - struct montis_xdg_decoration *dec = calloc(1, sizeof(*dec)); - dec->decoration = decoration; - - dec->request_mode.notify = xdg_decoration_request_mode; - wl_signal_add(&decoration->events.request_mode, &dec->request_mode); - dec->destroy.notify = xdg_decoration_destroy; - wl_signal_add(&decoration->events.destroy, &dec->destroy); - - wlr_xdg_toplevel_decoration_v1_set_mode( - decoration, WLR_XDG_TOPLEVEL_DECORATION_V1_MODE_SERVER_SIDE); -} - -static void xdg_toplevel_commit(struct wl_listener *listener, void *data) -{ - /* Called when a new surface state is committed. */ - struct montis_toplevel *toplevel = - wl_container_of(listener, toplevel, commit); - - if (toplevel->xdg_toplevel->base->initial_commit) { - /* When an xdg_surface performs an initial commit, the compositor must - * reply with a configure so the client can map the surface. montis - * configures the xdg_toplevel with 0,0 size to let the client pick the - * dimensions itself. */ - wlr_xdg_toplevel_set_size(toplevel->xdg_toplevel, 0, 0); - } -} - -static void server_new_xdg_toplevel(struct wl_listener *listener, void *data) -{ - /* This event is raised when a client creates a new toplevel (application - * window). */ - struct montis_server *server = - wl_container_of(listener, server, new_xdg_toplevel); - struct wlr_xdg_toplevel *xdg_toplevel = data; - - /* Allocate a montis_toplevel for this surface */ - struct montis_toplevel *toplevel = calloc(1, sizeof(*toplevel)); - toplevel->server = server; - toplevel->xdg_toplevel = xdg_toplevel; - toplevel->scene_tree = wlr_scene_xdg_surface_create( - &toplevel->server->scene->tree, xdg_toplevel->base); - toplevel->scene_tree->node.data = toplevel; - xdg_toplevel->base->data = toplevel->scene_tree; - - /* Listen to the various events it can emit */ - toplevel->map.notify = xdg_toplevel_map; - wl_signal_add(&xdg_toplevel->base->surface->events.map, &toplevel->map); - toplevel->unmap.notify = xdg_toplevel_unmap; - wl_signal_add(&xdg_toplevel->base->surface->events.unmap, &toplevel->unmap); - toplevel->commit.notify = xdg_toplevel_commit; - wl_signal_add(&xdg_toplevel->base->surface->events.commit, &toplevel->commit); - - toplevel->destroy.notify = xdg_toplevel_destroy; - wl_signal_add(&xdg_toplevel->events.destroy, &toplevel->destroy); - - /* cotd */ - toplevel->request_move.notify = xdg_toplevel_request_move; - wl_signal_add(&xdg_toplevel->events.request_move, &toplevel->request_move); - toplevel->request_resize.notify = xdg_toplevel_request_resize; - wl_signal_add(&xdg_toplevel->events.request_resize, - &toplevel->request_resize); - toplevel->request_maximize.notify = xdg_toplevel_request_maximize; - wl_signal_add(&xdg_toplevel->events.request_maximize, - &toplevel->request_maximize); - toplevel->request_fullscreen.notify = xdg_toplevel_request_fullscreen; - wl_signal_add(&xdg_toplevel->events.request_fullscreen, - &toplevel->request_fullscreen); -} - -int main(int argc, char *argv[]) -{ - wlr_log_init(WLR_DEBUG, NULL); - char *startup_cmd = NULL; - char *plugin = NULL; - - int c; - while ((c = getopt(argc, argv, "s:p:h")) != -1) { - switch (c) { - case 's': - startup_cmd = optarg; - break; - case 'p': - plugin = optarg; - break; - default: - printf("Usage: %s -p [plugin] [-s startup command]\n", argv[0]); - return 0; - } - } - if (optind < argc || !plugin) { - printf("Usage: %s -p [plugin] [-s startup command]\n", argv[0]); - return 0; - } - - struct montis_server server = {0}; - - if (load_plugin_from_file(argc, argv, plugin, &server.plugin)) { - fprintf(stderr, "Failed to read plugin from file.\n"); - return 1; - } - - plugin_cold_start(&server.plugin); - - /* The Wayland display is managed by libwayland. It handles accepting - * clients from the Unix socket, manging Wayland globals, and so on. */ - server.wl_display = wl_display_create(); - /* The backend is a wlroots feature which abstracts the underlying input and - * output hardware. The autocreate option will choose the most suitable - * backend based on the current environment, such as opening an X11 window - * if an X11 server is running. */ - server.backend = wlr_backend_autocreate( - wl_display_get_event_loop(server.wl_display), &server.session); - if (server.backend == NULL) { - wlr_log(WLR_ERROR, "failed to create wlr_backend"); - return 1; - } - - /* Autocreates a renderer, either Pixman, GLES2 or Vulkan for us. The user - * can also specify a renderer using the WLR_RENDERER env var. - * The renderer is responsible for defining the various pixel formats it - * supports for shared memory, this configures that for clients. */ - server.renderer = wlr_renderer_autocreate(server.backend); - if (server.renderer == NULL) { - wlr_log(WLR_ERROR, "failed to create wlr_renderer"); - return 1; - } - - wlr_renderer_init_wl_display(server.renderer, server.wl_display); - - /* Autocreates an allocator for us. - * The allocator is the bridge between the renderer and the backend. It - * handles the buffer creation, allowing wlroots to render onto the - * screen */ - server.allocator = wlr_allocator_autocreate(server.backend, server.renderer); - if (server.allocator == NULL) { - wlr_log(WLR_ERROR, "failed to create wlr_allocator"); - return 1; - } - - /* This creates some hands-off wlroots interfaces. The compositor is - * necessary for clients to allocate surfaces, the subcompositor allows to - * assign the role of subsurfaces to surfaces and the data device manager - * handles the clipboard. Each of these wlroots interfaces has room for you - * to dig your fingers in and play with their behavior if you want. Note that - * the clients cannot set the selection directly without compositor approval, - * see the handling of the request_set_selection event below.*/ - wlr_compositor_create(server.wl_display, 5, server.renderer); - wlr_subcompositor_create(server.wl_display); - wlr_data_device_manager_create(server.wl_display); - - /* Creates an output layout, which a wlroots utility for working with an - * arrangement of screens in a physical layout. */ - server.output_layout = wlr_output_layout_create(server.wl_display); - - /* Configure a listener to be notified when new outputs are available on the - * backend. */ - wl_list_init(&server.outputs); - server.new_output.notify = server_new_output; - wl_signal_add(&server.backend->events.new_output, &server.new_output); - - /* Create a scene graph. This is a wlroots abstraction that handles all - * rendering and damage tracking. All the compositor author needs to do - * is add things that should be rendered to the scene graph at the proper - * positions and then call wlr_scene_output_commit() to render a frame if - * necessary. - */ - server.scene = wlr_scene_create(); - server.scene_layout = - wlr_scene_attach_output_layout(server.scene, server.output_layout); - - /* Set up xdg-shell version 3. The xdg-shell is a Wayland protocol which is - * used for application windows. For more detail on shells, refer to - * https://drewdevault.com/2018/07/29/Wayland-shells.html. - */ - wl_list_init(&server.toplevels); - server.xdg_shell = wlr_xdg_shell_create(server.wl_display, 3); - server.new_xdg_toplevel.notify = server_new_xdg_toplevel; - wl_signal_add(&server.xdg_shell->events.new_toplevel, - &server.new_xdg_toplevel); - server.new_xdg_popup.notify = server_new_xdg_popup; - wl_signal_add(&server.xdg_shell->events.new_popup, &server.new_xdg_popup); - - /* Request server-side decorations for xdg-toplevel surfaces. */ - server.xdg_decoration_manager = - wlr_xdg_decoration_manager_v1_create(server.wl_display); - if (server.xdg_decoration_manager != NULL) { - server.new_xdg_decoration.notify = server_new_xdg_decoration; - wl_signal_add( - &server.xdg_decoration_manager->events.new_toplevel_decoration, - &server.new_xdg_decoration); - } - - /* - * Creates a cursor, which is a wlroots utility for tracking the cursor - * image shown on screen. - */ - server.cursor = wlr_cursor_create(); - wlr_cursor_attach_output_layout(server.cursor, server.output_layout); - - /* Creates an xcursor manager, another wlroots utility which loads up - * Xcursor themes to source cursor images from and makes sure that cursor - * images are available at all scale factors on the screen (necessary for - * HiDPI support). */ - server.cursor_mgr = wlr_xcursor_manager_create(NULL, 24); - - /* - * wlr_cursor *only* displays an image on screen. It does not move around - * when the pointer moves. However, we can attach input devices to it, and - * it will generate aggregate events for all of them. In these events, we - * can choose how we want to process them, forwarding them to clients and - * moving the cursor around. More detail on this process is described in - * https://drewdevault.com/2018/07/17/Input-handling-in-wlroots.html. - * - * And more comments are sprinkled throughout the notify functions above. - */ - server.cursor_mode = TINYWL_CURSOR_PASSTHROUGH; - server.cursor_motion.notify = server_cursor_motion; - wl_signal_add(&server.cursor->events.motion, &server.cursor_motion); - server.cursor_motion_absolute.notify = server_cursor_motion_absolute; - wl_signal_add(&server.cursor->events.motion_absolute, - &server.cursor_motion_absolute); - server.cursor_button.notify = server_cursor_button; - wl_signal_add(&server.cursor->events.button, &server.cursor_button); - server.cursor_axis.notify = server_cursor_axis; - wl_signal_add(&server.cursor->events.axis, &server.cursor_axis); - server.cursor_frame.notify = server_cursor_frame; - wl_signal_add(&server.cursor->events.frame, &server.cursor_frame); - - /* - * Configures a seat, which is a single "seat" at which a user sits and - * operates the computer. This conceptually includes up to one keyboard, - * pointer, touch, and drawing tablet device. We also rig up a listener to - * let us know when new input devices are available on the backend. - */ - wl_list_init(&server.keyboards); - server.new_input.notify = server_new_input; - wl_signal_add(&server.backend->events.new_input, &server.new_input); - server.seat = wlr_seat_create(server.wl_display, "seat0"); - server.request_cursor.notify = seat_request_cursor; - wl_signal_add(&server.seat->events.request_set_cursor, - &server.request_cursor); - server.request_set_selection.notify = seat_request_set_selection; - wl_signal_add(&server.seat->events.request_set_selection, - &server.request_set_selection); - - /* Add a Unix socket to the Wayland display. */ - const char *socket = wl_display_add_socket_auto(server.wl_display); - if (!socket) { - wlr_backend_destroy(server.backend); - return 1; - } - - /* Start the backend. This will enumerate outputs and inputs, become the DRM - * master, etc */ - if (!wlr_backend_start(server.backend)) { - wlr_backend_destroy(server.backend); - wl_display_destroy(server.wl_display); - return 1; - } - - /* Set the WAYLAND_DISPLAY environment variable to our socket and run the - * startup command if requested. */ - setenv("WAYLAND_DISPLAY", socket, true); - if (startup_cmd) { - if (fork() == 0) { - execl("/bin/sh", "/bin/sh", "-c", startup_cmd, (void *)NULL); - } - } - /* Run the Wayland event loop. This does not return until you exit the - * compositor. Starting the backend rigged up all of the necessary event - * loop configuration to listen to libinput events, DRM events, generate - * frame events at the refresh rate, and so on. */ - wlr_log(WLR_INFO, "Running Wayland compositor on WAYLAND_DISPLAY=%s", socket); - wl_display_run(server.wl_display); - - /* Once wl_display_run returns, we destroy all clients then shut down the - * server. */ - wl_display_destroy_clients(server.wl_display); - wlr_scene_node_destroy(&server.scene->tree.node); - wlr_xcursor_manager_destroy(server.cursor_mgr); - wlr_output_layout_destroy(server.output_layout); - wl_display_destroy(server.wl_display); - return 0; -} diff --git a/rt/tools/genbuild.pl b/rt/tools/genbuild.pl deleted file mode 100644 index 1acabc0..0000000 --- a/rt/tools/genbuild.pl +++ /dev/null @@ -1,48 +0,0 @@ -#!/usr/bin/env perl - -$comment=""; - -print "#include \n"; -print "#include \n"; -print "#include \n"; -print "#include \n"; -print "#include \"plugin.h\"\n\n"; - -print "int load_plugin_from_dl_(dlhandle_t dl, plugin_t* plug)\n"; -print "{\n"; -print " void* ptr;\n"; -print " int ret = 0;\n"; -print "\n"; -print " const char** name = dlsym(dl, \"plugin_name\");\n"; -print " memset(plug, 0, sizeof(*plug));\n"; -print " if (name) {\n"; -print " plug->plugin_name = *name;\n"; -print " } else {\n"; -print " plug->plugin_name = NULL;\n"; -print " }\n"; -print " plug->state = NULL;\n"; -print " plug->library_handle = dl;\n"; -print "\n"; -while (<>) { - if (/^\s*EXPORT/) { - my $line = "$_"; - while (not ($line =~ /;$/)) { - my $nextline = ; - last unless defined $nextline; - - $line="$line$nextline"; - } - if ($line =~ /^\s*EXPORT\(\s*((?:\w|\s*\*\s*)+)\s*\(\*(\w+)\)\s*\((.*)\)\);/s) { - print "\n"; - print " ptr = dlsym(dl, \"$2\");\n"; - print " if (!ptr) {\n"; - print " fprintf(stderr, \"Plugin missing %s\\n\", \"$2\");\n"; - print " ret |= 1;\n"; - print " }\n"; - print " plug->$2 = ptr;\n"; - $comment=""; - } - } -} -print "\n return ret;\n"; -print "}\n"; diff --git a/rt/tools/genintf.pl b/rt/tools/genintf.pl deleted file mode 100644 index 794f966..0000000 --- a/rt/tools/genintf.pl +++ /dev/null @@ -1,42 +0,0 @@ -#!/usr/bin/env perl - -$comment=""; - -print "#ifndef _PLUG_INTF\n"; -print "#define _PLUG_INTF\n"; -print "\n#include \n"; -print "\n#include \n"; - -while () { - if (/^\s*\/\*/) { - $_ =~ s/^\s*//; - $comment="$_"; - next; - } - - if (/^\s*\*/) { - $_ =~ s/^\s*/ /; - $comment="$comment$_"; - next; - } - - if (/^\s*EXPORT_INCLUDE\((.*)\)/) { - print "#include $1\n"; - } elsif (/^\s*EXPORT/) { - my $line = "$_"; - while (not ($line =~ /;$/)) { - my $nextline = ; - last unless defined $nextline; - - $line="$line$nextline"; - } - if ($line =~ /^\s*EXPORT\(\s*((?:\w|\s*\*\s*)+)\s*\(\*(\w+)\)\s*\((.*)\)\);/s) { - print "$comment"; - print "$1 $2($3);\n\n"; - $comment=""; - } elsif ($line =~ /^\s*EXPORT\((.*)\);/s) { - print "$1\n"; - } - } -} -print "#endif /* _PLUG_INTF */\n"; -- cgit