montis/src/Montis/Standard/Bindings/MagicKey.hs


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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
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)
                }
          }