aboutsummaryrefslogtreecommitdiff
path: root/plug/src/Config.hs
diff options
context:
space:
mode:
Diffstat (limited to 'plug/src/Config.hs')
-rw-r--r--plug/src/Config.hs93
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