diff options
| -rw-r--r-- | .gitignore | 2 | ||||
| -rw-r--r-- | CMakeLists.txt | 86 | ||||
| -rw-r--r-- | Makefile | 34 | ||||
| -rw-r--r-- | README.md | 206 | ||||
| -rw-r--r-- | ark/CMakeLists.txt | 134 | ||||
| -rw-r--r-- | ark/README.md | 51 | ||||
| -rw-r--r-- | ark/include/soul.h | 111 | ||||
| -rw-r--r-- | ark/include/soul_exports.h | 117 | ||||
| -rw-r--r-- | ark/include/soul_interface.h | 23 | ||||
| -rw-r--r-- | ark/include/soul_types.h (renamed from rt/include/plugin_types.h) | 0 | ||||
| -rw-r--r-- | ark/include/wl.h (renamed from rt/include/wl.h) | 4 | ||||
| -rw-r--r-- | ark/src/soul.c | 198 | ||||
| -rw-r--r-- | ark/src/soul_load.c | 39 | ||||
| -rw-r--r-- | ark/src/wl.c (renamed from rt/src/wl.c) | 86 | ||||
| -rw-r--r-- | cross/CMakeLists.txt | 27 | ||||
| -rw-r--r-- | cross/README.md | 32 | ||||
| -rw-r--r-- | cross/include/util.h | 24 | ||||
| -rw-r--r-- | cross/src/runtime_requests.c | 69 | ||||
| -rw-r--r-- | cross/src/util.c (renamed from rt/src/util.c) | 20 | ||||
| -rw-r--r-- | montis/README.md | 40 | ||||
| -rw-r--r-- | montis/package.yaml (renamed from plug/package.yaml) | 7 | ||||
| -rw-r--r-- | montis/src/Config.hs | 27 | ||||
| -rw-r--r-- | montis/src/Link.hs | 18 | ||||
| -rw-r--r-- | montis/src/Montis/Base/Foreign/Runtime.hs (renamed from plug/src/Montis/Base/Foreign/Runtime.hs) | 16 | ||||
| -rw-r--r-- | montis/src/Montis/Base/Foreign/WlRoots.hs (renamed from plug/src/Montis/Base/Foreign/WlRoots.hs) | 0 | ||||
| -rw-r--r-- | montis/src/Montis/Base/Foreign/WlRoots/Types.hs (renamed from plug/src/Montis/Base/Foreign/WlRoots/Types.hs) | 0 | ||||
| -rw-r--r-- | montis/src/Montis/Core.hs (renamed from plug/src/Montis/Core.hs) | 1 | ||||
| -rw-r--r-- | montis/src/Montis/Core/Events.hs (renamed from plug/src/Montis/Core/Events.hs) | 0 | ||||
| -rw-r--r-- | montis/src/Montis/Core/Extensions.hs (renamed from plug/src/Montis/Core/Extensions.hs) | 0 | ||||
| -rw-r--r-- | montis/src/Montis/Core/Internal/Foreign/Export.hs (renamed from plug/src/Montis/Core/Internal/Foreign/Export.hs) | 100 | ||||
| -rw-r--r-- | montis/src/Montis/Core/Monad.hs (renamed from plug/src/Montis/Core/Monad.hs) | 10 | ||||
| -rw-r--r-- | montis/src/Montis/Core/Runtime.hs | 88 | ||||
| -rw-r--r-- | montis/src/Montis/Core/Soul/Interface.hs (renamed from plug/src/Montis/Core/Plugin/Interface.hs) | 4 | ||||
| -rw-r--r-- | montis/src/Montis/Core/Start.hs (renamed from plug/src/Montis/Core/Start.hs) | 0 | ||||
| -rw-r--r-- | montis/src/Montis/Core/State.hs (renamed from plug/src/Montis/Core/State.hs) | 4 | ||||
| -rw-r--r-- | montis/src/Montis/Core/State/Marshal.hs (renamed from plug/src/Montis/Core/State/Marshal.hs) | 0 | ||||
| -rw-r--r-- | montis/src/Montis/Foreign/Marshal.hs (renamed from plug/src/Montis/Foreign/Marshal.hs) | 0 | ||||
| -rw-r--r-- | montis/src/Montis/Standard/Drag.hs | 123 | ||||
| -rw-r--r-- | montis/src/Montis/Standard/Keys.hs (renamed from plug/src/Montis/Standard/Keys.hs) | 34 | ||||
| -rw-r--r-- | montis/src/Montis/Standard/Keys/Dsl.hs | 85 | ||||
| -rw-r--r-- | montis/src/Montis/Standard/Mouse.hs (renamed from plug/src/Montis/Standard/Mouse.hs) | 18 | ||||
| -rw-r--r-- | montis/src/harness_adapter.c (renamed from plug/src/harness_adapter.c) | 16 | ||||
| -rw-r--r-- | montis/stack.yaml (renamed from plug/stack.yaml) | 0 | ||||
| -rw-r--r-- | montis/test/Spec.hs (renamed from plug/test/Spec.hs) | 0 | ||||
| -rw-r--r-- | plug/README.md | 1 | ||||
| -rw-r--r-- | plug/src/Config.hs | 46 | ||||
| -rw-r--r-- | plug/src/Montis/Standard/Drag.hs | 160 | ||||
| -rw-r--r-- | rt/CMakeLists.txt | 149 | ||||
| -rw-r--r-- | rt/include/plugin.h | 190 | ||||
| -rw-r--r-- | rt/include/util.h | 19 | ||||
| -rw-r--r-- | rt/src/plugin.c | 260 | ||||
| -rw-r--r-- | rt/tools/genbuild.pl | 48 | ||||
| -rw-r--r-- | rt/tools/genintf.pl | 42 |
53 files changed, 1622 insertions, 1147 deletions
@@ -1,4 +1,4 @@ -plug/.stack-work +montis/.stack-work *~ harness/build wtr.so diff --git a/CMakeLists.txt b/CMakeLists.txt index 18348ae..b4921ce 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,43 +1,51 @@ cmake_minimum_required(VERSION 3.16) project(montis LANGUAGES C) -add_custom_target(wlroots_build ALL DEPENDS "${WLROOTS_LIB_LINK}") - -add_subdirectory(rt) -add_dependencies(montis 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 "${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 - # 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 - 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; \"$<TARGET_FILE:montis>\" -s foot -p \"$PLUGIN_SO\"" - DEPENDS montis plug_build - USES_TERMINAL - VERBATIM -) - - -install(TARGETS montis RUNTIME DESTINATION bin) - -install(CODE [[ - execute_process( - COMMAND sh -c "find '${CMAKE_BINARY_DIR}/stack-work' -name montis.so -type f | head -n 1" - OUTPUT_VARIABLE _montis_so - OUTPUT_STRIP_TRAILING_WHITESPACE +option(MONTIS_BUILD_BUNDLED_SOUL "Build the bundled Haskell soul (montis.so)" ON) +if(DEFINED MONTIS_BUILD_BUNDLED_PLUGIN) + set(MONTIS_BUILD_BUNDLED_SOUL "${MONTIS_BUILD_BUNDLED_PLUGIN}") +endif() + +add_subdirectory(ark) + +add_subdirectory(cross) + +if(MONTIS_BUILD_BUNDLED_SOUL) + add_custom_target( + soul_build ALL + 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}/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}/montis/a.out" + DEPENDS ark cross + COMMENT "Building bundled Haskell soul with Stack" + VERBATIM + ) + + add_custom_target( + run + COMMAND sh -c "SOUL_SO=$(find '${CMAKE_BINARY_DIR}/stack-work' -name montis.so -type f | head -n 1); if [ -z \"$SOUL_SO\" ]; then echo 'montis.so not found in ${CMAKE_BINARY_DIR}/stack-work' 1>&2; exit 1; fi; \"$<TARGET_FILE:ark>\" -s foot -p \"$SOUL_SO\"" + DEPENDS ark soul_build + USES_TERMINAL + VERBATIM ) - if(NOT _montis_so) - message(FATAL_ERROR "montis.so not found in ${CMAKE_BINARY_DIR}/stack-work") - endif() - file(INSTALL DESTINATION "${CMAKE_INSTALL_PREFIX}/lib" TYPE FILE FILES "${_montis_so}") -]]) +endif() + + +install(TARGETS ark RUNTIME DESTINATION bin) + +if(MONTIS_BUILD_BUNDLED_SOUL) + install(CODE [[ + execute_process( + COMMAND sh -c "find '${CMAKE_BINARY_DIR}/stack-work' -name montis.so -type f | head -n 1" + OUTPUT_VARIABLE _montis_so + OUTPUT_STRIP_TRAILING_WHITESPACE + ) + if(NOT _montis_so) + message(FATAL_ERROR "montis.so not found in ${CMAKE_BINARY_DIR}/stack-work") + endif() + file(INSTALL DESTINATION "${CMAKE_INSTALL_PREFIX}/lib" TYPE FILE FILES "${_montis_so}") + ]]) +endif() diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..d814302 --- /dev/null +++ b/Makefile @@ -0,0 +1,34 @@ +.PHONY: all configure build ark cross soul run install clean distclean + +BUILD_DIR ?= build +BUILD_TYPE ?= Debug +PREFIX ?= $(HOME)/.local + +all: build + +configure: + cmake -S . -B $(BUILD_DIR) -DCMAKE_BUILD_TYPE=$(BUILD_TYPE) $(CMAKE_ARGS) + +build: configure + cmake --build $(BUILD_DIR) + +ark: configure + cmake --build $(BUILD_DIR) --target ark + +cross: configure + cmake --build $(BUILD_DIR) --target cross + +soul: configure + cmake --build $(BUILD_DIR) --target soul_build + +run: configure + cmake --build $(BUILD_DIR) --target run + +install: configure + cmake --install $(BUILD_DIR) --prefix $(PREFIX) + +clean: + cmake --build $(BUILD_DIR) --target clean + +distclean: + rm -rf $(BUILD_DIR) @@ -1,44 +1,162 @@ -# 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. + +### Ark -- The Runtime + +**Ark** 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 across reload. +* It is deliberately lean: a harness, not an engine + +Ark 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 Ark 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 Ark +runtime and wlroots itself. + +#### Cross -- Native Bridge Library + +**Cross** (`libcross.a`) is a static C library that contains the native +functions Montis uses to interact with Ark/wlroots. It is linked into the +`montis.so` soul so these FFI bindings hot-reload along with the Haskell code +instead of living inside the long-running compositor process. + +Code lives in `cross/src` and headers in `cross/include` (notably +`cross/include/util.h`). + +### 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 (Ark) that owns wlroots and the Wayland lifecycle +* A hot-reloadable window manager (Montis) that owns behavior + +## Building + +### Prerequisites + +- `cmake` +- A C toolchain (`cc`, `ld`, etc.) +- `pkg-config` +- wlroots build deps via your distro (Wayland, xkbcommon, libinput, pixman, etc.) +- `meson` (wlroots is built via Meson) and a backend like `ninja` +- `wayland-scanner` and `wayland-protocols` +- `curl` (first build downloads wlroots) +- Optional (only for the bundled soul): Haskell toolchain via Stack: `stack` (+ GHC) + +### Build + +This repo uses CMake to build: +- `ark` (the compositor runtime) +- `cross` (`libcross.a`) +- the bundled Haskell soul (`montis.so`) via Stack + +```sh +make build +``` + +To build only the runtime + bridge library (no bundled soul): + +```sh +make BUILD_DIR=build BUILD_TYPE=Debug CMAKE_ARGS=-DMONTIS_BUILD_BUNDLED_SOUL=OFF build +``` + +To run via the CMake helper target: + +```sh +make run +``` + +Note: the `run` target currently starts `ark` with `-s foot`, so you’ll want +`foot` installed (or adjust the target in `CMakeLists.txt`). + +### Using Your Own Soul + +If you disable the bundled soul (`-DMONTIS_BUILD_BUNDLED_SOUL=OFF`), you can +build and supply your own soul `.so` at runtime. + +- Soul ABI: `ark/include/soul.h` (soul header: `ark/include/soul_interface.h`) +- Optional bridge helpers: `cross/include` + `build/cross/libcross.a` + +Runtime invocation looks like: + +```sh +./build/ark/ark -p /path/to/your_soul.so +``` + +## Installing + +```sh +make install PREFIX=~/.local +``` + +This installs: +- `ark` to `~/.local/bin` +- if `-DMONTIS_BUILD_BUNDLED_SOUL=ON`, the latest built soul `.so` to `~/.local/lib` diff --git a/ark/CMakeLists.txt b/ark/CMakeLists.txt new file mode 100644 index 0000000..35e47a9 --- /dev/null +++ b/ark/CMakeLists.txt @@ -0,0 +1,134 @@ +cmake_minimum_required(VERSION 3.10) +project ( + ark + VERSION 0.1 + LANGUAGES C) + +set(CMAKE_VERBOSE_MAKEFILE ON) +set(CMAKE_BUILD_TYPE Debug) + +if(NOT TARGET wlroots_build) + set(WLROOTS_VERSION "0.18") + set(WLROOTS_URL "https://gitlab.freedesktop.org/wlroots/wlroots/-/archive/${WLROOTS_VERSION}/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 + ) + + add_custom_target(wlroots_build ALL DEPENDS "${WLROOTS_LIB_LINK}") +endif() + +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() + +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) + +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 +) + +add_executable (ark ${SOURCES} ${WLROOTS_LIB_LINK} + xdg-shell-protocol.c) + +target_link_libraries(ark 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(ark PRIVATE PkgConfig::WLOPT) +endif() + +target_link_directories(ark PUBLIC + "${WLROOTS_BUILD_DIR}") +target_link_options(ark PRIVATE -rdynamic) diff --git a/ark/README.md b/ark/README.md new file mode 100644 index 0000000..d773e0d --- /dev/null +++ b/ark/README.md @@ -0,0 +1,51 @@ +Ark (Runtime) +============= + +Ark is a long-running Wayland compositor runtime with a hot-reloadable soul +interface. + +Responsibilities +---------------- + +- Owns the Wayland display lifecycle and wlroots setup. +- Loads a soul shared object (`.so`) at runtime and routes input/surface events to it. +- Supports hot-reloading the soul without restarting the compositor. + +Soul interface +-------------- + +The runtime defines a C ABI that souls must implement (load/start/teardown, +event handlers, and optional state marshal/unmarshal for hot reload). The ABI is +defined in: + +- `ark/include/soul.h` + +Souls should include: + +- `ark/include/soul_interface.h` + +Key files +--------- + +- `ark/src/wl.c`: compositor setup + event loop + soul callbacks. +- `ark/src/soul.c`: dynamic loading, lifecycle, and hot-reload logic. +- `ark/include/soul.h`: C ABI the soul must implement. + +Building +-------- + +Ark is built via the top-level CMake project: + +```sh +cmake -S .. -B ../build +cmake --build ../build --target ark +``` + +Running +------- + +Use the top-level `run` target (builds the bundled soul and launches Ark): + +```sh +cmake --build ../build --target run +``` diff --git a/ark/include/soul.h b/ark/include/soul.h new file mode 100644 index 0000000..fa3415b --- /dev/null +++ b/ark/include/soul.h @@ -0,0 +1,111 @@ +#ifndef _SOUL_H_ +#define _SOUL_H_ + +#include <dlfcn.h> +#include <linux/limits.h> +#include <pthread.h> +#include <stdint.h> +#include <wlr/types/wlr_input_device.h> +#include <wlr/types/wlr_keyboard.h> +#include <wlr/types/wlr_pointer.h> + +#include "soul_types.h" +#include "soul_exports.h" + +#define MAX_QUEUED_ACTIONS 8 + +typedef void *dlhandle_t; + +/* Opaque state for a soul. Not to be touched by the harness (not that it + * really can be.) */ + +struct SOUL; +/* This structure represents an action requested by the soul for the harness. + */ +typedef struct { + int (*action)(struct SOUL *requester, void *arg); + void (*arg_dtor)(void *arg); + union { + void *ptr_arg; + int int_arg; + char *str_arg; + }; +} requested_action_t; + +/* + * Structure for the soul. + */ +typedef struct SOUL { + /* The argc this soul is loaded with. Typically the argc from main(). */ + int argc; + + /* The argv this soul is loaded with. Typically the argv from main(). */ + char **argv; + + /* Filename the soul is loaded from. */ + char filename[PATH_MAX]; + + /* Opaque state of this soul. The state is usually some kind of pointer to + * the soul 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 soul 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 soul'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 soul is initialized, otherwise set to zero. */ + int initialized; + + /* The handle to the shared library. */ + dlhandle_t library_handle; + + /* Pointer to the soul name. This is in the shared library and a + * null-terminated string. If the library does not have a soul name, this + * will be NULL. */ + const char *soul_name; + + /* Soul function table populated by the runtime loader. */ +#define SOUL_FN_PTR(ret, name, args) ret (*name) args; + ARKSOUL_EXPORTS(SOUL_FN_PTR) +#undef SOUL_FN_PTR + + /* List of requested actions by the soul. 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]; +} soul_t; + +/* Reloads the soul. This tears down the existing soul, marshals the state + * for it and reloads it. + * + * This function will call dlclose on the soul's library handle. + */ +int soul_hot_reload(int argc, char **argv, const char *filepath, soul_t *soul); + +/* + * Like hot-reload, but uses the same parameters the soul was originally + * loaded with. + */ +int soul_hot_reload_same_state(soul_t *soul); + +/* Starts a soul in a cold state. Called after load_soul_from_file. */ +void soul_cold_start(soul_t *soul); + +/* Reads a soul from a filename. */ +int load_soul_from_file(int argc, char **argv, const char *filename, + soul_t *soul); + +void soul_run_requested_actions(soul_t *soul); + +#endif /* _SOUL_H_ */ diff --git a/ark/include/soul_exports.h b/ark/include/soul_exports.h new file mode 100644 index 0000000..8e22b15 --- /dev/null +++ b/ark/include/soul_exports.h @@ -0,0 +1,117 @@ +#pragma once + +/* + * Single source of truth for the soul ABI. + * + * Consumers must define an X-macro like: + * #define X(ret, name, args) ... + * and then invoke: + * ARKSOUL_EXPORTS(X) + * + * Note: this file intentionally does not include headers. Include whatever you + * need (e.g. <stdint.h>, soul_types.h, wlroots headers) before expanding. + */ + +#define ARKSOUL_EXPORTS(X) \ + /* \ + * `arksoul_export_metaload` \ + * \ + * Called at most once per process *per `soul_name`*. This is the place \ + * for truly global initialization that should survive hot reloads (e.g. \ + * one-time language runtime init, registering global hooks, etc.). \ + * \ + * Notes: \ + * - May be a no-op. \ + * - Must be safe to call before any other soul entrypoint. \ + */ \ + X(void, arksoul_export_metaload, (int argc, char **argv)) \ + /* \ + * `arksoul_export_load` \ + * \ + * Called every time the shared object is loaded (cold start and each hot \ + * reload). Use this for per-load initialization that must be re-done after \ + * `dlopen`. \ + */ \ + X(void, arksoul_export_load, (int argc, char **argv)) \ + /* \ + * `arksoul_export_rebirth` \ + * \ + * Called after a hot reload with the previous soul's preserved state. \ + * Must return the new live opaque state (`opqst_t`) to be used for future \ + * handler calls. \ + * \ + * Contract: \ + * - Must not fail hard on state incompatibility; fall back to a default. \ + * - `self` is an opaque pointer owned by the runtime; treat it as \ + * read-only. \ + */ \ + X(opqst_t, arksoul_export_rebirth, \ + (void *self, uint8_t *marshalled_state, uint32_t n)) \ + /* \ + * `arksoul_export_ensoul` \ + * \ + * Called on first boot when no previous state exists. Must construct and \ + * return an initial opaque state. \ + */ \ + X(opqst_t, arksoul_export_ensoul, (void *self)) \ + /* \ + * `arksoul_export_preserve` \ + * \ + * Called before unloading the current soul during hot reload. Must \ + * serialize the provided opaque state into a newly allocated byte buffer. \ + * \ + * Ownership: \ + * - Return a heap-allocated buffer (e.g. `malloc`). \ + * - The runtime takes ownership and will `free()` it after \ + * `arksoul_export_rebirth`. \ + */ \ + X(uint8_t *, arksoul_export_preserve, (opqst_t st, uint32_t *szout)) \ + /* \ + * `arksoul_export_release` \ + * \ + * Called immediately before the shared object is unloaded. Use this to \ + * release resources owned by the opaque state (and any per-load resources \ + * created in `arksoul_export_load`). \ + */ \ + X(void, arksoul_export_release, (opqst_t st)) \ + /* \ + * `arksoul_export_handle_keybinding` \ + * \ + * Called for keyboard events. Returns the updated opaque state. Set \ + * `*out_handled` to non-zero if the event is consumed. \ + */ \ + X(opqst_t, arksoul_export_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)) \ + /* \ + * `arksoul_export_handle_button` \ + * \ + * Called for pointer button events (mouse/trackpad clicks). Returns the \ + * updated opaque state. \ + */ \ + X(opqst_t, arksoul_export_handle_button, \ + (struct wlr_pointer_button_event * event, uint32_t modifiers, \ + opqst_t state)) \ + /* \ + * `arksoul_export_handle_motion` \ + * \ + * Called for pointer motion. Returns the updated opaque state. \ + * \ + * Parameters: \ + * - `event` is an opaque pointer to the underlying wlroots event struct \ + * (type depends on `is_absolute`). \ + * - `lx`/`ly` are layout coordinates in compositor space. \ + */ \ + X(opqst_t, arksoul_export_handle_motion, \ + (void *event, uint32_t modifiers, uint32_t is_absolute, double lx, \ + double ly, opqst_t state)) \ + /* \ + * `arksoul_export_handle_surface` \ + * \ + * Called when a surface is mapped/unmapped/destroyed. `surface` is an \ + * opaque pointer to the runtime surface representation. Returns the updated \ + * opaque state. \ + */ \ + X(opqst_t, arksoul_export_handle_surface, \ + (void *surface, surface_event_t event, opqst_t state)) diff --git a/ark/include/soul_interface.h b/ark/include/soul_interface.h new file mode 100644 index 0000000..6e45573 --- /dev/null +++ b/ark/include/soul_interface.h @@ -0,0 +1,23 @@ +#ifndef _SOUL_INTF +#define _SOUL_INTF + +#include <stdint.h> + +#include "soul_types.h" +#include "soul_exports.h" + +#include <wlr/types/wlr_input_device.h> +#include <wlr/types/wlr_keyboard.h> +#include <wlr/types/wlr_pointer.h> + +/* + * Soul ABI: souls must export these symbols. + * + * This header is intended to be included by soul implementations. + */ + +#define DECLARE_SOUL_EXPORT(ret, name, args) ret name args; +ARKSOUL_EXPORTS(DECLARE_SOUL_EXPORT) +#undef DECLARE_SOUL_EXPORT + +#endif /* _SOUL_INTF */ diff --git a/rt/include/plugin_types.h b/ark/include/soul_types.h index df1eab5..df1eab5 100644 --- a/rt/include/plugin_types.h +++ b/ark/include/soul_types.h diff --git a/rt/include/wl.h b/ark/include/wl.h index f10ee7d..e5cf4f3 100644 --- a/rt/include/wl.h +++ b/ark/include/wl.h @@ -26,7 +26,7 @@ #include <wlr/util/log.h> #include <xkbcommon/xkbcommon.h> -#include <plugin.h> +#include <soul.h> /* For brevity's sake, struct members are annotated where they are used. */ enum montis_cursor_mode { @@ -75,7 +75,7 @@ struct montis_server { struct wl_listener new_output; struct wlr_session *session; - plugin_t plugin; + soul_t soul; }; struct montis_output { diff --git a/ark/src/soul.c b/ark/src/soul.c new file mode 100644 index 0000000..4268cd5 --- /dev/null +++ b/ark/src/soul.c @@ -0,0 +1,198 @@ +#include "soul.h" + +#include <ctype.h> +#include <dlfcn.h> +#include <pthread.h> +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <sys/stat.h> +#include <unistd.h> + +/* 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_soul_from_dl_(dlhandle_t dl, soul_t *soul); + +static void lock(soul_t *soul) { pthread_mutex_lock(&soul->lock); }; + +static void unlock(soul_t *soul) { pthread_mutex_unlock(&soul->lock); }; + +static int load_soul_from_file_(int argc, char **argv, const char *filename, + soul_t *soul) +{ + 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_soul_from_dl_(lib, soul); + + if (ec) { + goto end; + } + + strncpy(soul->filename, filename, sizeof(soul->filename)); + soul->argc = argc; + soul->argv = argv; + + soul->arksoul_export_load(soul->argc, soul->argv); +end: + return ec; +} + +static void maybe_run_metaload(int argc, char **argv, soul_t *soul) +{ + static char *loaded_souls[12]; + int i; + for (i = 0; i < 12 && loaded_souls[i]; ++i) { + if (strcmp(loaded_souls[i], soul->soul_name) == 0) { + return; // Soul is already loaded + } + } + loaded_souls[i] = strdup(soul->soul_name); + + printf("First time loading %s, running metaload.\n", soul->soul_name); + if (soul->arksoul_export_metaload) { + soul->arksoul_export_metaload(argc, argv); + } +} + +int load_soul_from_file(int argc, char **argv, const char *filename, + soul_t *soul) +{ + memset(soul, 0, sizeof(*soul)); + + 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(&soul->lock, &attr)) { + pthread_mutexattr_destroy(&attr); + perror("pthread_mutexattr_init"); + return 1; + } + pthread_mutexattr_destroy(&attr); + int rc = load_soul_from_file_(argc, argv, filename, soul); + + if (rc == 0) { + maybe_run_metaload(argc, argv, soul); + } + + return rc; +} + +int soul_hot_reload_same_state(soul_t *soul) +{ + char filename_cpy[PATH_MAX]; + strncpy(filename_cpy, soul->filename, sizeof(filename_cpy)); + return soul_hot_reload(soul->argc, soul->argv, filename_cpy, soul); +} + +int soul_hot_reload(int argc, char **argv, const char *filepath, soul_t *soul) +{ + int ec = 0; + uint32_t sz = 0; + uint8_t *marshalled_state = NULL; + + printf("Hot Reloading %s\n", soul->soul_name); + lock(soul); + + printf("Marshalling state ...\n"); + marshalled_state = soul->arksoul_export_preserve(soul->state, &sz); + + printf("Calling teardown ...\n"); + soul->arksoul_export_release(soul->state); + + printf("State Marshalled:\n"); + shx(marshalled_state, sz); + + printf("Unloading old library handle.\n"); + if (dlclose(soul->library_handle)) { + printf("Could not close library handle: %s\n", dlerror()); + } + + if ((ec = load_soul_from_file_(argc, argv, filepath, soul))) { + goto fail; + } + + printf("Hot starting soul ...\n"); + soul->state = soul->arksoul_export_rebirth(soul, marshalled_state, sz); + +fail: + free(marshalled_state); + unlock(soul); + return ec; +} + +void soul_run_requested_actions(soul_t *soul) +{ + lock(soul); + requested_action_t requested_actions[MAX_QUEUED_ACTIONS]; + size_t n_requested_actions = soul->n_requested_actions; + memcpy(&requested_actions, soul->requested_actions, + sizeof(requested_actions)); + soul->n_requested_actions = 0; + unlock(soul); + + size_t i; + for (i = 0; i < n_requested_actions; ++i) { + requested_actions[i].action(soul, requested_actions[i].str_arg); + if (requested_actions[i].arg_dtor) { + requested_actions[i].arg_dtor(requested_actions[i].ptr_arg); + } + } +} + +void soul_cold_start(soul_t *soul) +{ + lock(soul); + soul->state = soul->arksoul_export_ensoul(soul); + unlock(soul); +} diff --git a/ark/src/soul_load.c b/ark/src/soul_load.c new file mode 100644 index 0000000..fcf04a9 --- /dev/null +++ b/ark/src/soul_load.c @@ -0,0 +1,39 @@ +#include "soul.h" + +#include <dlfcn.h> +#include <stdio.h> + +#include "soul_exports.h" + +int load_soul_from_dl_(dlhandle_t dl, soul_t *soul) +{ + void *ptr; + int ret = 0; + + const char **name = dlsym(dl, "soul_name"); + if (name) { + soul->soul_name = *name; + } + else { + soul->soul_name = NULL; + } + + soul->state = NULL; + soul->library_handle = dl; + +#define LOAD_SYM(ret_type, sym, args) \ + do { \ + ptr = dlsym(dl, #sym); \ + if (!ptr) { \ + fprintf(stderr, "Soul missing %s\n", #sym); \ + ret |= 1; \ + } \ + soul->sym = (ret_type(*) args)ptr; \ + } while (0); + + ARKSOUL_EXPORTS(LOAD_SYM); + +#undef LOAD_SYM + + return ret; +} diff --git a/rt/src/wl.c b/ark/src/wl.c index f528c22..b9ce952 100644 --- a/rt/src/wl.c +++ b/ark/src/wl.c @@ -9,8 +9,8 @@ #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 +// This macro is responsible for calling a handler on a soul. This macro will +// acquire the soul's lock, call the member with the arguments and update the // state. // // This only works on function which have the format: @@ -18,13 +18,13 @@ // opqst_t function(args ..., opqst_t state); // // Note that the state parameter is omitted from this macro. -#define plugin_call_update_state(plugin, member, ...) \ +#define soul_call_update_state(soul, 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__); \ + soul_t *sl__ = &(soul); \ + pthread_mutex_lock(&sl__->lock); \ + sl__->state = sl__->member(__VA_ARGS__, sl__->state); \ + pthread_mutex_unlock(&sl__->lock); \ + soul_run_requested_actions(sl__); \ } while (0) static void focus_toplevel(struct montis_toplevel *toplevel, @@ -113,9 +113,9 @@ static void keyboard_handle_key(struct wl_listener *listener, void *data) 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. */ + * bindings regardless of what the soul dictates. This allows an escape + * hatch to edit the soul in a different vterm and then use the escape + * hatch below to hot-restart the soul 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); @@ -124,26 +124,26 @@ static void keyboard_handle_key(struct wl_listener *listener, void *data) 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 + /* Escape-hatch to hot-reload the soul in case the soul got borked and * stops accepting keybindings. Ctrl+Shift+Alt+Escape will always reload the - * plugin.*/ + * soul. */ 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"); + if ((ec = soul_hot_reload_same_state(&server->soul)) != 0) { + fprintf(stderr, "Failed to hot reload soul"); 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 + /* Pass the information along to the soul for the soul to handle. The + * soul 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); + soul_call_update_state(server->soul, arksoul_export_handle_keybinding, + keyboard->wlr_keyboard, event, modifiers, syms[0], + codepoint, &handled); } } } @@ -429,6 +429,9 @@ static void server_cursor_motion(struct wl_listener *listener, void *data) 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 @@ -437,6 +440,9 @@ static void server_cursor_motion(struct wl_listener *listener, void *data) wlr_cursor_move(server->cursor, &event->pointer->base, event->delta_x, event->delta_y); process_cursor_motion(server, event->time_msec); + soul_call_update_state(server->soul, arksoul_export_handle_motion, event, + modifiers, + 0, server->cursor->x, server->cursor->y); } static void server_cursor_motion_absolute(struct wl_listener *listener, @@ -459,8 +465,9 @@ static void server_cursor_motion_absolute(struct wl_listener *listener, 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, server->cursor->x, server->cursor->y); + soul_call_update_state(server->soul, arksoul_export_handle_motion, event, + modifiers, + 1, server->cursor->x, server->cursor->y); } static void server_cursor_button(struct wl_listener *listener, void *data) @@ -474,8 +481,8 @@ static void server_cursor_button(struct wl_listener *listener, void *data) 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); + soul_call_update_state(server->soul, arksoul_export_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, @@ -633,8 +640,9 @@ static void xdg_toplevel_map(struct wl_listener *listener, void *data) 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); + soul_call_update_state(toplevel->server->soul, arksoul_export_handle_surface, + toplevel, + SURFACE_MAP); fprintf(stderr, "/ Surface map ...\n"); focus_toplevel(toplevel, toplevel->xdg_toplevel->base->surface); @@ -651,8 +659,9 @@ static void xdg_toplevel_unmap(struct wl_listener *listener, void *data) } fprintf(stderr, "Surface unmap ...\n"); - plugin_call_update_state(toplevel->server->plugin, plugin_handle_surface, - toplevel, SURFACE_UNMAP); + soul_call_update_state(toplevel->server->soul, arksoul_export_handle_surface, + toplevel, + SURFACE_UNMAP); fprintf(stderr, "/ Surface map ...\n"); wl_list_remove(&toplevel->link); @@ -673,8 +682,9 @@ static void xdg_toplevel_destroy(struct wl_listener *listener, void *data) 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); + soul_call_update_state(toplevel->server->soul, arksoul_export_handle_surface, + toplevel, + SURFACE_DELETE); fprintf(stderr, "/ Surface destroy ...\n"); free(toplevel); @@ -917,7 +927,7 @@ int main(int argc, char *argv[]) { wlr_log_init(WLR_DEBUG, NULL); char *startup_cmd = NULL; - char *plugin = NULL; + char *soul_path = NULL; int c; while ((c = getopt(argc, argv, "s:p:h")) != -1) { @@ -926,26 +936,26 @@ int main(int argc, char *argv[]) startup_cmd = optarg; break; case 'p': - plugin = optarg; + soul_path = optarg; break; default: - printf("Usage: %s -p [plugin] [-s startup command]\n", argv[0]); + printf("Usage: %s -p [soul] [-s startup command]\n", argv[0]); return 0; } } - if (optind < argc || !plugin) { - printf("Usage: %s -p [plugin] [-s startup command]\n", argv[0]); + if (optind < argc || !soul_path) { + printf("Usage: %s -p [soul] [-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"); + if (load_soul_from_file(argc, argv, soul_path, &server.soul)) { + fprintf(stderr, "Failed to read soul from file.\n"); return 1; } - plugin_cold_start(&server.plugin); + soul_cold_start(&server.soul); /* The Wayland display is managed by libwayland. It handles accepting * clients from the Unix socket, manging Wayland globals, and so on. */ diff --git a/cross/CMakeLists.txt b/cross/CMakeLists.txt new file mode 100644 index 0000000..7180c6e --- /dev/null +++ b/cross/CMakeLists.txt @@ -0,0 +1,27 @@ +cmake_minimum_required(VERSION 3.10) +project(cross LANGUAGES C) + +set(WLROOTS_SOURCE_DIR "${CMAKE_BINARY_DIR}/wlroots-src") +set(WLROOTS_BUILD_DIR "${CMAKE_BINARY_DIR}/wlroots") + +file(GLOB_RECURSE CROSS_SOURCES src/*.c) + +add_library(cross STATIC ${CROSS_SOURCES}) +set_target_properties(cross PROPERTIES + POSITION_INDEPENDENT_CODE ON + ARCHIVE_OUTPUT_DIRECTORY "${CMAKE_BINARY_DIR}/cross" +) + +add_dependencies(cross wlroots_build) + +target_include_directories(cross PUBLIC + ${CMAKE_CURRENT_SOURCE_DIR}/include + ${CMAKE_SOURCE_DIR}/ark/include + ${CMAKE_BINARY_DIR} + ${WLROOTS_SOURCE_DIR}/include + ${WLROOTS_BUILD_DIR}/include + ${WLROOTS_BUILD_DIR}/protocol + /usr/include/pixman-1 +) + +target_compile_definitions(cross PRIVATE WLR_USE_UNSTABLE) diff --git a/cross/README.md b/cross/README.md new file mode 100644 index 0000000..cea84bb --- /dev/null +++ b/cross/README.md @@ -0,0 +1,32 @@ +Cross (Native Bridge Library) +============================= + +Cross is a static C library (`libcross.a`) that provides native helper +functions for a dynamically loaded soul to interact with the runtime and +wlroots. + +Why a static library? +--------------------- + +These helpers are linked into the soul (`.so`) so they hot-reload along with +the soul, instead of being stuck inside the long-running runtime process. + +API surface +----------- + +Public headers live in `cross/include`. + +- `cross/include/util.h`: soul-facing functions used via FFI, including: + - runtime requests (log/exit/hot-reload) + - seat access + - toplevel queries and basic positioning/geometry helpers + +Building +-------- + +Cross is built via the top-level CMake project: + +```sh +cmake -S .. -B ../build +cmake --build ../build --target cross +``` diff --git a/cross/include/util.h b/cross/include/util.h new file mode 100644 index 0000000..3707ae1 --- /dev/null +++ b/cross/include/util.h @@ -0,0 +1,24 @@ +#ifndef MONTIS_UTIL_H +#define MONTIS_UTIL_H + +/* + * Runtime helpers exposed to souls. These operate on compositor state and are + * intended for direct FFI use from a soul implementation. + */ + +void montis_do_request_hot_reload(void *plugv); +void montis_do_request_log(void *plugv, const char *str); +void montis_do_request_exit(void *plugv, int ec); + +void *arksoul_get_seat(void *ctx); +void *arksoul_toplevel_at(void *ctx, double lx, double ly); +void arksoul_get_toplevel_position(void *toplevel, double *x, double *y); +void arksoul_set_toplevel_position(void *toplevel, double x, double y); +void arksoul_get_toplevel_geometry(void *toplevel, double *x, double *y, + double *w, double *h); +void arksoul_set_toplevel_geometry(void *toplevel, double x, double y, + double w, double h); +void arksoul_focus_toplevel(void *toplevel); +void arksoul_warp_cursor(void *ctx, double lx, double ly); + +#endif /* MONTIS_UTIL_H */ diff --git a/cross/src/runtime_requests.c b/cross/src/runtime_requests.c new file mode 100644 index 0000000..adb2b2f --- /dev/null +++ b/cross/src/runtime_requests.c @@ -0,0 +1,69 @@ +#include "util.h" +#include "wl.h" + +#include <stdio.h> +#include <stdlib.h> +#include <string.h> + +static int soul_hot_reload_same_state_action_(soul_t *soul, void *ignore) +{ + (void)ignore; + return soul_hot_reload_same_state(soul); +} + +void montis_do_request_hot_reload(void *plugv) +{ + soul_t *soul = plugv; + + size_t n = soul->n_requested_actions++; + if (n < MAX_QUEUED_ACTIONS) { + soul->requested_actions[n].action = soul_hot_reload_same_state_action_; + soul->requested_actions[n].arg_dtor = NULL; + } +} + +static int soul_do_log(soul_t *soul, void *chrs) +{ + (void)soul; + char *str = chrs; + puts(str); + return 0; +} + +void montis_do_request_log(void *plugv, const char *str) +{ + soul_t *soul = plugv; + + size_t n = soul->n_requested_actions++; + if (n < MAX_QUEUED_ACTIONS) { + soul->requested_actions[n].action = soul_do_log; + soul->requested_actions[n].str_arg = strdup(str); + soul->requested_actions[n].arg_dtor = free; + } +} + +static int arksoul_do_exit(void *plugv, int ec) +{ + (void)plugv; + exit(ec); + return 0; +} + +void montis_do_request_exit(void *plugv, int ec) +{ + soul_t *soul = plugv; + + size_t n = soul->n_requested_actions++; + if (n < MAX_QUEUED_ACTIONS) { + soul->requested_actions[n].action = + (int (*)(soul_t *, void *))arksoul_do_exit; + soul->requested_actions[n].int_arg = ec; + soul->requested_actions[n].arg_dtor = NULL; + } +} + +void *arksoul_get_seat(void *ctx) +{ + struct montis_server *server = wl_container_of(ctx, server, soul); + return server->seat; +} diff --git a/rt/src/util.c b/cross/src/util.c index e09cff9..0c02dfe 100644 --- a/rt/src/util.c +++ b/cross/src/util.c @@ -6,7 +6,7 @@ static struct montis_server *server_from_ctx(void *ctx) { - struct montis_server *server = wl_container_of(ctx, server, plugin); + struct montis_server *server = wl_container_of(ctx, server, soul); return server; } @@ -35,7 +35,7 @@ static struct montis_toplevel *toplevel_at(struct montis_server *server, return tree ? tree->node.data : NULL; } -void *montis_plugin_toplevel_at(void *ctx, double lx, double ly) +void *arksoul_toplevel_at(void *ctx, double lx, double ly) { if (!ctx) { return NULL; @@ -44,7 +44,7 @@ void *montis_plugin_toplevel_at(void *ctx, double lx, double ly) return toplevel_at(server, lx, ly); } -void montis_plugin_get_toplevel_position(void *toplevel, double *x, double *y) +void arksoul_get_toplevel_position(void *toplevel, double *x, double *y) { if (!toplevel || !x || !y) { return; @@ -54,7 +54,7 @@ void montis_plugin_get_toplevel_position(void *toplevel, double *x, double *y) *y = tl->scene_tree->node.y; } -void montis_plugin_set_toplevel_position(void *toplevel, double x, double y) +void arksoul_set_toplevel_position(void *toplevel, double x, double y) { if (!toplevel) { return; @@ -63,8 +63,8 @@ void montis_plugin_set_toplevel_position(void *toplevel, double x, double y) 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) +void arksoul_get_toplevel_geometry(void *toplevel, double *x, double *y, + double *w, double *h) { if (!toplevel || !x || !y || !w || !h) { return; @@ -78,8 +78,8 @@ void montis_plugin_get_toplevel_geometry(void *toplevel, double *x, double *y, *h = geo_box.height; } -void montis_plugin_set_toplevel_geometry(void *toplevel, double x, double y, - double w, double h) +void arksoul_set_toplevel_geometry(void *toplevel, double x, double y, + double w, double h) { if (!toplevel) { return; @@ -89,7 +89,7 @@ void montis_plugin_set_toplevel_geometry(void *toplevel, double x, double y, wlr_xdg_toplevel_set_size(tl->xdg_toplevel, (int)w, (int)h); } -void montis_plugin_warp_cursor(void *ctx, double lx, double ly) +void arksoul_warp_cursor(void *ctx, double lx, double ly) { if (!ctx) { return; @@ -98,7 +98,7 @@ void montis_plugin_warp_cursor(void *ctx, double lx, double ly) wlr_cursor_warp(server->cursor, NULL, lx, ly); } -void montis_plugin_focus_toplevel(void *toplevel) +void arksoul_focus_toplevel(void *toplevel) { if (!toplevel) { return; diff --git a/montis/README.md b/montis/README.md new file mode 100644 index 0000000..cfe264e --- /dev/null +++ b/montis/README.md @@ -0,0 +1,40 @@ +Montis (Haskell Window Manager Soul) +==================================== + +Montis is the hot-reloadable window manager logic for the Ark runtime. + +It builds to a shared object (`montis.so`) that Ark loads at runtime. You can +edit/rebuild the soul and hot-reload it without restarting the compositor. + +Native interface +---------------- + +Montis talks to the runtime through: + +- the soul ABI defined by Ark (`ark/include/soul.h`), implemented in Haskell via + `montis/src/Montis/Core/Internal/Foreign/Export.hs` and a small C shim + `montis/src/harness_adapter.c`. +- the Cross bridge library (`libcross.a`), which provides soul-facing helper + functions used via FFI (see `montis/src/Montis/Base/Foreign/Runtime.hs`). + +Building +-------- + +The soul is built by Stack, typically driven by the top-level CMake build: + +```sh +cmake -S .. -B ../build +cmake --build ../build --target soul_build +``` + +Or directly: + +```sh +stack build +``` + +Output +------ + +The built `montis.so` ends up under the shared `build/stack-work` directory +(symlinked to `montis/.stack-work` by the top-level build). diff --git a/plug/package.yaml b/montis/package.yaml index bd42ced..b46f5de 100644 --- a/plug/package.yaml +++ b/montis/package.yaml @@ -70,10 +70,15 @@ executables: - -O2 - -shared - -I../build/ - - -I../rt/include/ + - -I../ark/include/ + - -I../cross/include/ - -I../build/wlroots/include - -I../build/wlroots-src/include - -DWLR_USE_UNSTABLE + extra-lib-dirs: + - ../build/cross + extra-libraries: + - cross tests: montis-test: diff --git a/montis/src/Config.hs b/montis/src/Config.hs new file mode 100644 index 0000000..f71b5f9 --- /dev/null +++ b/montis/src/Config.hs @@ -0,0 +1,27 @@ +module Config (config) where + +import Data.Bits (shiftL) +import Data.Word (Word32) +import Montis.Core +import Montis.Standard.Drag (DragConfig (DragConfig)) +import Montis.Standard.Keys.Dsl +import Montis.Standard.Mouse (MouseConfig (MouseConfig)) + +keyBindings :: [Binding] +keyBindings = + [ Bind + (Mod1 .+ 'j') + [ Bind (Mod1 .+ 'k') (mio $ putStrLn "Pressed 'k' after 'j'") + ], + Bind (Mod1 .+ 'Q') requestRebirth, + Bind (Mod1 .+ 's') (\(keyEvent :: KeyEvent) -> mio (print keyEvent)) + ] + +mod1Mask :: Word32 +mod1Mask = 1 `shiftL` 3 -- WLR_MODIFIER_ALT + +config :: MontisConfig +config = + install MouseConfig $ + install (DragConfig mod1Mask) $ + withBindings keyBindings defaultConfig diff --git a/montis/src/Link.hs b/montis/src/Link.hs new file mode 100644 index 0000000..9c0a07f --- /dev/null +++ b/montis/src/Link.hs @@ -0,0 +1,18 @@ +-- | Module that provides the start hooks using the config required to link the +-- soul's shared library. +module Link () where + +import Config (config) +import Montis.Core + +foreign export ccall "arksoul_export_ensoul" + coldStart :: MontisColdStart + +foreign export ccall "arksoul_export_rebirth" + hotStart :: MontisHotStart + +coldStart :: MontisColdStart +coldStart = coldStartMontis config + +hotStart :: MontisHotStart +hotStart = hotStartMontis config diff --git a/plug/src/Montis/Base/Foreign/Runtime.hs b/montis/src/Montis/Base/Foreign/Runtime.hs index 427545a..46507b5 100644 --- a/plug/src/Montis/Base/Foreign/Runtime.hs +++ b/montis/src/Montis/Base/Foreign/Runtime.hs @@ -12,26 +12,26 @@ foreign import ccall "montis_do_request_log" foreign_doRequestLog :: Ptr Void -> 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 "arksoul_get_seat" foreign_getSeat :: Ptr Void -> IO (Ptr Void) -foreign import ccall "montis_plugin_toplevel_at" +foreign import ccall "arksoul_toplevel_at" foreign_toplevelAt :: Ptr Void -> CDouble -> CDouble -> IO (Ptr ForeignMontisToplevel) -foreign import ccall "montis_plugin_get_toplevel_position" +foreign import ccall "arksoul_get_toplevel_position" foreign_getToplevelPosition :: Ptr ForeignMontisToplevel -> Ptr CDouble -> Ptr CDouble -> IO () -foreign import ccall "montis_plugin_set_toplevel_position" +foreign import ccall "arksoul_set_toplevel_position" foreign_setToplevelPosition :: Ptr ForeignMontisToplevel -> CDouble -> CDouble -> IO () -foreign import ccall "montis_plugin_get_toplevel_geometry" +foreign import ccall "arksoul_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 import ccall "arksoul_set_toplevel_geometry" foreign_setToplevelGeometry :: Ptr ForeignMontisToplevel -> CDouble -> CDouble -> CDouble -> CDouble -> IO () -foreign import ccall "montis_plugin_focus_toplevel" +foreign import ccall "arksoul_focus_toplevel" foreign_focusToplevel :: Ptr ForeignMontisToplevel -> IO () -foreign import ccall "montis_plugin_warp_cursor" +foreign import ccall "arksoul_warp_cursor" foreign_warpCursor :: Ptr Void -> CDouble -> CDouble -> IO () diff --git a/plug/src/Montis/Base/Foreign/WlRoots.hs b/montis/src/Montis/Base/Foreign/WlRoots.hs index 272567f..272567f 100644 --- a/plug/src/Montis/Base/Foreign/WlRoots.hs +++ b/montis/src/Montis/Base/Foreign/WlRoots.hs diff --git a/plug/src/Montis/Base/Foreign/WlRoots/Types.hs b/montis/src/Montis/Base/Foreign/WlRoots/Types.hs index c109653..c109653 100644 --- a/plug/src/Montis/Base/Foreign/WlRoots/Types.hs +++ b/montis/src/Montis/Base/Foreign/WlRoots/Types.hs diff --git a/plug/src/Montis/Core.hs b/montis/src/Montis/Core.hs index 65dcdad..5399f1e 100644 --- a/plug/src/Montis/Core.hs +++ b/montis/src/Montis/Core.hs @@ -5,5 +5,6 @@ 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/montis/src/Montis/Core/Events.hs index 91b8618..91b8618 100644 --- a/plug/src/Montis/Core/Events.hs +++ b/montis/src/Montis/Core/Events.hs diff --git a/plug/src/Montis/Core/Extensions.hs b/montis/src/Montis/Core/Extensions.hs index 0e8384f..0e8384f 100644 --- a/plug/src/Montis/Core/Extensions.hs +++ b/montis/src/Montis/Core/Extensions.hs diff --git a/plug/src/Montis/Core/Internal/Foreign/Export.hs b/montis/src/Montis/Core/Internal/Foreign/Export.hs index 132273a..635955a 100644 --- a/plug/src/Montis/Core/Internal/Foreign/Export.hs +++ b/montis/src/Montis/Core/Internal/Foreign/Export.hs @@ -1,5 +1,5 @@ -- | This module has no public functions, but provides the surface interface --- between the Montis runtime and the plugin. +-- between the Montis runtime and the soul. module Montis.Core.Internal.Foreign.Export () where import Control.Monad (forM_) @@ -17,20 +17,18 @@ import Foreign mallocBytes, newStablePtr, ) -import Foreign.C (CChar, CDouble(..), CInt (..)) +import Foreign.C (CChar, CDouble (..), CInt (..)) import Foreign.Ptr (castPtr) import Montis.Base.Foreign.WlRoots.Types ( ForeignSurface (toSurface), ForeignWlrInputDevice, ForeignWlrPointer, - ForeignWlrPointerMotionAbsoluteEvent, ForeignWlrXWaylandSurface, ForeignWlrXdgSurface, WlrEventKeyboardKey, WlrInputDevice (WlrInputDevice), WlrPointer (WlrPointer), WlrPointerButtonEvent, - WlrPointerMotionAbsoluteEvent, ) import Montis.Core import Montis.Core.State @@ -66,11 +64,11 @@ runForeignWithReturn fn outptr stableptr = do -- 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) +foreign export ccall "arksoul_export_preserve" + soulMarshalState :: OpqStT -> Ptr Word32 -> IO (Ptr Word8) -pluginMarshalState :: OpqStT -> Ptr Word32 -> IO (Ptr Word8) -pluginMarshalState opqStT outlen = do +soulMarshalState :: OpqStT -> Ptr Word32 -> IO (Ptr Word8) +soulMarshalState opqStT outlen = do (_, st) <- deRefStablePtr opqStT let bs = CH.pack (marshalState st) ret <- mallocBytes (BS.length bs) @@ -82,11 +80,11 @@ pluginMarshalState opqStT outlen = do -- ---------------------------------------------------------------------- -- Input handlers -foreign export ccall "plugin_handle_button" - pluginHandleButton :: Ptr WlrPointerButtonEvent -> Word32 -> OpqStT -> IO OpqStT +foreign export ccall "arksoul_export_handle_button" + soulHandleButton :: Ptr WlrPointerButtonEvent -> Word32 -> OpqStT -> IO OpqStT -pluginHandleButton :: Ptr WlrPointerButtonEvent -> Word32 -> OpqStT -> IO OpqStT -pluginHandleButton eventPtr modifiers = +soulHandleButton :: Ptr WlrPointerButtonEvent -> Word32 -> OpqStT -> IO OpqStT +soulHandleButton eventPtr modifiers = runForeign $ do s <- gets currentHooks event <- liftIO $ @@ -109,8 +107,8 @@ pluginHandleButton eventPtr modifiers = -- ---------------------------------------------------------------------- -- Keybinding handler -foreign export ccall "plugin_handle_keybinding" - pluginHandleKeybinding :: +foreign export ccall "arksoul_export_handle_keybinding" + soulHandleKeybinding :: Ptr ForeignWlrInputDevice -> Ptr WlrEventKeyboardKey -> Word32 -> @@ -120,7 +118,7 @@ foreign export ccall "plugin_handle_keybinding" OpqStT -> IO OpqStT -pluginHandleKeybinding :: +soulHandleKeybinding :: Ptr ForeignWlrInputDevice -> Ptr WlrEventKeyboardKey -> Word32 -> @@ -129,7 +127,7 @@ pluginHandleKeybinding :: Ptr CInt -> OpqStT -> IO OpqStT -pluginHandleKeybinding inputDevicePtr eventPtr mods sym cp = +soulHandleKeybinding inputDevicePtr eventPtr mods sym cp = runForeignWithReturn $ do s <- gets currentHooks event <- liftIO $ @@ -155,28 +153,46 @@ pluginHandleKeybinding inputDevicePtr eventPtr mods sym cp = -- ---------------------------------------------------------------------- -- Motion handler -foreign export ccall "plugin_handle_motion" - pluginHandleMotion :: Ptr WlrPointerMotionAbsoluteEvent -> Word32 -> CDouble -> CDouble -> OpqStT -> IO OpqStT +foreign export ccall "arksoul_export_handle_motion" + soulHandleMotion :: Ptr Void -> Word32 -> Word32 -> CDouble -> CDouble -> OpqStT -> IO OpqStT -pluginHandleMotion :: Ptr WlrPointerMotionAbsoluteEvent -> Word32 -> CDouble -> CDouble -> OpqStT -> IO OpqStT -pluginHandleMotion eventPtr modifiers lx ly = +soulHandleMotion :: Ptr Void -> Word32 -> Word32 -> CDouble -> CDouble -> OpqStT -> IO OpqStT +soulHandleMotion eventPtr modifiers isAbsolute lx ly = runForeign $ do s <- gets currentHooks event <- liftIO $ - 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) + 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 @@ -185,26 +201,26 @@ pluginHandleMotion eventPtr modifiers lx ly = -- | Function exported to the harness to handle the mapping/unmapping/deletion -- of an XDG surface. -foreign export ccall "plugin_handle_surface" - pluginHandleSurface :: +foreign export ccall "arksoul_export_handle_surface" + soulHandleSurface :: Ptr ForeignWlrXdgSurface -> CInt -> OpqStT -> IO OpqStT -pluginHandleSurface :: +soulHandleSurface :: Ptr ForeignWlrXdgSurface -> CInt -> OpqStT -> IO OpqStT -pluginHandleSurface p t = +soulHandleSurface 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 :: +foreign export ccall "arksoul_export_handle_xwayland_surface" + soulHandleXWaylandSurface :: Ptr ForeignWlrXWaylandSurface -> CInt -> OpqStT -> IO OpqStT -pluginHandleXWaylandSurface :: +soulHandleXWaylandSurface :: Ptr ForeignWlrXWaylandSurface -> CInt -> OpqStT -> IO OpqStT -pluginHandleXWaylandSurface p t = +soulHandleXWaylandSurface 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/montis/src/Montis/Core/Monad.hs index b7d1633..0eee819 100644 --- a/plug/src/Montis/Core/Monad.hs +++ b/montis/src/Montis/Core/Monad.hs @@ -23,7 +23,7 @@ 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 +-- | The Opaque State Type passed between the soul and the runtime. The -- OpqStT *is* the opq_st_t from the runtime code. type OpqStT = StablePtr (MontisContext, MontisState) @@ -34,7 +34,7 @@ newtype Montis a where 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 +-- keeps soul code from mutating the context while still allowing read-only -- access to configuration. instance MonadReader MontisConfig Montis where ask :: Montis MontisConfig @@ -47,7 +47,7 @@ instance MonadReader MontisConfig Montis where local cfn (Montis fn) = Montis $ local (\ctx -> ctx {ctxConfig = cfn (ctxConfig ctx)}) fn --- | Access the plugin self pointer stored in the context. +-- | Access the soul self pointer stored in the context. getSelfPtr :: Montis SelfPtr getSelfPtr = Montis $ asks ctxSelfPtr @@ -123,3 +123,7 @@ xConfigGet = do fromMaybe def $ Map.lookup (typeRepr (Proxy :: Proxy a)) exts >>= (\(Extension a) -> cast a) + + +mio :: IO a -> Montis a +mio = liftIO diff --git a/montis/src/Montis/Core/Runtime.hs b/montis/src/Montis/Core/Runtime.hs new file mode 100644 index 0000000..541cc6b --- /dev/null +++ b/montis/src/Montis/Core/Runtime.hs @@ -0,0 +1,88 @@ +module Montis.Core.Runtime + ( ToplevelHandle, + focusToplevel, + getSeat, + getToplevelGeometry, + setToplevelGeometry, + setToplevelPosition, + toplevelAt, + warpCursor, + requestRebirth, + ) +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 + +requestRebirth :: Montis () +requestRebirth = do + (SelfPtr p) <- getSelfPtr + liftIO $ foreign_doRequestHotReload 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/Plugin/Interface.hs b/montis/src/Montis/Core/Soul/Interface.hs index 73c0371..3271ab7 100644 --- a/plug/src/Montis/Core/Plugin/Interface.hs +++ b/montis/src/Montis/Core/Soul/Interface.hs @@ -1,5 +1,5 @@ --- | Provides the plugin interface through foreign exports. -module Montis.Core.Plugin.Interface where +-- | Provides the soul interface through foreign exports. +module Montis.Core.Soul.Interface where import Data.ByteString (ByteString) import Data.Data (Typeable) diff --git a/plug/src/Montis/Core/Start.hs b/montis/src/Montis/Core/Start.hs index 54ec8c5..54ec8c5 100644 --- a/plug/src/Montis/Core/Start.hs +++ b/montis/src/Montis/Core/Start.hs diff --git a/plug/src/Montis/Core/State.hs b/montis/src/Montis/Core/State.hs index ce8f903..6a2d5d0 100644 --- a/plug/src/Montis/Core/State.hs +++ b/montis/src/Montis/Core/State.hs @@ -10,11 +10,11 @@ import Montis.Core.Events import Montis.Core.Extensions import Text.Read (readMaybe) --- | An opaque type used for the plugin's self-reference. +-- | An opaque type used for the soul's self-reference. newtype SelfPtr where SelfPtr :: Ptr Void -> SelfPtr --- | This is the context the plugin operates under. The context contains data +-- | This is the context the soul operates under. The context contains data -- which must be provided by the runtime or the configuration. This data may not -- be cold-created. -- diff --git a/plug/src/Montis/Core/State/Marshal.hs b/montis/src/Montis/Core/State/Marshal.hs index 04a2a57..04a2a57 100644 --- a/plug/src/Montis/Core/State/Marshal.hs +++ b/montis/src/Montis/Core/State/Marshal.hs diff --git a/plug/src/Montis/Foreign/Marshal.hs b/montis/src/Montis/Foreign/Marshal.hs index 157d928..157d928 100644 --- a/plug/src/Montis/Foreign/Marshal.hs +++ b/montis/src/Montis/Foreign/Marshal.hs 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/plug/src/Montis/Standard/Keys.hs b/montis/src/Montis/Standard/Keys.hs index 24f232b..0b670eb 100644 --- a/plug/src/Montis/Standard/Keys.hs +++ b/montis/src/Montis/Standard/Keys.hs @@ -6,17 +6,14 @@ import Data.Data (Typeable) import Data.Default.Class (Default (..)) import Data.Set qualified as Set import Data.Word (Word32) -import Foreign.Ptr (Ptr, castPtr, nullPtr) -import Montis.Base.Foreign.Runtime (foreign_getSeat) import Montis.Base.Foreign.WlRoots (seatKeyboardNotifyKey) -import Montis.Base.Foreign.WlRoots.Types (ForeignWlrSeat, WlrSeat (WlrSeat)) import Montis.Core.Events (KeyEvent (..), KeyState (..)) -import Montis.Core.Monad (Montis, getSelfPtr, xConfigGet, xStateGet, xStateModify) +import Montis.Core.Monad (Montis, xConfigGet, xStateGet, xStateModify) +import Montis.Core.Runtime (getSeat) import Montis.Core.State ( Config (startingHooks), ConfigModule (..), Hooks (keyHook), - SelfPtr (..), StateExtension (..), ) @@ -86,9 +83,7 @@ instance ConfigModule Montis KeysConfig where else return False if not handled - then do - self <- getSelfPtr - liftIO $ forwardKeyToSeat self ev + then forwardKeyToSeat ev else when (isKeyPress ev) $ xStateModify $ \ks -> @@ -97,17 +92,18 @@ instance ConfigModule Montis KeysConfig where Set.insert (keyEvent_keycode ev) (ignoredKeys ks) } -forwardKeyToSeat :: SelfPtr -> KeyEvent -> IO () -forwardKeyToSeat (SelfPtr ctx) ev = do - seatPtr <- foreign_getSeat ctx - if seatPtr == nullPtr - then return () - else - seatKeyboardNotifyKey - (WlrSeat (castPtr seatPtr :: Ptr ForeignWlrSeat)) - (keyEvent_timeMs ev) - (keyEvent_keycode ev) - (keyStateToWord32 (keyEvent_state ev)) +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 diff --git a/montis/src/Montis/Standard/Keys/Dsl.hs b/montis/src/Montis/Standard/Keys/Dsl.hs new file mode 100644 index 0000000..096a8b9 --- /dev/null +++ b/montis/src/Montis/Standard/Keys/Dsl.hs @@ -0,0 +1,85 @@ +{-# LANGUAGE ImpredicativeTypes #-} + +-- | Small DSL for defining key bindings and nested sub-maps. +module Montis.Standard.Keys.Dsl where + +import Control.Monad.Loops (anyM) +import Data.Bits (shiftL, (.&.)) +import Montis.Core (Config, KeyEvent (keyEvent_codepoint, keyEvent_modifiers), Montis (..), install) +import Montis.Standard.Keys + +-- | A predicate over a key event. +class KeyMatch a where + matches :: a -> KeyEvent -> Montis Bool + +instance KeyMatch Char where + matches c k = return $ keyEvent_codepoint k == c + +-- | Modifier matches using wlroots bit positions. +data Modifier = Mod1 | Mod2 | Mod3 | Mod4 | Mod5 | Any | None + +instance KeyMatch Modifier where + matches Mod1 ev = return $ keyEvent_modifiers ev .&. (1 `shiftL` 3) /= 0 + matches Mod2 ev = return $ keyEvent_modifiers ev .&. (1 `shiftL` 4) /= 0 + matches Mod3 ev = return $ keyEvent_modifiers ev .&. (1 `shiftL` 5) /= 0 + matches Mod4 ev = return $ keyEvent_modifiers ev .&. (1 `shiftL` 6) /= 0 + matches Mod5 ev = return $ keyEvent_modifiers ev .&. (1 `shiftL` 7) /= 0 + matches Any _ = return True + matches None ev = return $ keyEvent_modifiers ev == 0 + +-- | Actions run when a binding matches. Each action reports handled status. +class Action b where + run :: b -> Montis Bool + +instance Action (Montis ()) where + run a = a >> return True + +instance Action (KeyEvent -> Montis ()) where + run f = subkeys (\e -> f e >> return True) + +-- | Submap to the first binding that matches. +instance Action [Binding] where + run bs = subkeys $ \ev -> + anyM + ( \(Bind k a) -> do + m <- matches k ev + if m then run a >> return True else return False + ) + bs + +instance Action (Montis [Binding]) where + run mbs = do + bs <- mbs + run bs + +-- | A single binding from a matcher to an action. +data Binding where + Bind :: forall k b. (KeyMatch k, Action b) => k -> b -> Binding + +-- | A matcher for key + modifier chords. +data ChordMatch where + ChordMatch :: forall k2 k1. (KeyMatch k2, KeyMatch k1) => k2 -> k1 -> ChordMatch + +(.+) :: (KeyMatch k1, KeyMatch k2) => k1 -> k2 -> ChordMatch +(.+) = ChordMatch + +instance KeyMatch ChordMatch where + matches (ChordMatch a b) ev = do + ma <- matches a ev + mb <- matches b ev + return (ma && mb) + +-- | Installs the bindings into a config as the starting key hook. +withBindings :: [Binding] -> Config Montis -> Config Montis +withBindings bs = + install + ( KeysConfig + ( \ev -> + anyM + ( \(Bind k a) -> do + m <- matches k ev + if m then run a >> return True else return False + ) + bs + ) + ) diff --git a/plug/src/Montis/Standard/Mouse.hs b/montis/src/Montis/Standard/Mouse.hs index b671206..933a2f4 100644 --- a/plug/src/Montis/Standard/Mouse.hs +++ b/montis/src/Montis/Standard/Mouse.hs @@ -1,11 +1,8 @@ module Montis.Standard.Mouse where -import Control.Monad.IO.Class (liftIO) import Data.Data (Typeable) -import Data.Void (Void) -import Foreign.Ptr (Ptr, nullPtr) -import Montis.Base.Foreign.Runtime (foreign_focusToplevel, foreign_toplevelAt) import Montis.Core +import Montis.Core.Runtime (focusToplevel, toplevelAt) import Montis.Core.State ( Config (startingHooks), ConfigModule (..), @@ -46,13 +43,8 @@ onButton :: ButtonEvent -> Montis () onButton ev | buttonEvent_state ev /= ButtonPressed = return () | otherwise = do - self <- getSelfPtr CursorPosition (x, y) <- xStateGet - liftIO $ do - tl <- foreign_toplevelAt (unwrapSelf self) (realToFrac x) (realToFrac y) - if tl == nullPtr - then return () - else foreign_focusToplevel tl - -unwrapSelf :: SelfPtr -> Ptr Void -unwrapSelf (SelfPtr p) = p + mtl <- toplevelAt x y + case mtl of + Nothing -> return () + Just tl -> focusToplevel tl diff --git a/plug/src/harness_adapter.c b/montis/src/harness_adapter.c index db5e7ce..fb5646c 100644 --- a/plug/src/harness_adapter.c +++ b/montis/src/harness_adapter.c @@ -4,25 +4,25 @@ // Currently these functions exclusively enable/disable the Haskell runtime. #include "HsFFI.h" -#include "plugin_interface.h" +#include "soul_interface.h" #include <stdio.h> #include <stdlib.h> #include <unistd.h> -const char *plugin_name = "Montis"; +const char *soul_name = "Montis"; extern void performMajorGC(); -void plugin_metaload(int argc, char** argv) +void arksoul_export_metaload(int argc, char** argv) { // hs_init(&argc, &argv); } -void plugin_load(int argc, char **argv) { +void arksoul_export_load(int argc, char **argv) { hs_init(&argc, &argv); } -void plugin_teardown(opqst_t st) { +void arksoul_export_release(opqst_t st) { hs_exit(); } @@ -34,10 +34,10 @@ void shell_exec(const char* cmd) { } static const char msg[] = - "Montis Plugin v 0.01\n\n" + "Montis Soul 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" + "This is merely a soul for the Montis Compositor and not meant to be\n" + "executed as a standalone binary. This soul 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); diff --git a/plug/stack.yaml b/montis/stack.yaml index 0faf47c..0faf47c 100644 --- a/plug/stack.yaml +++ b/montis/stack.yaml diff --git a/plug/test/Spec.hs b/montis/test/Spec.hs index cd4753f..cd4753f 100644 --- a/plug/test/Spec.hs +++ b/montis/test/Spec.hs 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/src/Config.hs b/plug/src/Config.hs deleted file mode 100644 index c76898e..0000000 --- a/plug/src/Config.hs +++ /dev/null @@ -1,46 +0,0 @@ -module Config () where - -import Control.Monad.IO.Class (liftIO) -import Data.Bits (shiftL, (.&.)) -import Data.Word (Word32) -import Montis.Core -import Montis.Base.Foreign.Runtime -import Montis.Standard.Drag (DragConfig (DragConfig), unwrapSelf) -import Montis.Standard.Keys (KeysConfig (KeysConfig), subkeys) -import Montis.Standard.Mouse (MouseConfig (MouseConfig)) - -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 - -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!") - self <- getSelfPtr - liftIO $ foreign_warpCursor (unwrapSelf self) 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/Montis/Standard/Drag.hs b/plug/src/Montis/Standard/Drag.hs deleted file mode 100644 index 720398d..0000000 --- a/plug/src/Montis/Standard/Drag.hs +++ /dev/null @@ -1,160 +0,0 @@ -module Montis.Standard.Drag where - -import Control.Monad.IO.Class (liftIO) -import Data.Bits ((.&.)) -import Data.Data (Typeable) -import Data.Void (Void) -import Data.Word (Word32) -import Foreign (Ptr) -import Foreign.C (CDouble) -import Foreign.Marshal.Alloc (alloca) -import Foreign.Ptr (nullPtr) -import Foreign.Storable (peek) -import Montis.Base.Foreign.Runtime -import Montis.Core -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 :: Ptr ForeignMontisToplevel, - dragOffsetX :: Double, - dragOffsetY :: Double - } - deriving (Typeable) - -data ResizeState = ResizeState - { resizeToplevel :: Ptr ForeignMontisToplevel, - 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 - self <- getSelfPtr - CursorPosition (x, y) <- xStateGet - (newDrag, warpState) <- liftIO $ do - tl <- foreign_toplevelAt (unwrapSelf self) (realToFrac x) (realToFrac y) - if tl == nullPtr - then return (Dragging Nothing, Nothing) - else do - (tx, ty, tw, th) <- getToplevelGeometry tl - if buttonEvent_button ev == rightButton - then do - let warpX = tx + tw - warpY = ty + th - foreign_warpCursor (unwrapSelf self) (realToFrac warpX) (realToFrac warpY) - return - ( Dragging - ( Just - ( DragResize - (ResizeState tl tx ty tw th warpX warpY) - ) - ), - Just (CursorPosition (warpX, warpY)) - ) - else - return - ( Dragging - (Just (DragMove (DragState tl (x - tx) (y - ty)))), - Nothing - ) - mapM_ xStatePut warpState - xStatePut newDrag - | 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)) -> do - liftIO $ - foreign_setToplevelPosition - tl - (realToFrac (x - dx)) - (realToFrac (y - dy)) - Just (DragResize rs) -> do - let newW = max 1 (resizeStartW rs + (x - resizeStartCursorX rs)) - newH = max 1 (resizeStartH rs + (y - resizeStartCursorY rs)) - liftIO $ - foreign_setToplevelGeometry - (resizeToplevel rs) - (realToFrac (resizeStartX rs)) - (realToFrac (resizeStartY rs)) - (realToFrac newW) - (realToFrac newH) - -unwrapSelf :: SelfPtr -> Ptr Void -unwrapSelf (SelfPtr p) = p - -getToplevelGeometry :: Ptr ForeignMontisToplevel -> IO (Double, Double, Double, Double) -getToplevelGeometry tl = - 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) - ) 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 d7ae18b..0000000 --- a/rt/include/plugin.h +++ /dev/null @@ -1,190 +0,0 @@ -#ifndef _PLUGIN_H_ -#define _PLUGIN_H_ - -#include <dlfcn.h> -#include <linux/limits.h> -#include <pthread.h> -#include <stdint.h> -#include <wlr/types/wlr_input_device.h> -#include <wlr/types/wlr_keyboard.h> -#include <wlr/types/wlr_pointer.h> - -#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(<wlr/types/wlr_keyboard.h>) -EXPORT_INCLUDE(<wlr/types/wlr_input_device.h>) -EXPORT_INCLUDE(<wlr/types/wlr_pointer.h>) -// 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)( - struct wlr_pointer_motion_absolute_event *event, uint32_t modifiers, - 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/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/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 <ctype.h> -#include <dlfcn.h> -#include <pthread.h> -#include <stdio.h> -#include <stdlib.h> -#include <string.h> -#include <sys/stat.h> -#include <unistd.h> - -/* 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/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 <stdio.h>\n"; -print "#include <dlfcn.h>\n"; -print "#include <pthread.h>\n"; -print "#include <string.h>\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 = <STDIN>; - 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 <stdint.h>\n"; -print "\n#include <plugin_types.h>\n"; - -while (<STDIN>) { - 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 = <STDIN>; - 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"; |