diff options
| -rw-r--r-- | montis/src/Config.hs | 15 | ||||
| -rw-r--r-- | montis/src/Montis/Standard/Bindings.hs | 2 | ||||
| -rw-r--r-- | montis/src/Montis/Standard/Bindings/MagicKey.hs | 86 |
3 files changed, 96 insertions, 7 deletions
diff --git a/montis/src/Config.hs b/montis/src/Config.hs index 5ba1c40..183889b 100644 --- a/montis/src/Config.hs +++ b/montis/src/Config.hs @@ -5,6 +5,7 @@ import Data.Word (Word32) import Montis.Core import Montis.Standard.Bindings.Button import Montis.Standard.Bindings.Dsl +import Montis.Standard.Bindings.MagicKey (MagicKeyConfig (MagicKeyConfig), Magic (Magic)) import Montis.Standard.Drag import Montis.Standard.Mouse (MouseConfig (MouseConfig)) @@ -18,9 +19,10 @@ keyBindings = Bind (Mod1 .+ 'q') requestExit, Bind (Mod1 .+ 's') (\(keyEvent :: KeyEvent) -> mio (print keyEvent)), Bind (Mod1 .+ 'S') (\(keyEvent :: KeyEvent) -> mio (print keyEvent)), - Bind (Mod1 .+ btnLeft) startWindowMove, - Bind (Mod1 .+ btnRight) startWindowResize, - Bind (Mod1 .+ btnMiddle) (\(buttonEvent :: ButtonEvent) -> mio (print buttonEvent)) + Bind (Magic .+ 's') (mio $ putStrLn "Did Some Magic!"), + Bind (Magic .+ btnLeft) startWindowMove, + Bind (Magic .+ btnRight) startWindowResize, + Bind (Magic .+ btnMiddle) (\(buttonEvent :: ButtonEvent) -> mio (print buttonEvent)) ] mod1Mask :: Word32 @@ -28,6 +30,7 @@ mod1Mask = 1 `shiftL` 3 -- WLR_MODIFIER_ALT config :: MontisConfig config = - install MouseConfig $ - install DragConfig $ - withBindings keyBindings defaultConfig + install (MagicKeyConfig '\t') $ + install MouseConfig $ + install DragConfig $ + withBindings keyBindings defaultConfig diff --git a/montis/src/Montis/Standard/Bindings.hs b/montis/src/Montis/Standard/Bindings.hs index 7905b4b..fea7a03 100644 --- a/montis/src/Montis/Standard/Bindings.hs +++ b/montis/src/Montis/Standard/Bindings.hs @@ -61,7 +61,7 @@ instance ConfigModule Montis InputsConfig where { startingHooks = (startingHooks c) { keyHook = \ev -> runEv (InputEvent (Left ev)) >> oh ev, - buttonHook = \ev -> liftIO (putStrLn $ "Is it working? " ++ show ev) >> runEv (InputEvent (Right ev)) >> obh ev + buttonHook = \ev -> runEv (InputEvent (Right ev)) >> obh ev } } where diff --git a/montis/src/Montis/Standard/Bindings/MagicKey.hs b/montis/src/Montis/Standard/Bindings/MagicKey.hs new file mode 100644 index 0000000..a52431f --- /dev/null +++ b/montis/src/Montis/Standard/Bindings/MagicKey.hs @@ -0,0 +1,86 @@ +module Montis.Standard.Bindings.MagicKey where + +import Control.Monad (unless, when) +import Data.Data (Typeable) +import Data.Word (Word32) +import Montis.Core +import Montis.Standard.Bindings (forwardKeyToSeat) +import Montis.Standard.Bindings.Dsl + +data MagicKeyConfig where + MagicKeyConfig :: + { magicKeyCodepoint :: Char + } -> + MagicKeyConfig + deriving (Typeable) + +data MagicKeyState where + MagicKeyState :: + { magicActive :: Bool, + magicPressedAt :: Maybe Word32, + magicPressEvent :: Maybe KeyEvent, + magicInterrupted :: Bool + } -> + MagicKeyState + deriving (Typeable) + +data Magic = Magic + +instance StateExtension MagicKeyState where + initialValue = MagicKeyState False Nothing Nothing False + marshalExtension _ = Nothing + demarshalExtension _ = Nothing + +instance InputMatch Magic where + matches _ _ = do + MagicKeyState {magicActive} <- xStateGet + return magicActive + +markInterrupted :: MagicKeyState -> MagicKeyState +markInterrupted st@MagicKeyState {magicActive} + | magicActive = st {magicInterrupted = True} + | otherwise = st + +emitTap :: KeyEvent -> KeyEvent -> Montis () +emitTap pressEv releaseEv = do + forwardKeyToSeat pressEv + forwardKeyToSeat releaseEv + +handleMagicKey :: Char -> KeyEvent -> Montis Bool +handleMagicKey magicKey ev + | keyEvent_codepoint ev == magicKey = + case keyEvent_state ev of + KeyPressed -> do + xStatePut $ + MagicKeyState + True + (Just (keyEvent_timeMs ev)) + (Just ev) + False + return True + KeyReleased -> do + MagicKeyState _ pressAt pressEv interrupted <- xStateGet + xStatePut (MagicKeyState False Nothing Nothing False) + case (pressAt, pressEv) of + (Just t0, Just pev) -> do + let t1 = keyEvent_timeMs ev + if not interrupted && t1 >= t0 && t1 - t0 <= 200 + then emitTap pev ev >> return True + else return True + _ -> return True + | otherwise = do + when (keyEvent_state ev == KeyPressed) $ + xStateModify markInterrupted + return False + +instance ConfigModule Montis MagicKeyConfig where + alterConfig cfg c = + let okh = keyHook (startingHooks c) + in c + { startingHooks = + (startingHooks c) + { keyHook = \ev -> do + handled <- handleMagicKey (magicKeyCodepoint cfg) ev + unless handled (okh ev) + } + } |