blob: f9b87eb0d3eff61538b9a3fd5c8e9a41d2804555 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
|
{-# OPTIONS_GHC -Wno-missing-export-lists #-}
module Montis.Keys.MagicModifierKey where
import Control.Monad.RWS (MonadTrans (lift))
import Control.Monad.Trans.Maybe (MaybeT (..))
import Data.Data
import Data.Default.Class
import GHC.TypeNats
import Montis.Core.KeyEvent
import Montis.Core.W
import Montis.Dsl.Input
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)
|
