1 files changed, 50 insertions, 0 deletions
diff --git a/plug/src/Wetterhorn/Keys/MagicModifierKey.hs b/plug/src/Wetterhorn/Keys/MagicModifierKey.hs
new file mode 100644
index 0000000..6bc8bb3
--- /dev/null
+++ b/plug/src/Wetterhorn/Keys/MagicModifierKey.hs
@@ -0,0 +1,50 @@
+module Wetterhorn.Keys.MagicModifierKey where
+
+import Data.Data
+import Data.Default.Class
+import GHC.TypeNats
+import Wetterhorn.Core.KeyEvent
+import Wetterhorn.Core.W
+import Wetterhorn.Dsl.Bind
+import Wetterhorn.Dsl.Input
+import Control.Monad.RWS (MonadTrans(lift))
+import Control.Monad.Trans.Maybe (MaybeT(..))
+
+data MagicModifierProxy (keycode :: Natural) inputproxy
+  deriving (Typeable)
+
+newtype MagicModifierState (keycode :: Natural) = MagicModifierState {isPressed :: Bool}
+  deriving (Typeable, Eq, Show, Ord, Read)
+
+instance Default (MagicModifierState k) where
+  def = MagicModifierState False
+
+instance (KnownNat k) => ExtensionClass (MagicModifierState k)
+
+instance
+  (KnownNat keycode, InputProxy inputproxy) =>
+  InputProxy (MagicModifierProxy keycode inputproxy)
+  where
+  onKeyEvent proxy ie = do
+    case ie of
+      (InputKeyEvent (KeyEvent {keycode = kc, state = state}))
+        | fromIntegral kc == natVal (keycodeProxy proxy) -> do
+          lift $ setMagicModifierPressed proxy (state == KeyPressed)
+          MaybeT (return Nothing)
+      _ -> do
+        pressed <- lift $ isMagicModifierPressed proxy
+        if pressed
+          then onKeyEvent (Proxy :: Proxy inputproxy) ie
+          else return ie
+    where
+      keycodeProxy :: Proxy (MagicModifierProxy kc a) -> Proxy kc
+      keycodeProxy _ = Proxy
+
+      isMagicModifierPressed p = isPressed <$> getModState p
+      setMagicModifierPressed p = modifyModState p . const
+
+      getModState :: (KnownNat kc) => Proxy (MagicModifierProxy kc a) -> W (MagicModifierState kc)
+      getModState _ = xget
+
+      modifyModState :: (KnownNat kc) => Proxy (MagicModifierProxy kc a) -> (MagicModifierState kc -> Bool) -> W ()
+      modifyModState _ fn = xmodify (MagicModifierState . fn)