blob: 37f4db43ecfffd698818a6068af4ddf8fb4287cd (
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
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
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
-- There are constraints used for better type-level enforced safety rules.
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
module Montis.Keys.Macros
( MacroSupport,
macroStartStopKeybind,
macroReplayKeybind,
stopMacroRecording,
startRecording,
)
where
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Trans (MonadTrans (lift))
import Data.Default.Class
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Type.Bool
import Data.Type.Equality
import Data.Word
import Foreign (Ptr)
import GHC.TypeError
import Montis.Core.KeyEvent
import Montis.Core.W
import Montis.Dsl.Input
import Montis.Foreign.WlRoots (WlrInputDevice)
data RecordedKey = RecordedKey Word32 Word32 KeyState Word32 Word32 Char
deriving (Read, Show)
data MacrosState = MacrosState
{ macros :: Map String [RecordedKey],
currentlyRecording :: Maybe String
}
deriving (Read, Show)
instance Default MacrosState where
def = MacrosState mempty def
instance ExtensionClass MacrosState
type family Find a ls where
Find b (a : t) = (b == a) || Find b t
Find _ '[] = False
-- | Provides a Vim-esque keybinding behavior for macro recording.
--
-- Designed to be used like:
--
-- bind ev (Mod1 .+ 'q') macroStartStopKeybind
macroStartStopKeybind :: (HasMacroSupport spy) => InputM spy ()
macroStartStopKeybind = do
currentlyRecordingMacro
>>= ( \case
Just ch -> do
liftIO $ putStrLn $ "Done Recording: " ++ ch
stopMacroRecording
Nothing -> do
(InputKeyEvent (KeyEvent {codepoint = cp})) <- nextInputPressEvent
liftIO $ putStrLn $ "Recording: " ++ [cp]
startRecording [cp]
)
-- | Provides a keybinding for replaying a macro.
--
-- Designed to be used like:
--
-- bind ev (weak $ Mod1 .+ '@') macroReplayKeybind
macroReplayKeybind :: (HasMacroSupport spy) => InputM spy ()
macroReplayKeybind = do
( InputKeyEvent
(KeyEvent {codepoint = cp, device = device})
) <-
nextInputPressEvent
replayMacro device [cp]
startRecording :: (Wlike m) => String -> m ()
startRecording ch =
xmodify
( \m@MacrosState {macros = macros} ->
m
{ macros = Map.delete ch macros,
currentlyRecording = Just ch
}
)
stopMacroRecording :: (Wlike m) => m ()
stopMacroRecording = xmodify (\m -> m {currentlyRecording = Nothing})
currentlyRecordingMacro :: (Wlike m) => m (Maybe String)
currentlyRecordingMacro = xgets currentlyRecording
replayMacro :: Ptr WlrInputDevice -> String -> InputM spy ()
replayMacro inputDevice s = do
m <- liftW (Map.lookup s <$> xgets macros)
-- 'tail' is to cut off the last keystroke which stops the recording.
mapM_ (replayEvents . map toInputEvent . reverse . tail) m
where
toInputEvent :: RecordedKey -> InputEvent
toInputEvent (RecordedKey ts kc st mo keysym cp) =
InputKeyEvent $ KeyEvent ts kc st mo keysym cp inputDevice
pushMacroKey :: (Wlike m) => KeyEvent -> m ()
pushMacroKey ke = do
cur <- xgets currentlyRecording
whenJust cur $ \ch -> do
let recordedKey = toRecordedKey ke
in xmodify $ \m@MacrosState {macros = macros} ->
m {macros = Map.insertWith (++) ch [recordedKey] macros}
where
whenJust (Just a) fn = fn a
whenJust _ _ = return ()
toRecordedKey (KeyEvent ts c s m keysym cp _) = RecordedKey ts c s m keysym cp
-- | Phantom type defining a proxy required to support macros.
data MacroSupport
-- | Instance for macro support.
instance InputProxy MacroSupport where
onKeyEvent _ ie = do
lift $ whenKeyEvent ie pushMacroKey
return ie
class HasMacroSupport t
instance
( If
(Find MacroSupport t)
True
( TypeError
( Text "This Requires the Macro Proxy to be Enabled."
:<>: Text "Please enable this by adding MacroSupport to your"
:<>: Text "inputProxies list.\n"
:<>: Text "i.e. Change "
:<>: ShowType t
:<>: Text " to "
:<>: ShowType (MacroSupport ': t)
)
)
~ True
) =>
HasMacroSupport t
instance HasMacroSupport MacroSupport
|
