aboutsummaryrefslogtreecommitdiff
path: root/src/Wetterhorn/Keys/MagicModifierKey.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Wetterhorn/Keys/MagicModifierKey.hs')
-rw-r--r--src/Wetterhorn/Keys/MagicModifierKey.hs50
1 files changed, 0 insertions, 50 deletions
diff --git a/src/Wetterhorn/Keys/MagicModifierKey.hs b/src/Wetterhorn/Keys/MagicModifierKey.hs
deleted file mode 100644
index 6bc8bb3..0000000
--- a/src/Wetterhorn/Keys/MagicModifierKey.hs
+++ /dev/null
@@ -1,50 +0,0 @@
-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)