[feat] add magic key for fake modifiers.HEADmain

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)
+                }
+          }