[feat] add focusing and better dragging.

1 files changed, 5 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