aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--plug/src/Config.hs93
-rw-r--r--plug/src/Montis/Base/Foreign/Runtime.hs3
-rw-r--r--plug/src/Montis/Standard/Drag.hs106
-rw-r--r--plug/src/Montis/Standard/Mouse.hs58
-rw-r--r--rt/include/util.h1
-rw-r--r--rt/src/util.c35
6 files changed, 208 insertions, 88 deletions
diff --git a/plug/src/Config.hs b/plug/src/Config.hs
index 7314604..fd337eb 100644
--- a/plug/src/Config.hs
+++ b/plug/src/Config.hs
@@ -2,17 +2,10 @@ module Config () where
import Control.Monad.IO.Class (liftIO)
import Data.Bits (shiftL, (.&.))
-import Data.Maybe (fromMaybe)
-import Data.Typeable (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.Standard.Drag (DragConfig (DragConfig))
+import Montis.Standard.Mouse (MouseConfig (MouseConfig))
import Montis.Standard.Keys (KeysConfig (KeysConfig), subkeys)
foreign export ccall "plugin_cold_start"
@@ -45,82 +38,6 @@ mod1Mask = 1 `shiftL` 3 -- WLR_MODIFIER_ALT
config :: MontisConfig
config =
- install (KeysConfig keys) $
- defaultConfig
- { startingHooks =
- (startingHooks defaultConfig)
- { buttonHook = onButton,
- motionHook = onMotion
- }
- }
-
-data DragState = DragState
- { dragToplevel :: Ptr ForeignMontisToplevel,
- dragOffsetX :: Double,
- dragOffsetY :: Double
- }
- deriving (Typeable)
-
-newtype Dragging = Dragging (Maybe DragState)
- deriving (Typeable)
-
-instance StateExtension Dragging where
- initialValue = Dragging Nothing
- marshalExtension _ = Nothing
- demarshalExtension _ = Nothing
-
-newtype CursorPosition = CursorPosition (Double, Double)
- deriving (Typeable)
-
-instance StateExtension CursorPosition where
- initialValue = CursorPosition (0, 0)
- marshalExtension _ = Nothing
- demarshalExtension _ = Nothing
-
-leftButton :: Word32
-leftButton = 272 -- BTN_LEFT
-
-onButton :: ButtonEvent -> Montis ()
-onButton ev
- | buttonEvent_button ev /= leftButton = return ()
- | buttonEvent_state ev == ButtonPressed = do
- self <- getSelfPtr
- CursorPosition (x, y) <- xStateGet
- newDrag <- liftIO $ do
- tl <- foreign_toplevelAt (unwrapSelf self) (realToFrac x) (realToFrac y)
- if tl == nullPtr
- then return (Dragging Nothing)
- else do
- (tx, ty) <- getToplevelPosition tl
- return $
- Dragging
- (Just (DragState tl (x - tx) (y - ty)))
- 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 (DragState tl dx dy) -> do
- liftIO $
- foreign_setToplevelPosition
- tl
- (realToFrac (x - dx))
- (realToFrac (y - dy))
-
-unwrapSelf :: SelfPtr -> Ptr Void
-unwrapSelf (SelfPtr p) = p
-
-getToplevelPosition :: Ptr ForeignMontisToplevel -> IO (Double, Double)
-getToplevelPosition tl =
- alloca $ \xPtr -> alloca $ \yPtr -> do
- foreign_getToplevelPosition tl xPtr yPtr
- x <- peek xPtr
- y <- peek yPtr
- return (realToFrac (x :: CDouble), realToFrac (y :: CDouble))
+ install MouseConfig $
+ install (DragConfig mod1Mask) $
+ install (KeysConfig keys) defaultConfig
diff --git a/plug/src/Montis/Base/Foreign/Runtime.hs b/plug/src/Montis/Base/Foreign/Runtime.hs
index 5797aa5..65ae53f 100644
--- a/plug/src/Montis/Base/Foreign/Runtime.hs
+++ b/plug/src/Montis/Base/Foreign/Runtime.hs
@@ -22,3 +22,6 @@ foreign import ccall "montis_plugin_get_toplevel_position"
foreign import ccall "montis_plugin_set_toplevel_position"
foreign_setToplevelPosition :: Ptr ForeignMontisToplevel -> CDouble -> CDouble -> IO ()
+
+foreign import ccall "montis_plugin_focus_toplevel"
+ foreign_focusToplevel :: Ptr ForeignMontisToplevel -> IO ()
diff --git a/plug/src/Montis/Standard/Drag.hs b/plug/src/Montis/Standard/Drag.hs
new file mode 100644
index 0000000..192ade8
--- /dev/null
+++ b/plug/src/Montis/Standard/Drag.hs
@@ -0,0 +1,106 @@
+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)
+
+newtype Dragging = Dragging (Maybe DragState)
+ deriving (Typeable)
+
+instance StateExtension Dragging where
+ initialValue = Dragging Nothing
+ marshalExtension _ = Nothing
+ demarshalExtension _ = Nothing
+
+leftButton :: Word32
+leftButton = 272 -- BTN_LEFT
+
+onButton :: Word32 -> ButtonEvent -> Montis ()
+onButton modMask ev
+ | buttonEvent_button ev /= leftButton = return ()
+ | buttonEvent_state ev == ButtonPressed = do
+ if buttonEvent_modifiers ev .&. modMask == 0
+ then return ()
+ else do
+ self <- getSelfPtr
+ CursorPosition (x, y) <- xStateGet
+ newDrag <- liftIO $ do
+ tl <- foreign_toplevelAt (unwrapSelf self) (realToFrac x) (realToFrac y)
+ if tl == nullPtr
+ then return (Dragging Nothing)
+ else do
+ (tx, ty) <- getToplevelPosition tl
+ return $
+ Dragging
+ (Just (DragState tl (x - tx) (y - ty)))
+ 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 (DragState tl dx dy) -> do
+ liftIO $
+ foreign_setToplevelPosition
+ tl
+ (realToFrac (x - dx))
+ (realToFrac (y - dy))
+
+unwrapSelf :: SelfPtr -> Ptr Void
+unwrapSelf (SelfPtr p) = p
+
+getToplevelPosition :: Ptr ForeignMontisToplevel -> IO (Double, Double)
+getToplevelPosition tl =
+ alloca $ \xPtr -> alloca $ \yPtr -> do
+ foreign_getToplevelPosition tl xPtr yPtr
+ x <- peek xPtr
+ y <- peek yPtr
+ return (realToFrac (x :: CDouble), realToFrac (y :: CDouble))
diff --git a/plug/src/Montis/Standard/Mouse.hs b/plug/src/Montis/Standard/Mouse.hs
new file mode 100644
index 0000000..b671206
--- /dev/null
+++ b/plug/src/Montis/Standard/Mouse.hs
@@ -0,0 +1,58 @@
+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.State
+ ( Config (startingHooks),
+ ConfigModule (..),
+ Hooks (buttonHook, motionHook),
+ StateExtension (..),
+ )
+
+data MouseConfig where
+ MouseConfig :: MouseConfig
+ deriving (Typeable)
+
+instance ConfigModule Montis MouseConfig where
+ alterConfig _ c =
+ let ohb = buttonHook (startingHooks c)
+ ohm = motionHook (startingHooks c)
+ in c
+ { startingHooks =
+ (startingHooks c)
+ { buttonHook = \ev -> onButton ev >> ohb ev,
+ motionHook = \ev -> onMotion ev >> ohm ev
+ }
+ }
+
+newtype CursorPosition = CursorPosition (Double, Double)
+ deriving (Typeable)
+
+instance StateExtension CursorPosition where
+ initialValue = CursorPosition (0, 0)
+ marshalExtension _ = Nothing
+ demarshalExtension _ = Nothing
+
+onMotion :: MotionEvent -> Montis ()
+onMotion ev = do
+ let (x, y) = motionEvent_absolute ev
+ xStatePut (CursorPosition (x, y))
+
+onButton :: ButtonEvent -> Montis ()
+onButton ev
+ | buttonEvent_state ev /= ButtonPressed = return ()
+ | otherwise = do
+ 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
diff --git a/rt/include/util.h b/rt/include/util.h
index b477113..a9c290d 100644
--- a/rt/include/util.h
+++ b/rt/include/util.h
@@ -9,5 +9,6 @@
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_focus_toplevel(void *toplevel);
#endif /* MONTIS_UTIL_H */
diff --git a/rt/src/util.c b/rt/src/util.c
index 6576770..66a2b20 100644
--- a/rt/src/util.c
+++ b/rt/src/util.c
@@ -2,6 +2,7 @@
#include "wl.h"
#include <wlr/types/wlr_scene.h>
+#include <wlr/types/wlr_xdg_shell.h>
static struct montis_server *server_from_ctx(void *ctx)
{
@@ -61,3 +62,37 @@ void montis_plugin_set_toplevel_position(void *toplevel, double x, double y)
struct montis_toplevel *tl = toplevel;
wlr_scene_node_set_position(&tl->scene_tree->node, (int)x, (int)y);
}
+
+void montis_plugin_focus_toplevel(void *toplevel)
+{
+ if (!toplevel) {
+ return;
+ }
+ struct montis_toplevel *tl = toplevel;
+ struct montis_server *server = tl->server;
+ struct wlr_seat *seat = server->seat;
+ struct wlr_surface *surface = tl->xdg_toplevel->base->surface;
+ struct wlr_surface *prev_surface = seat->keyboard_state.focused_surface;
+
+ if (prev_surface == surface) {
+ return;
+ }
+ if (prev_surface) {
+ struct wlr_xdg_toplevel *prev_toplevel =
+ wlr_xdg_toplevel_try_from_wlr_surface(prev_surface);
+ if (prev_toplevel != NULL) {
+ wlr_xdg_toplevel_set_activated(prev_toplevel, false);
+ }
+ }
+
+ struct wlr_keyboard *keyboard = wlr_seat_get_keyboard(seat);
+ wlr_scene_node_raise_to_top(&tl->scene_tree->node);
+ wl_list_remove(&tl->link);
+ wl_list_insert(&server->toplevels, &tl->link);
+ wlr_xdg_toplevel_set_activated(tl->xdg_toplevel, true);
+ if (keyboard != NULL) {
+ wlr_seat_keyboard_notify_enter(seat, surface, keyboard->keycodes,
+ keyboard->num_keycodes,
+ &keyboard->modifiers);
+ }
+}
generated by cgit (git 2.34.1) at 2026-01-09 20:02:36 +0000