module KMonad.Button
(
Button
, HasButton(..)
, onPress
, mkButton
, around
, tapOn
, emitB
, modded
, layerToggle
, layerSwitch
, layerAdd
, layerRem
, pass
, cmdButton
, aroundNext
, layerDelay
, layerNext
, tapHold
, multiTap
, tapNext
, tapHoldNext
, tapNextRelease
, tapHoldNextRelease
, tapMacro
)
where
import KMonad.Prelude
import KMonad.Action
import KMonad.Keyboard
import KMonad.Util
data Button = Button
{ Button -> Action
_pressAction :: !Action
, Button -> Action
_releaseAction :: !Action
}
makeClassy ''Button
mkButton :: AnyK () -> AnyK () -> Button
mkButton :: AnyK () -> AnyK () -> Button
mkButton a :: AnyK ()
a b :: AnyK ()
b = Action -> Action -> Button
Button (AnyK () -> Action
Action AnyK ()
a) (AnyK () -> Action
Action AnyK ()
b)
onPress :: AnyK () -> Button
onPress :: AnyK () -> Button
onPress p :: AnyK ()
p = AnyK () -> AnyK () -> Button
mkButton AnyK ()
p (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
tap :: MonadK m => Button -> m ()
tap :: Button -> m ()
tap b :: Button
b = do
Action -> m ()
Action -> AnyK ()
runAction (Action -> m ()) -> Action -> m ()
forall a b. (a -> b) -> a -> b
$ Button
bButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
pressAction
Action -> m ()
Action -> AnyK ()
runAction (Action -> m ()) -> Action -> m ()
forall a b. (a -> b) -> a -> b
$ Button
bButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
releaseAction
press :: MonadK m => Button -> m ()
press :: Button -> m ()
press b :: Button
b = do
Action -> m ()
Action -> AnyK ()
runAction (Action -> m ()) -> Action -> m ()
forall a b. (a -> b) -> a -> b
$ Button
bButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
pressAction
Switch -> m Catch -> m ()
forall (m :: * -> *). MonadK m => Switch -> m Catch -> m ()
awaitMy Switch
Release (m Catch -> m ()) -> m Catch -> m ()
forall a b. (a -> b) -> a -> b
$ do
Action -> m ()
Action -> AnyK ()
runAction (Action -> m ()) -> Action -> m ()
forall a b. (a -> b) -> a -> b
$ Button
bButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
releaseAction
Catch -> m Catch
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
Catch
emitB :: Keycode -> Button
emitB :: Keycode -> Button
emitB c :: Keycode
c = AnyK () -> AnyK () -> Button
mkButton
(KeyEvent -> m ()
forall (m :: * -> *). MonadKIO m => KeyEvent -> m ()
emit (KeyEvent -> m ()) -> KeyEvent -> m ()
forall a b. (a -> b) -> a -> b
$ Keycode -> KeyEvent
mkPress Keycode
c)
(KeyEvent -> m ()
forall (m :: * -> *). MonadKIO m => KeyEvent -> m ()
emit (KeyEvent -> m ()) -> KeyEvent -> m ()
forall a b. (a -> b) -> a -> b
$ Keycode -> KeyEvent
mkRelease Keycode
c)
modded ::
Keycode
-> Button
-> Button
modded :: Keycode -> Button -> Button
modded modder :: Keycode
modder = Button -> Button -> Button
around (Keycode -> Button
emitB Keycode
modder)
layerToggle :: LayerTag -> Button
layerToggle :: LayerTag -> Button
layerToggle t :: LayerTag
t = AnyK () -> AnyK () -> Button
mkButton
(LayerOp -> m ()
forall (m :: * -> *). MonadKIO m => LayerOp -> m ()
layerOp (LayerOp -> m ()) -> LayerOp -> m ()
forall a b. (a -> b) -> a -> b
$ LayerTag -> LayerOp
PushLayer LayerTag
t)
(LayerOp -> m ()
forall (m :: * -> *). MonadKIO m => LayerOp -> m ()
layerOp (LayerOp -> m ()) -> LayerOp -> m ()
forall a b. (a -> b) -> a -> b
$ LayerTag -> LayerOp
PopLayer LayerTag
t)
layerSwitch :: LayerTag -> Button
layerSwitch :: LayerTag -> Button
layerSwitch t :: LayerTag
t = AnyK () -> Button
onPress (LayerOp -> m ()
forall (m :: * -> *). MonadKIO m => LayerOp -> m ()
layerOp (LayerOp -> m ()) -> LayerOp -> m ()
forall a b. (a -> b) -> a -> b
$ LayerTag -> LayerOp
SetBaseLayer LayerTag
t)
layerAdd :: LayerTag -> Button
layerAdd :: LayerTag -> Button
layerAdd t :: LayerTag
t = AnyK () -> Button
onPress (LayerOp -> m ()
forall (m :: * -> *). MonadKIO m => LayerOp -> m ()
layerOp (LayerOp -> m ()) -> LayerOp -> m ()
forall a b. (a -> b) -> a -> b
$ LayerTag -> LayerOp
PushLayer LayerTag
t)
layerRem :: LayerTag -> Button
layerRem :: LayerTag -> Button
layerRem t :: LayerTag
t = AnyK () -> Button
onPress (LayerOp -> m ()
forall (m :: * -> *). MonadKIO m => LayerOp -> m ()
layerOp (LayerOp -> m ()) -> LayerOp -> m ()
forall a b. (a -> b) -> a -> b
$ LayerTag -> LayerOp
PopLayer LayerTag
t)
pass :: Button
pass :: Button
pass = AnyK () -> Button
onPress (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
cmdButton :: Text -> Button
cmdButton :: LayerTag -> Button
cmdButton t :: LayerTag
t = AnyK () -> Button
onPress (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ LayerTag -> m ()
forall (m :: * -> *). MonadKIO m => LayerTag -> m ()
shellCmd LayerTag
t
around ::
Button
-> Button
-> Button
around :: Button -> Button -> Button
around outer :: Button
outer inner :: Button
inner = Action -> Action -> Button
Button
(AnyK () -> Action
Action (Action -> AnyK ()
runAction (Button
outerButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
pressAction) m () -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Action -> AnyK ()
runAction (Button
innerButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
pressAction)))
(AnyK () -> Action
Action (Action -> AnyK ()
runAction (Button
innerButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
releaseAction) m () -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Action -> AnyK ()
runAction (Button
outerButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
releaseAction)))
aroundNext ::
Button
-> Button
aroundNext :: Button -> Button
aroundNext b :: Button
b = AnyK () -> Button
onPress (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ KeyPred -> (KeyEvent -> m Catch) -> m ()
forall (m :: * -> *).
MonadKIO m =>
KeyPred -> (KeyEvent -> m Catch) -> m ()
await KeyPred
isPress ((KeyEvent -> m Catch) -> m ()) -> (KeyEvent -> m Catch) -> m ()
forall a b. (a -> b) -> a -> b
$ \e :: KeyEvent
e -> do
Action -> m ()
Action -> AnyK ()
runAction (Action -> m ()) -> Action -> m ()
forall a b. (a -> b) -> a -> b
$ Button
bButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
pressAction
KeyPred -> (KeyEvent -> m Catch) -> m ()
forall (m :: * -> *).
MonadKIO m =>
KeyPred -> (KeyEvent -> m Catch) -> m ()
await (Keycode -> KeyPred
isReleaseOf (Keycode -> KeyPred) -> Keycode -> KeyPred
forall a b. (a -> b) -> a -> b
$ KeyEvent
eKeyEvent -> Getting Keycode KeyEvent Keycode -> Keycode
forall s a. s -> Getting a s a -> a
^.Getting Keycode KeyEvent Keycode
Lens' KeyEvent Keycode
keycode) ((KeyEvent -> m Catch) -> m ()) -> (KeyEvent -> m Catch) -> m ()
forall a b. (a -> b) -> a -> b
$ \_ -> do
Action -> m ()
Action -> AnyK ()
runAction (Action -> m ()) -> Action -> m ()
forall a b. (a -> b) -> a -> b
$ Button
bButton -> Getting Action Button Action -> Action
forall s a. s -> Getting a s a -> a
^.Getting Action Button Action
forall c. HasButton c => Lens' c Action
releaseAction
Catch -> m Catch
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
NoCatch
Catch -> m Catch
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
NoCatch
tapOn ::
Switch
-> Button
-> Button
tapOn :: Switch -> Button -> Button
tapOn Press b :: Button
b = AnyK () -> AnyK () -> Button
mkButton (Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
tap Button
b) (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
tapOn Release b :: Button
b = AnyK () -> AnyK () -> Button
mkButton (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
tap Button
b)
tapHold :: Milliseconds -> Button -> Button -> Button
tapHold :: Milliseconds -> Button -> Button -> Button
tapHold ms :: Milliseconds
ms t :: Button
t h :: Button
h = AnyK () -> Button
onPress (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ Milliseconds -> m KeyPred -> m () -> (Trigger -> m Catch) -> m ()
forall (m :: * -> *).
MonadK m =>
Milliseconds -> m KeyPred -> m () -> (Trigger -> m Catch) -> m ()
withinHeld Milliseconds
ms (Switch -> m KeyPred
forall (m :: * -> *). MonadK m => Switch -> m KeyPred
matchMy Switch
Release)
(Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
press Button
h)
(m Catch -> Trigger -> m Catch
forall a b. a -> b -> a
const (m Catch -> Trigger -> m Catch) -> m Catch -> Trigger -> m Catch
forall a b. (a -> b) -> a -> b
$ Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
tap Button
t m () -> m Catch -> m Catch
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Catch -> m Catch
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
Catch)
tapNext :: Button -> Button -> Button
tapNext :: Button -> Button -> Button
tapNext t :: Button
t h :: Button
h = AnyK () -> Button
onPress (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ HookLocation -> (KeyEvent -> m Catch) -> m ()
forall (m :: * -> *).
MonadKIO m =>
HookLocation -> (KeyEvent -> m Catch) -> m ()
hookF HookLocation
InputHook ((KeyEvent -> m Catch) -> m ()) -> (KeyEvent -> m Catch) -> m ()
forall a b. (a -> b) -> a -> b
$ \e :: KeyEvent
e -> do
KeyPred
p <- Switch -> m KeyPred
forall (m :: * -> *). MonadK m => Switch -> m KeyPred
matchMy Switch
Release
if KeyPred
p KeyEvent
e
then Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
tap Button
t m () -> m Catch -> m Catch
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Catch -> m Catch
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
Catch
else Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
press Button
h m () -> m Catch -> m Catch
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Catch -> m Catch
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
NoCatch
tapHoldNext :: Milliseconds -> Button -> Button -> Button
tapHoldNext :: Milliseconds -> Button -> Button -> Button
tapHoldNext ms :: Milliseconds
ms t :: Button
t h :: Button
h = AnyK () -> Button
onPress (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ Milliseconds -> m KeyPred -> m () -> (Trigger -> m Catch) -> m ()
forall (m :: * -> *).
MonadK m =>
Milliseconds -> m KeyPred -> m () -> (Trigger -> m Catch) -> m ()
within Milliseconds
ms (KeyPred -> m KeyPred
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeyPred -> m KeyPred) -> KeyPred -> m KeyPred
forall a b. (a -> b) -> a -> b
$ Bool -> KeyPred
forall a b. a -> b -> a
const Bool
True) (Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
press Button
h) ((Trigger -> m Catch) -> m ()) -> (Trigger -> m Catch) -> m ()
forall a b. (a -> b) -> a -> b
$ \tr :: Trigger
tr -> do
KeyPred
p <- Switch -> m KeyPred
forall (m :: * -> *). MonadK m => Switch -> m KeyPred
matchMy Switch
Release
if KeyPred
p KeyPred -> KeyPred
forall a b. (a -> b) -> a -> b
$ Trigger
trTrigger -> Getting KeyEvent Trigger KeyEvent -> KeyEvent
forall s a. s -> Getting a s a -> a
^.Getting KeyEvent Trigger KeyEvent
forall c. HasTrigger c => Lens' c KeyEvent
event
then Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
tap Button
t m () -> m Catch -> m Catch
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Catch -> m Catch
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
Catch
else Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
press Button
h m () -> m Catch -> m Catch
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Catch -> m Catch
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
NoCatch
tapNextRelease :: Button -> Button -> Button
tapNextRelease :: Button -> Button -> Button
tapNextRelease t :: Button
t h :: Button
h = AnyK () -> Button
onPress (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ do
Bool -> m ()
forall (m :: * -> *). MonadKIO m => Bool -> m ()
hold Bool
True
[Keycode] -> m ()
forall (m :: * -> *). MonadK m => [Keycode] -> m ()
go []
where
go :: MonadK m => [Keycode] -> m ()
go :: [Keycode] -> m ()
go ks :: [Keycode]
ks = HookLocation -> (KeyEvent -> m Catch) -> m ()
forall (m :: * -> *).
MonadKIO m =>
HookLocation -> (KeyEvent -> m Catch) -> m ()
hookF HookLocation
InputHook ((KeyEvent -> m Catch) -> m ()) -> (KeyEvent -> m Catch) -> m ()
forall a b. (a -> b) -> a -> b
$ \e :: KeyEvent
e -> do
KeyPred
p <- Switch -> m KeyPred
forall (m :: * -> *). MonadK m => Switch -> m KeyPred
matchMy Switch
Release
let isRel :: Bool
isRel = KeyPred
isRelease KeyEvent
e
if
| KeyPred
p KeyEvent
e -> m Catch
forall (m :: * -> *). MonadK m => m Catch
doTap
| Bool
isRel Bool -> Bool -> Bool
&& (KeyEvent
eKeyEvent -> Getting Keycode KeyEvent Keycode -> Keycode
forall s a. s -> Getting a s a -> a
^.Getting Keycode KeyEvent Keycode
Lens' KeyEvent Keycode
keycode Keycode -> [Keycode] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Keycode]
ks) -> KeyEvent -> m Catch
forall (m :: * -> *). MonadK m => KeyEvent -> m Catch
doHold KeyEvent
e
| Bool -> Bool
not Bool
isRel -> [Keycode] -> m ()
forall (m :: * -> *). MonadK m => [Keycode] -> m ()
go ((KeyEvent
eKeyEvent -> Getting Keycode KeyEvent Keycode -> Keycode
forall s a. s -> Getting a s a -> a
^.Getting Keycode KeyEvent Keycode
Lens' KeyEvent Keycode
keycode)Keycode -> [Keycode] -> [Keycode]
forall a. a -> [a] -> [a]
:[Keycode]
ks) m () -> m Catch -> m Catch
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Catch -> m Catch
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
NoCatch
| Bool
otherwise -> [Keycode] -> m ()
forall (m :: * -> *). MonadK m => [Keycode] -> m ()
go [Keycode]
ks m () -> m Catch -> m Catch
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Catch -> m Catch
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
NoCatch
doTap :: MonadK m => m Catch
doTap :: m Catch
doTap = Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
tap Button
t m () -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> m ()
forall (m :: * -> *). MonadKIO m => Bool -> m ()
hold Bool
False m () -> m Catch -> m Catch
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Catch -> m Catch
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
Catch
doHold :: MonadK m => KeyEvent -> m Catch
doHold :: KeyEvent -> m Catch
doHold e :: KeyEvent
e = Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
press Button
h m () -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> m ()
forall (m :: * -> *). MonadKIO m => Bool -> m ()
hold Bool
False m () -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> KeyEvent -> m ()
forall (m :: * -> *). MonadKIO m => KeyEvent -> m ()
inject KeyEvent
e m () -> m Catch -> m Catch
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Catch -> m Catch
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
Catch
tapHoldNextRelease :: Milliseconds -> Button -> Button -> Button
tapHoldNextRelease :: Milliseconds -> Button -> Button -> Button
tapHoldNextRelease ms :: Milliseconds
ms t :: Button
t h :: Button
h = AnyK () -> Button
onPress (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ do
Bool -> m ()
forall (m :: * -> *). MonadKIO m => Bool -> m ()
hold Bool
True
Milliseconds -> [Keycode] -> m ()
forall (m :: * -> *). MonadK m => Milliseconds -> [Keycode] -> m ()
go Milliseconds
ms []
where
go :: MonadK m => Milliseconds -> [Keycode] -> m ()
go :: Milliseconds -> [Keycode] -> m ()
go ms' :: Milliseconds
ms' ks :: [Keycode]
ks = HookLocation
-> Milliseconds -> m () -> (Trigger -> m Catch) -> m ()
forall (m :: * -> *).
MonadK m =>
HookLocation
-> Milliseconds -> m () -> (Trigger -> m Catch) -> m ()
tHookF HookLocation
InputHook Milliseconds
ms' m ()
AnyK ()
onTimeout ((Trigger -> m Catch) -> m ()) -> (Trigger -> m Catch) -> m ()
forall a b. (a -> b) -> a -> b
$ \r :: Trigger
r -> do
KeyPred
p <- Switch -> m KeyPred
forall (m :: * -> *). MonadK m => Switch -> m KeyPred
matchMy Switch
Release
let e :: KeyEvent
e = Trigger
rTrigger -> Getting KeyEvent Trigger KeyEvent -> KeyEvent
forall s a. s -> Getting a s a -> a
^.Getting KeyEvent Trigger KeyEvent
forall c. HasTrigger c => Lens' c KeyEvent
event
let isRel :: Bool
isRel = KeyPred
isRelease KeyEvent
e
if
| KeyPred
p KeyEvent
e -> m Catch
forall (m :: * -> *). MonadK m => m Catch
onRelSelf
| Bool
isRel Bool -> Bool -> Bool
&& (KeyEvent
eKeyEvent -> Getting Keycode KeyEvent Keycode -> Keycode
forall s a. s -> Getting a s a -> a
^.Getting Keycode KeyEvent Keycode
Lens' KeyEvent Keycode
keycode Keycode -> [Keycode] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Keycode]
ks) -> KeyEvent -> m Catch
forall (m :: * -> *). MonadK m => KeyEvent -> m Catch
onRelOther KeyEvent
e
| Bool -> Bool
not Bool
isRel -> Milliseconds -> [Keycode] -> m ()
forall (m :: * -> *). MonadK m => Milliseconds -> [Keycode] -> m ()
go (Milliseconds
ms' Milliseconds -> Milliseconds -> Milliseconds
forall a. Num a => a -> a -> a
- Trigger
rTrigger
-> Getting Milliseconds Trigger Milliseconds -> Milliseconds
forall s a. s -> Getting a s a -> a
^.Getting Milliseconds Trigger Milliseconds
forall c. HasTrigger c => Lens' c Milliseconds
elapsed) (KeyEvent
eKeyEvent -> Getting Keycode KeyEvent Keycode -> Keycode
forall s a. s -> Getting a s a -> a
^.Getting Keycode KeyEvent Keycode
Lens' KeyEvent Keycode
keycode Keycode -> [Keycode] -> [Keycode]
forall a. a -> [a] -> [a]
: [Keycode]
ks) m () -> m Catch -> m Catch
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Catch -> m Catch
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
NoCatch
| Bool
otherwise -> Milliseconds -> [Keycode] -> m ()
forall (m :: * -> *). MonadK m => Milliseconds -> [Keycode] -> m ()
go (Milliseconds
ms' Milliseconds -> Milliseconds -> Milliseconds
forall a. Num a => a -> a -> a
- Trigger
rTrigger
-> Getting Milliseconds Trigger Milliseconds -> Milliseconds
forall s a. s -> Getting a s a -> a
^.Getting Milliseconds Trigger Milliseconds
forall c. HasTrigger c => Lens' c Milliseconds
elapsed) [Keycode]
ks m () -> m Catch -> m Catch
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Catch -> m Catch
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
NoCatch
onTimeout :: MonadK m => m ()
onTimeout :: m ()
onTimeout = Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
press Button
h m () -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> m ()
forall (m :: * -> *). MonadKIO m => Bool -> m ()
hold Bool
False
onRelSelf :: MonadK m => m Catch
onRelSelf :: m Catch
onRelSelf = Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
tap Button
t m () -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> m ()
forall (m :: * -> *). MonadKIO m => Bool -> m ()
hold Bool
False m () -> m Catch -> m Catch
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Catch -> m Catch
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
Catch
onRelOther :: MonadK m => KeyEvent -> m Catch
onRelOther :: KeyEvent -> m Catch
onRelOther e :: KeyEvent
e = Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
press Button
h m () -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> m ()
forall (m :: * -> *). MonadKIO m => Bool -> m ()
hold Bool
False m () -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> KeyEvent -> m ()
forall (m :: * -> *). MonadKIO m => KeyEvent -> m ()
inject KeyEvent
e m () -> m Catch -> m Catch
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Catch -> m Catch
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
Catch
multiTap :: Button -> [(Milliseconds, Button)] -> Button
multiTap :: Button -> [(Milliseconds, Button)] -> Button
multiTap l :: Button
l bs :: [(Milliseconds, Button)]
bs = AnyK () -> Button
onPress (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ [(Milliseconds, Button)] -> AnyK ()
go [(Milliseconds, Button)]
bs
where
go :: [(Milliseconds, Button)] -> AnyK ()
go :: [(Milliseconds, Button)] -> AnyK ()
go [] = Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
press Button
l
go ((ms :: Milliseconds
ms, b :: Button
b):bs' :: [(Milliseconds, Button)]
bs') = do
let onMatch :: Trigger -> m Catch
onMatch t :: Trigger
t = do
Milliseconds -> m KeyPred -> m () -> (Trigger -> m Catch) -> m ()
forall (m :: * -> *).
MonadK m =>
Milliseconds -> m KeyPred -> m () -> (Trigger -> m Catch) -> m ()
within (Milliseconds
ms Milliseconds -> Milliseconds -> Milliseconds
forall a. Num a => a -> a -> a
- Trigger
tTrigger
-> Getting Milliseconds Trigger Milliseconds -> Milliseconds
forall s a. s -> Getting a s a -> a
^.Getting Milliseconds Trigger Milliseconds
forall c. HasTrigger c => Lens' c Milliseconds
elapsed) (Switch -> m KeyPred
forall (m :: * -> *). MonadK m => Switch -> m KeyPred
matchMy Switch
Press)
(Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
tap Button
b)
(m Catch -> Trigger -> m Catch
forall a b. a -> b -> a
const (m Catch -> Trigger -> m Catch) -> m Catch -> Trigger -> m Catch
forall a b. (a -> b) -> a -> b
$ [(Milliseconds, Button)] -> AnyK ()
go [(Milliseconds, Button)]
bs' m () -> m Catch -> m Catch
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Catch -> m Catch
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
Catch)
Catch -> m Catch
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
Catch
Milliseconds -> m KeyPred -> m () -> (Trigger -> m Catch) -> m ()
forall (m :: * -> *).
MonadK m =>
Milliseconds -> m KeyPred -> m () -> (Trigger -> m Catch) -> m ()
within Milliseconds
ms (Switch -> m KeyPred
forall (m :: * -> *). MonadK m => Switch -> m KeyPred
matchMy Switch
Release) (Button -> m ()
forall (m :: * -> *). MonadK m => Button -> m ()
press Button
b) Trigger -> m Catch
onMatch
tapMacro :: [Button] -> Button
tapMacro :: [Button] -> Button
tapMacro bs :: [Button]
bs = AnyK () -> Button
onPress (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ [Button] -> m ()
forall (f :: * -> *). MonadK f => [Button] -> f ()
go [Button]
bs
where
go :: [Button] -> f ()
go [] = () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
go (b :: Button
b:[]) = Button -> f ()
forall (m :: * -> *). MonadK m => Button -> m ()
press Button
b
go (b :: Button
b:rst :: [Button]
rst) = Button -> f ()
forall (m :: * -> *). MonadK m => Button -> m ()
tap Button
b f () -> f () -> f ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Button] -> f ()
go [Button]
rst
layerDelay :: Milliseconds -> LayerTag -> Button
layerDelay :: Milliseconds -> LayerTag -> Button
layerDelay d :: Milliseconds
d t :: LayerTag
t = AnyK () -> Button
onPress (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ do
LayerOp -> m ()
forall (m :: * -> *). MonadKIO m => LayerOp -> m ()
layerOp (LayerTag -> LayerOp
PushLayer LayerTag
t)
Milliseconds -> m () -> m ()
forall (m :: * -> *). MonadK m => Milliseconds -> m () -> m ()
after Milliseconds
d (LayerOp -> m ()
forall (m :: * -> *). MonadKIO m => LayerOp -> m ()
layerOp (LayerOp -> m ()) -> LayerOp -> m ()
forall a b. (a -> b) -> a -> b
$ LayerTag -> LayerOp
PopLayer LayerTag
t)
layerNext :: LayerTag -> Button
layerNext :: LayerTag -> Button
layerNext t :: LayerTag
t = AnyK () -> Button
onPress (AnyK () -> Button) -> AnyK () -> Button
forall a b. (a -> b) -> a -> b
$ do
LayerOp -> m ()
forall (m :: * -> *). MonadKIO m => LayerOp -> m ()
layerOp (LayerTag -> LayerOp
PushLayer LayerTag
t)
KeyPred -> (KeyEvent -> m Catch) -> m ()
forall (m :: * -> *).
MonadKIO m =>
KeyPred -> (KeyEvent -> m Catch) -> m ()
await KeyPred
isPress (\_ -> m () -> m ()
forall (m :: * -> *). MonadK m => m () -> m ()
whenDone (LayerOp -> m ()
forall (m :: * -> *). MonadKIO m => LayerOp -> m ()
layerOp (LayerOp -> m ()) -> LayerOp -> m ()
forall a b. (a -> b) -> a -> b
$ LayerTag -> LayerOp
PopLayer LayerTag
t) m () -> m Catch -> m Catch
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Catch -> m Catch
forall (f :: * -> *) a. Applicative f => a -> f a
pure Catch
NoCatch)