[refactor] Change dragging behavior to use the motion event.

4 files changed, 22 insertions, 23 deletions

diff --git a/plug/src/Config.hs b/plug/src/Config.hs
index e80f360..5cf616f 100644
--- a/plug/src/Config.hs
+++ b/plug/src/Config.hs
@@ -50,6 +50,14 @@ instance StateExtension Dragging where
   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
 
@@ -58,8 +66,8 @@ onButton ev
   | buttonEvent_button ev /= leftButton = return ()
   | buttonEvent_state ev == ButtonPressed = do
       self <- getSelfPtr
+      CursorPosition (x, y) <- fromMaybe (CursorPosition (0, 0)) <$> xStateGet
       newDrag <- liftIO $ do
-        (x, y) <- getCursorPosition self
         tl <- foreign_toplevelAt (unwrapSelf self) (realToFrac x) (realToFrac y)
         if tl == nullPtr
           then return (Dragging Nothing)
@@ -74,13 +82,13 @@ onButton ev
   | otherwise = return ()
 
 onMotion :: MotionEvent -> Montis ()
-onMotion _ev = do
+onMotion ev = do
+  let (x, y) = motionEvent_absolute ev
+  xStatePut (CursorPosition (x, y))
   Dragging mdrag <- fromMaybe (Dragging Nothing) <$> xStateGet
   case mdrag of
     Nothing -> return ()
     Just (DragState tl dx dy) -> do
-      self <- getSelfPtr
-      (x, y) <- liftIO $ getCursorPosition self
       liftIO $
         foreign_setToplevelPosition
           tl
@@ -90,14 +98,6 @@ onMotion _ev = do
 unwrapSelf :: SelfPtr -> Ptr Void
 unwrapSelf (SelfPtr p) = p
 
-getCursorPosition :: SelfPtr -> IO (Double, Double)
-getCursorPosition self =
-  alloca $ \xPtr -> alloca $ \yPtr -> do
-    foreign_getCursorPosition (unwrapSelf self) xPtr yPtr
-    x <- peek xPtr
-    y <- peek yPtr
-    return (realToFrac (x :: CDouble), realToFrac (y :: CDouble))
-
 getToplevelPosition :: Ptr ForeignMontisToplevel -> IO (Double, Double)
 getToplevelPosition tl =
   alloca $ \xPtr -> alloca $ \yPtr -> do
diff --git a/plug/src/Montis/Base/Foreign/Runtime.hs b/plug/src/Montis/Base/Foreign/Runtime.hs
index 5c131f3..5797aa5 100644
--- a/plug/src/Montis/Base/Foreign/Runtime.hs
+++ b/plug/src/Montis/Base/Foreign/Runtime.hs
@@ -14,9 +14,6 @@ foreign import ccall "montis_do_request_exit" foreign_doRequestExit :: Ptr Void
 
 foreign import ccall "montis_plugin_get_seat" foreign_getSeat :: Ptr Void -> IO (Ptr Void)
 
-foreign import ccall "montis_plugin_get_cursor_position"
-  foreign_getCursorPosition :: Ptr Void -> Ptr CDouble -> Ptr CDouble -> IO ()
-
 foreign import ccall "montis_plugin_toplevel_at"
   foreign_toplevelAt :: Ptr Void -> CDouble -> CDouble -> IO (Ptr ForeignMontisToplevel)
 
diff --git a/plug/src/Montis/Core/Events.hs b/plug/src/Montis/Core/Events.hs
index cb74d6f..91b8618 100644
--- a/plug/src/Montis/Core/Events.hs
+++ b/plug/src/Montis/Core/Events.hs
@@ -31,7 +31,8 @@ data MotionEvent = MotionEvent
   { motionEvent_pointer :: WlrPointer,
     motionEvent_timeMs :: Word32,
     motionEvent_modifiers :: Word32,
-    motionEvent_absolute :: (Double, Double)
+    motionEvent_absolute :: (Double, Double),
+    motionEvent_raw :: (Double, Double)
   }
   deriving (Eq, Show, Ord)
 
diff --git a/plug/src/Montis/Core/Internal/Foreign/Export.hs b/plug/src/Montis/Core/Internal/Foreign/Export.hs
index 99ba58b..132273a 100644
--- a/plug/src/Montis/Core/Internal/Foreign/Export.hs
+++ b/plug/src/Montis/Core/Internal/Foreign/Export.hs
@@ -17,7 +17,7 @@ import Foreign
     mallocBytes,
     newStablePtr,
   )
-import Foreign.C (CChar, CInt (..))
+import Foreign.C (CChar, CDouble(..), CInt (..))
 import Foreign.Ptr (castPtr)
 import Montis.Base.Foreign.WlRoots.Types
   ( ForeignSurface (toSurface),
@@ -156,10 +156,10 @@ pluginHandleKeybinding inputDevicePtr eventPtr mods sym cp =
 -- Motion handler
 
 foreign export ccall "plugin_handle_motion"
-  pluginHandleMotion :: Ptr WlrPointerMotionAbsoluteEvent -> Word32 -> OpqStT -> IO OpqStT
+  pluginHandleMotion :: Ptr WlrPointerMotionAbsoluteEvent -> Word32 -> CDouble -> CDouble -> OpqStT -> IO OpqStT
 
-pluginHandleMotion :: Ptr WlrPointerMotionAbsoluteEvent -> Word32 -> OpqStT -> IO OpqStT
-pluginHandleMotion eventPtr modifiers =
+pluginHandleMotion :: Ptr WlrPointerMotionAbsoluteEvent -> Word32 -> CDouble -> CDouble -> OpqStT -> IO OpqStT
+pluginHandleMotion eventPtr modifiers lx ly =
   runForeign $ do
     s <- gets currentHooks
     event <- liftIO $
@@ -168,14 +168,15 @@ pluginHandleMotion eventPtr modifiers =
         pointerPtr <- demarshal :: Demarshal (Ptr ForeignWlrPointer)
         tMs <- demarshal
         _ <- demarshal :: Demarshal Word32
-        x <- demarshal
-        y <- demarshal
+        rawX <- demarshal
+        rawY <- demarshal
         return $
           MotionEvent
             (WlrPointer pointerPtr)
             tMs
             modifiers
-            (x, y)
+            (realToFrac lx, realToFrac ly)
+            (rawX, rawY)
 
     motionHook s event