{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeSynonymInstances #-}
module WildBind.X11.Internal.Key
(
XKeyInput (..)
, xKeyEventToXKeyInput
, KeyEventType (..)
, KeyMaskMap (..)
, getKeyMaskMap
, XKeyEvent (..)
, XMod (..)
, ToXKeyEvent (..)
, addXMod
, press
, release
, shift
, ctrl
, alt
, super
, xGrabKey
, xUngrabKey
, xSendKeyEvent
) where
import Control.Applicative ((<$>), (<*>), (<|>))
import Control.Monad (forM_)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Maybe (MaybeT (MaybeT))
import Data.Bits ((.&.), (.|.))
import qualified Data.Bits as Bits
import Data.Foldable (fold, foldr)
import Data.List (nub)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.Map as M
import Data.Maybe (listToMaybe, mapMaybe)
import Data.Monoid ((<>))
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Foreign
import qualified Graphics.X11.Xlib as Xlib
import qualified Graphics.X11.Xlib.Extras as XlibE
import WildBind.Description (Describable (..))
import qualified WildBind.Input.NumPad as NumPad
data KeyEventType = KeyPress | KeyRelease deriving (KeyEventType
forall a. a -> a -> Bounded a
maxBound :: KeyEventType
$cmaxBound :: KeyEventType
minBound :: KeyEventType
$cminBound :: KeyEventType
Bounded, Int -> KeyEventType
KeyEventType -> Int
KeyEventType -> [KeyEventType]
KeyEventType -> KeyEventType
KeyEventType -> KeyEventType -> [KeyEventType]
KeyEventType -> KeyEventType -> KeyEventType -> [KeyEventType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: KeyEventType -> KeyEventType -> KeyEventType -> [KeyEventType]
$cenumFromThenTo :: KeyEventType -> KeyEventType -> KeyEventType -> [KeyEventType]
enumFromTo :: KeyEventType -> KeyEventType -> [KeyEventType]
$cenumFromTo :: KeyEventType -> KeyEventType -> [KeyEventType]
enumFromThen :: KeyEventType -> KeyEventType -> [KeyEventType]
$cenumFromThen :: KeyEventType -> KeyEventType -> [KeyEventType]
enumFrom :: KeyEventType -> [KeyEventType]
$cenumFrom :: KeyEventType -> [KeyEventType]
fromEnum :: KeyEventType -> Int
$cfromEnum :: KeyEventType -> Int
toEnum :: Int -> KeyEventType
$ctoEnum :: Int -> KeyEventType
pred :: KeyEventType -> KeyEventType
$cpred :: KeyEventType -> KeyEventType
succ :: KeyEventType -> KeyEventType
$csucc :: KeyEventType -> KeyEventType
Enum, KeyEventType -> KeyEventType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyEventType -> KeyEventType -> Bool
$c/= :: KeyEventType -> KeyEventType -> Bool
== :: KeyEventType -> KeyEventType -> Bool
$c== :: KeyEventType -> KeyEventType -> Bool
Eq, Eq KeyEventType
KeyEventType -> KeyEventType -> Bool
KeyEventType -> KeyEventType -> Ordering
KeyEventType -> KeyEventType -> KeyEventType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: KeyEventType -> KeyEventType -> KeyEventType
$cmin :: KeyEventType -> KeyEventType -> KeyEventType
max :: KeyEventType -> KeyEventType -> KeyEventType
$cmax :: KeyEventType -> KeyEventType -> KeyEventType
>= :: KeyEventType -> KeyEventType -> Bool
$c>= :: KeyEventType -> KeyEventType -> Bool
> :: KeyEventType -> KeyEventType -> Bool
$c> :: KeyEventType -> KeyEventType -> Bool
<= :: KeyEventType -> KeyEventType -> Bool
$c<= :: KeyEventType -> KeyEventType -> Bool
< :: KeyEventType -> KeyEventType -> Bool
$c< :: KeyEventType -> KeyEventType -> Bool
compare :: KeyEventType -> KeyEventType -> Ordering
$ccompare :: KeyEventType -> KeyEventType -> Ordering
Ord, Int -> KeyEventType -> ShowS
[KeyEventType] -> ShowS
KeyEventType -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [KeyEventType] -> ShowS
$cshowList :: [KeyEventType] -> ShowS
show :: KeyEventType -> [Char]
$cshow :: KeyEventType -> [Char]
showsPrec :: Int -> KeyEventType -> ShowS
$cshowsPrec :: Int -> KeyEventType -> ShowS
Show)
data KeyMaskMap
= KeyMaskMap
{ KeyMaskMap -> KeyMask
maskShift :: Xlib.KeyMask
, KeyMaskMap -> KeyMask
maskControl :: Xlib.KeyMask
, KeyMaskMap -> KeyMask
maskAlt :: Xlib.KeyMask
, KeyMaskMap -> KeyMask
maskSuper :: Xlib.KeyMask
, KeyMaskMap -> KeyMask
maskNumLock :: Xlib.KeyMask
, KeyMaskMap -> KeyMask
maskCapsLock :: Xlib.KeyMask
, KeyMaskMap -> KeyMask
maskShiftLock :: Xlib.KeyMask
, KeyMaskMap -> KeyMask
maskScrollLock :: Xlib.KeyMask
}
deriving (KeyMaskMap -> KeyMaskMap -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyMaskMap -> KeyMaskMap -> Bool
$c/= :: KeyMaskMap -> KeyMaskMap -> Bool
== :: KeyMaskMap -> KeyMaskMap -> Bool
$c== :: KeyMaskMap -> KeyMaskMap -> Bool
Eq, Eq KeyMaskMap
KeyMaskMap -> KeyMaskMap -> Bool
KeyMaskMap -> KeyMaskMap -> Ordering
KeyMaskMap -> KeyMaskMap -> KeyMaskMap
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: KeyMaskMap -> KeyMaskMap -> KeyMaskMap
$cmin :: KeyMaskMap -> KeyMaskMap -> KeyMaskMap
max :: KeyMaskMap -> KeyMaskMap -> KeyMaskMap
$cmax :: KeyMaskMap -> KeyMaskMap -> KeyMaskMap
>= :: KeyMaskMap -> KeyMaskMap -> Bool
$c>= :: KeyMaskMap -> KeyMaskMap -> Bool
> :: KeyMaskMap -> KeyMaskMap -> Bool
$c> :: KeyMaskMap -> KeyMaskMap -> Bool
<= :: KeyMaskMap -> KeyMaskMap -> Bool
$c<= :: KeyMaskMap -> KeyMaskMap -> Bool
< :: KeyMaskMap -> KeyMaskMap -> Bool
$c< :: KeyMaskMap -> KeyMaskMap -> Bool
compare :: KeyMaskMap -> KeyMaskMap -> Ordering
$ccompare :: KeyMaskMap -> KeyMaskMap -> Ordering
Ord, Int -> KeyMaskMap -> ShowS
[KeyMaskMap] -> ShowS
KeyMaskMap -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [KeyMaskMap] -> ShowS
$cshowList :: [KeyMaskMap] -> ShowS
show :: KeyMaskMap -> [Char]
$cshow :: KeyMaskMap -> [Char]
showsPrec :: Int -> KeyMaskMap -> ShowS
$cshowsPrec :: Int -> KeyMaskMap -> ShowS
Show)
isMasked :: KeyMaskMap -> (KeyMaskMap -> Xlib.KeyMask) -> Xlib.KeyMask -> Bool
isMasked :: KeyMaskMap -> (KeyMaskMap -> KeyMask) -> KeyMask -> Bool
isMasked KeyMaskMap
kmmap KeyMaskMap -> KeyMask
accessor KeyMask
target = if (KeyMask
target forall a. Bits a => a -> a -> a
.&. KeyMaskMap -> KeyMask
accessor KeyMaskMap
kmmap) forall a. Eq a => a -> a -> Bool
== KeyMask
0
then Bool
False
else Bool
True
class XKeyInput k where
toKeySym :: k -> Xlib.KeySym
toModifierMasks :: KeyMaskMap -> k -> NonEmpty Xlib.KeyMask
toModifierMasks KeyMaskMap
_ k
_ = forall (m :: * -> *) a. Monad m => a -> m a
return KeyMask
0
fromKeyEvent :: KeyMaskMap -> KeyEventType -> Xlib.KeySym -> Xlib.KeyMask -> Maybe k
fromKeySymDef :: (Bounded k, Enum k) => (k -> Xlib.KeySym) -> Xlib.KeySym -> Maybe k
fromKeySymDef :: forall k. (Bounded k, Enum k) => (k -> KeySym) -> KeySym -> Maybe k
fromKeySymDef k -> KeySym
to_conv KeySym
ks = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup KeySym
ks forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\k
n -> (k -> KeySym
to_conv k
n, k
n)) forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> a -> [a]
enumFromTo forall a. Bounded a => a
minBound forall a. Bounded a => a
maxBound
instance XKeyInput NumPad.NumPadUnlocked where
toKeySym :: NumPadUnlocked -> KeySym
toKeySym NumPadUnlocked
n = case NumPadUnlocked
n of
NumPadUnlocked
NumPad.NumUp -> KeySym
Xlib.xK_KP_Up
NumPadUnlocked
NumPad.NumDown -> KeySym
Xlib.xK_KP_Down
NumPadUnlocked
NumPad.NumLeft -> KeySym
Xlib.xK_KP_Left
NumPadUnlocked
NumPad.NumRight -> KeySym
Xlib.xK_KP_Right
NumPadUnlocked
NumPad.NumHome -> KeySym
Xlib.xK_KP_Home
NumPadUnlocked
NumPad.NumPageUp -> KeySym
Xlib.xK_KP_Page_Up
NumPadUnlocked
NumPad.NumPageDown -> KeySym
Xlib.xK_KP_Page_Down
NumPadUnlocked
NumPad.NumEnd -> KeySym
Xlib.xK_KP_End
NumPadUnlocked
NumPad.NumCenter -> KeySym
Xlib.xK_KP_Begin
NumPadUnlocked
NumPad.NumInsert -> KeySym
Xlib.xK_KP_Insert
NumPadUnlocked
NumPad.NumDelete -> KeySym
Xlib.xK_KP_Delete
NumPadUnlocked
NumPad.NumEnter -> KeySym
Xlib.xK_KP_Enter
NumPadUnlocked
NumPad.NumDivide -> KeySym
Xlib.xK_KP_Divide
NumPadUnlocked
NumPad.NumMulti -> KeySym
Xlib.xK_KP_Multiply
NumPadUnlocked
NumPad.NumMinus -> KeySym
Xlib.xK_KP_Subtract
NumPadUnlocked
NumPad.NumPlus -> KeySym
Xlib.xK_KP_Add
fromKeyEvent :: KeyMaskMap
-> KeyEventType -> KeySym -> KeyMask -> Maybe NumPadUnlocked
fromKeyEvent KeyMaskMap
_ KeyEventType
KeyPress KeySym
_ KeyMask
_ = forall a. Maybe a
Nothing
fromKeyEvent KeyMaskMap
kmmask KeyEventType
KeyRelease KeySym
keysym KeyMask
mask = if Bool
is_numlocked
then forall a. Maybe a
Nothing
else forall k. (Bounded k, Enum k) => (k -> KeySym) -> KeySym -> Maybe k
fromKeySymDef forall k. XKeyInput k => k -> KeySym
toKeySym KeySym
keysym
where
is_numlocked :: Bool
is_numlocked = KeyMaskMap -> (KeyMaskMap -> KeyMask) -> KeyMask -> Bool
isMasked KeyMaskMap
kmmask KeyMaskMap -> KeyMask
maskNumLock KeyMask
mask
instance XKeyInput NumPad.NumPadLocked where
toKeySym :: NumPadLocked -> KeySym
toKeySym NumPadLocked
n = case NumPadLocked
n of
NumPadLocked
NumPad.NumL0 -> KeySym
Xlib.xK_KP_0
NumPadLocked
NumPad.NumL1 -> KeySym
Xlib.xK_KP_1
NumPadLocked
NumPad.NumL2 -> KeySym
Xlib.xK_KP_2
NumPadLocked
NumPad.NumL3 -> KeySym
Xlib.xK_KP_3
NumPadLocked
NumPad.NumL4 -> KeySym
Xlib.xK_KP_4
NumPadLocked
NumPad.NumL5 -> KeySym
Xlib.xK_KP_5
NumPadLocked
NumPad.NumL6 -> KeySym
Xlib.xK_KP_6
NumPadLocked
NumPad.NumL7 -> KeySym
Xlib.xK_KP_7
NumPadLocked
NumPad.NumL8 -> KeySym
Xlib.xK_KP_8
NumPadLocked
NumPad.NumL9 -> KeySym
Xlib.xK_KP_9
NumPadLocked
NumPad.NumLDivide -> KeySym
Xlib.xK_KP_Divide
NumPadLocked
NumPad.NumLMulti -> KeySym
Xlib.xK_KP_Multiply
NumPadLocked
NumPad.NumLMinus -> KeySym
Xlib.xK_KP_Subtract
NumPadLocked
NumPad.NumLPlus -> KeySym
Xlib.xK_KP_Add
NumPadLocked
NumPad.NumLEnter -> KeySym
Xlib.xK_KP_Enter
NumPadLocked
NumPad.NumLPeriod -> KeySym
Xlib.xK_KP_Delete
toModifierMasks :: KeyMaskMap -> NumPadLocked -> NonEmpty KeyMask
toModifierMasks KeyMaskMap
kmmap NumPadLocked
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ KeyMaskMap -> KeyMask
maskNumLock KeyMaskMap
kmmap
fromKeyEvent :: KeyMaskMap
-> KeyEventType -> KeySym -> KeyMask -> Maybe NumPadLocked
fromKeyEvent KeyMaskMap
_ KeyEventType
KeyPress KeySym
_ KeyMask
_ = forall a. Maybe a
Nothing
fromKeyEvent KeyMaskMap
kmmap KeyEventType
KeyRelease KeySym
keysym KeyMask
mask =
if Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Bool
is_num_locked
then forall a. Maybe a
Nothing
else if KeySym
keysym forall a. Eq a => a -> a -> Bool
== KeySym
Xlib.xK_KP_Decimal
then forall a. a -> Maybe a
Just NumPadLocked
NumPad.NumLPeriod
else forall k. (Bounded k, Enum k) => (k -> KeySym) -> KeySym -> Maybe k
fromKeySymDef forall k. XKeyInput k => k -> KeySym
toKeySym KeySym
keysym
where
is_num_locked :: Bool
is_num_locked = KeyMaskMap -> (KeyMaskMap -> KeyMask) -> KeyMask -> Bool
isMasked KeyMaskMap
kmmap KeyMaskMap -> KeyMask
maskNumLock KeyMask
mask
instance (XKeyInput a, XKeyInput b) => XKeyInput (Either a b) where
toKeySym :: Either a b -> KeySym
toKeySym = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall k. XKeyInput k => k -> KeySym
toKeySym forall k. XKeyInput k => k -> KeySym
toKeySym
toModifierMasks :: KeyMaskMap -> Either a b -> NonEmpty KeyMask
toModifierMasks KeyMaskMap
kmmap = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall k. XKeyInput k => KeyMaskMap -> k -> NonEmpty KeyMask
toModifierMasks KeyMaskMap
kmmap) (forall k. XKeyInput k => KeyMaskMap -> k -> NonEmpty KeyMask
toModifierMasks KeyMaskMap
kmmap)
fromKeyEvent :: KeyMaskMap
-> KeyEventType -> KeySym -> KeyMask -> Maybe (Either a b)
fromKeyEvent KeyMaskMap
kmmap KeyEventType
ev_type KeySym
keysym KeyMask
mask =
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall k.
XKeyInput k =>
KeyMaskMap -> KeyEventType -> KeySym -> KeyMask -> Maybe k
fromKeyEvent KeyMaskMap
kmmap KeyEventType
ev_type KeySym
keysym KeyMask
mask) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall k.
XKeyInput k =>
KeyMaskMap -> KeyEventType -> KeySym -> KeyMask -> Maybe k
fromKeyEvent KeyMaskMap
kmmap KeyEventType
ev_type KeySym
keysym KeyMask
mask)
xKeyEventToXKeyInput :: XKeyInput k => KeyMaskMap -> KeyEventType -> Xlib.XKeyEventPtr -> MaybeT IO k
xKeyEventToXKeyInput :: forall k.
XKeyInput k =>
KeyMaskMap -> KeyEventType -> XKeyEventPtr -> MaybeT IO k
xKeyEventToXKeyInput KeyMaskMap
kmmap KeyEventType
ev_type XKeyEventPtr
kev = do
KeySym
keysym <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XKeyEventPtr -> IO (Maybe KeySym, [Char])
Xlib.lookupString XKeyEventPtr
kev)
(KeySym
_, KeySym
_, KeySym
_, CInt
_, CInt
_, CInt
_, CInt
_, KeyMask
status, KeyCode
_, Bool
_) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ XEventPtr
-> IO
(KeySym, KeySym, KeySym, CInt, CInt, CInt, CInt, KeyMask, KeyCode,
Bool)
Xlib.get_KeyEvent forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
Foreign.castPtr XKeyEventPtr
kev
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k.
XKeyInput k =>
KeyMaskMap -> KeyEventType -> KeySym -> KeyMask -> Maybe k
fromKeyEvent KeyMaskMap
kmmap KeyEventType
ev_type KeySym
keysym KeyMask
status
type XModifierMap = [(Xlib.Modifier, [Xlib.KeyCode])]
getKeyMaskMap :: Xlib.Display -> IO KeyMaskMap
getKeyMaskMap :: Display -> IO KeyMaskMap
getKeyMaskMap Display
disp = do
XModifierMap
xmodmap <- Display -> IO XModifierMap
getXModifierMap Display
disp
let maskFor :: KeySym -> IO KeyMask
maskFor = Display -> XModifierMap -> KeySym -> IO KeyMask
lookupModifierKeyMask Display
disp XModifierMap
xmodmap
KeyMask
numlock_mask <- KeySym -> IO KeyMask
maskFor KeySym
Xlib.xK_Num_Lock
KeyMask
capslock_mask <- KeySym -> IO KeyMask
maskFor KeySym
Xlib.xK_Caps_Lock
KeyMask
shiftlock_mask <- KeySym -> IO KeyMask
maskFor KeySym
Xlib.xK_Shift_Lock
KeyMask
scrolllock_mask <- KeySym -> IO KeyMask
maskFor KeySym
Xlib.xK_Scroll_Lock
KeyMask
alt_mask <- KeySym -> IO KeyMask
maskFor KeySym
Xlib.xK_Alt_L
KeyMask
super_mask <- KeySym -> IO KeyMask
maskFor KeySym
Xlib.xK_Super_L
forall (m :: * -> *) a. Monad m => a -> m a
return KeyMaskMap { maskShift :: KeyMask
maskShift = KeyMask
Xlib.shiftMask,
maskControl :: KeyMask
maskControl = KeyMask
Xlib.controlMask,
maskAlt :: KeyMask
maskAlt = KeyMask
alt_mask,
maskSuper :: KeyMask
maskSuper = KeyMask
super_mask,
maskNumLock :: KeyMask
maskNumLock = KeyMask
numlock_mask,
maskCapsLock :: KeyMask
maskCapsLock = KeyMask
capslock_mask,
maskShiftLock :: KeyMask
maskShiftLock = KeyMask
shiftlock_mask,
maskScrollLock :: KeyMask
maskScrollLock = KeyMask
scrolllock_mask
}
getXModifierMap :: Xlib.Display -> IO XModifierMap
getXModifierMap :: Display -> IO XModifierMap
getXModifierMap = Display -> IO XModifierMap
XlibE.getModifierMapping
lookupModifierKeyMask :: Xlib.Display -> XModifierMap -> Xlib.KeySym -> IO Xlib.KeyMask
lookupModifierKeyMask :: Display -> XModifierMap -> KeySym -> IO KeyMask
lookupModifierKeyMask Display
disp XModifierMap
xmmap KeySym
keysym = do
KeyCode
keycode <- Display -> KeySym -> IO KeyCode
Xlib.keysymToKeycode Display
disp KeySym
keysym
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe KeyMask
0 KeyMask -> KeyMask
modifierToKeyMask forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall {t :: * -> *} {a} {a}.
(Foldable t, Eq a) =>
a -> (a, t a) -> Maybe a
lookupXMod' KeyCode
keycode) XModifierMap
xmmap
where
lookupXMod' :: a -> (a, t a) -> Maybe a
lookupXMod' a
key_code (a
xmod, t a
codes) = if a
key_code forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t a
codes
then forall a. a -> Maybe a
Just a
xmod
else forall a. Maybe a
Nothing
modifierToKeyMask :: Xlib.Modifier -> Xlib.KeyMask
modifierToKeyMask :: KeyMask -> KeyMask
modifierToKeyMask = forall a. Bits a => a -> Int -> a
Bits.shift KeyMask
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
xGrabKey :: Xlib.Display -> Xlib.Window -> Xlib.KeySym -> Xlib.KeyMask -> IO ()
xGrabKey :: Display -> KeySym -> KeySym -> KeyMask -> IO ()
xGrabKey Display
disp KeySym
win KeySym
key KeyMask
mask = do
KeyCode
code <- Display -> KeySym -> IO KeyCode
Xlib.keysymToKeycode Display
disp KeySym
key
Display
-> KeyCode -> KeyMask -> KeySym -> Bool -> CInt -> CInt -> IO ()
Xlib.grabKey Display
disp KeyCode
code KeyMask
mask KeySym
win Bool
False CInt
Xlib.grabModeAsync CInt
Xlib.grabModeAsync
xUngrabKey :: Xlib.Display -> Xlib.Window -> Xlib.KeySym -> Xlib.KeyMask -> IO ()
xUngrabKey :: Display -> KeySym -> KeySym -> KeyMask -> IO ()
xUngrabKey Display
disp KeySym
win KeySym
key KeyMask
mask = do
KeyCode
code <- Display -> KeySym -> IO KeyCode
Xlib.keysymToKeycode Display
disp KeySym
key
Display -> KeyCode -> KeyMask -> KeySym -> IO ()
Xlib.ungrabKey Display
disp KeyCode
code KeyMask
mask KeySym
win
data XMod = Shift | Ctrl | Alt | Super deriving (XMod
forall a. a -> a -> Bounded a
maxBound :: XMod
$cmaxBound :: XMod
minBound :: XMod
$cminBound :: XMod
Bounded, Int -> XMod
XMod -> Int
XMod -> [XMod]
XMod -> XMod
XMod -> XMod -> [XMod]
XMod -> XMod -> XMod -> [XMod]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: XMod -> XMod -> XMod -> [XMod]
$cenumFromThenTo :: XMod -> XMod -> XMod -> [XMod]
enumFromTo :: XMod -> XMod -> [XMod]
$cenumFromTo :: XMod -> XMod -> [XMod]
enumFromThen :: XMod -> XMod -> [XMod]
$cenumFromThen :: XMod -> XMod -> [XMod]
enumFrom :: XMod -> [XMod]
$cenumFrom :: XMod -> [XMod]
fromEnum :: XMod -> Int
$cfromEnum :: XMod -> Int
toEnum :: Int -> XMod
$ctoEnum :: Int -> XMod
pred :: XMod -> XMod
$cpred :: XMod -> XMod
succ :: XMod -> XMod
$csucc :: XMod -> XMod
Enum, XMod -> XMod -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XMod -> XMod -> Bool
$c/= :: XMod -> XMod -> Bool
== :: XMod -> XMod -> Bool
$c== :: XMod -> XMod -> Bool
Eq, Eq XMod
XMod -> XMod -> Bool
XMod -> XMod -> Ordering
XMod -> XMod -> XMod
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: XMod -> XMod -> XMod
$cmin :: XMod -> XMod -> XMod
max :: XMod -> XMod -> XMod
$cmax :: XMod -> XMod -> XMod
>= :: XMod -> XMod -> Bool
$c>= :: XMod -> XMod -> Bool
> :: XMod -> XMod -> Bool
$c> :: XMod -> XMod -> Bool
<= :: XMod -> XMod -> Bool
$c<= :: XMod -> XMod -> Bool
< :: XMod -> XMod -> Bool
$c< :: XMod -> XMod -> Bool
compare :: XMod -> XMod -> Ordering
$ccompare :: XMod -> XMod -> Ordering
Ord, Int -> XMod -> ShowS
[XMod] -> ShowS
XMod -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [XMod] -> ShowS
$cshowList :: [XMod] -> ShowS
show :: XMod -> [Char]
$cshow :: XMod -> [Char]
showsPrec :: Int -> XMod -> ShowS
$cshowsPrec :: Int -> XMod -> ShowS
Show)
data XKeyEvent
= XKeyEvent
{ XKeyEvent -> KeyEventType
xKeyEventType :: KeyEventType
, XKeyEvent -> Set XMod
xKeyEventMods :: S.Set XMod
, XKeyEvent -> KeySym
xKeyEventKeySym :: Xlib.KeySym
}
deriving (XKeyEvent -> XKeyEvent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XKeyEvent -> XKeyEvent -> Bool
$c/= :: XKeyEvent -> XKeyEvent -> Bool
== :: XKeyEvent -> XKeyEvent -> Bool
$c== :: XKeyEvent -> XKeyEvent -> Bool
Eq, Eq XKeyEvent
XKeyEvent -> XKeyEvent -> Bool
XKeyEvent -> XKeyEvent -> Ordering
XKeyEvent -> XKeyEvent -> XKeyEvent
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: XKeyEvent -> XKeyEvent -> XKeyEvent
$cmin :: XKeyEvent -> XKeyEvent -> XKeyEvent
max :: XKeyEvent -> XKeyEvent -> XKeyEvent
$cmax :: XKeyEvent -> XKeyEvent -> XKeyEvent
>= :: XKeyEvent -> XKeyEvent -> Bool
$c>= :: XKeyEvent -> XKeyEvent -> Bool
> :: XKeyEvent -> XKeyEvent -> Bool
$c> :: XKeyEvent -> XKeyEvent -> Bool
<= :: XKeyEvent -> XKeyEvent -> Bool
$c<= :: XKeyEvent -> XKeyEvent -> Bool
< :: XKeyEvent -> XKeyEvent -> Bool
$c< :: XKeyEvent -> XKeyEvent -> Bool
compare :: XKeyEvent -> XKeyEvent -> Ordering
$ccompare :: XKeyEvent -> XKeyEvent -> Ordering
Ord, Int -> XKeyEvent -> ShowS
[XKeyEvent] -> ShowS
XKeyEvent -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [XKeyEvent] -> ShowS
$cshowList :: [XKeyEvent] -> ShowS
show :: XKeyEvent -> [Char]
$cshow :: XKeyEvent -> [Char]
showsPrec :: Int -> XKeyEvent -> ShowS
$cshowsPrec :: Int -> XKeyEvent -> ShowS
Show)
instance XKeyInput XKeyEvent where
toKeySym :: XKeyEvent -> KeySym
toKeySym (XKeyEvent KeyEventType
_ Set XMod
_ KeySym
ks) = KeySym
ks
toModifierMasks :: KeyMaskMap -> XKeyEvent -> NonEmpty KeyMask
toModifierMasks KeyMaskMap
kmmap (XKeyEvent KeyEventType
_ Set XMod
mods KeySym
_) =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Bits a => a -> a -> a
.|. KeyMaskMap -> Set XMod -> KeyMask
xModsToKeyMask KeyMaskMap
kmmap Set XMod
mods) forall a b. (a -> b) -> a -> b
$ KeyMaskMap -> NonEmpty KeyMask
lockVariations KeyMaskMap
kmmap
fromKeyEvent :: KeyMaskMap -> KeyEventType -> KeySym -> KeyMask -> Maybe XKeyEvent
fromKeyEvent KeyMaskMap
kmmap KeyEventType
ev_type KeySym
keysym KeyMask
mask = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ KeyEventType -> Set XMod -> KeySym -> XKeyEvent
XKeyEvent KeyEventType
ev_type (KeyMaskMap -> KeyMask -> Set XMod
keyMaskToXMods KeyMaskMap
kmmap KeyMask
mask) KeySym
keysym
class ToXKeyEvent k where
toXKeyEvent :: k -> XKeyEvent
instance ToXKeyEvent XKeyEvent where
toXKeyEvent :: XKeyEvent -> XKeyEvent
toXKeyEvent = forall a. a -> a
id
instance ToXKeyEvent Xlib.KeySym where
toXKeyEvent :: KeySym -> XKeyEvent
toXKeyEvent KeySym
keysym = KeyEventType -> Set XMod -> KeySym -> XKeyEvent
XKeyEvent KeyEventType
KeyPress forall a. Monoid a => a
mempty KeySym
keysym
instance (ToXKeyEvent a, ToXKeyEvent b) => ToXKeyEvent (Either a b) where
toXKeyEvent :: Either a b -> XKeyEvent
toXKeyEvent = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall k. ToXKeyEvent k => k -> XKeyEvent
toXKeyEvent forall k. ToXKeyEvent k => k -> XKeyEvent
toXKeyEvent
instance Describable XKeyEvent where
describe :: XKeyEvent -> ActionDescription
describe (XKeyEvent KeyEventType
ev Set XMod
mods KeySym
keysym) = ActionDescription
ev_txt forall a. Semigroup a => a -> a -> a
<> [Char] -> ActionDescription
T.pack ([Char]
mods_str forall a. [a] -> [a] -> [a]
++ KeySym -> [Char]
Xlib.keysymToString KeySym
keysym)
where
mods_str :: [Char]
mods_str = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (\XMod
m -> forall a. Show a => a -> [Char]
show XMod
m forall a. [a] -> [a] -> [a]
++ [Char]
"+") Set XMod
mods
ev_txt :: ActionDescription
ev_txt = case KeyEventType
ev of
KeyEventType
KeyPress -> ActionDescription
"press "
KeyEventType
KeyRelease -> ActionDescription
"release "
xModToKeyMask :: KeyMaskMap -> XMod -> Xlib.KeyMask
xModToKeyMask :: KeyMaskMap -> XMod -> KeyMask
xModToKeyMask KeyMaskMap
kmmap XMod
modi = case XMod
modi of
XMod
Shift -> KeyMaskMap -> KeyMask
maskShift KeyMaskMap
kmmap
XMod
Ctrl -> KeyMaskMap -> KeyMask
maskControl KeyMaskMap
kmmap
XMod
Alt -> KeyMaskMap -> KeyMask
maskAlt KeyMaskMap
kmmap
XMod
Super -> KeyMaskMap -> KeyMask
maskSuper KeyMaskMap
kmmap
xModsToKeyMask :: KeyMaskMap -> S.Set XMod -> Xlib.KeyMask
xModsToKeyMask :: KeyMaskMap -> Set XMod -> KeyMask
xModsToKeyMask KeyMaskMap
kmmap = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr XMod -> KeyMask -> KeyMask
f KeyMask
0
where
f :: XMod -> KeyMask -> KeyMask
f XMod
modi KeyMask
mask = KeyMaskMap -> XMod -> KeyMask
xModToKeyMask KeyMaskMap
kmmap XMod
modi forall a. Bits a => a -> a -> a
.|. KeyMask
mask
lockVariations :: KeyMaskMap -> NonEmpty Xlib.KeyMask
lockVariations :: KeyMaskMap -> NonEmpty KeyMask
lockVariations KeyMaskMap
kmmap = forall {a}. Num a => [a] -> NonEmpty a
toNonEmpty forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ do
KeyMask
numl <- [KeyMask
0, KeyMaskMap -> KeyMask
maskNumLock KeyMaskMap
kmmap]
KeyMask
capsl <- [KeyMask
0, KeyMaskMap -> KeyMask
maskCapsLock KeyMaskMap
kmmap]
KeyMask
shiftl <- [KeyMask
0, KeyMaskMap -> KeyMask
maskShiftLock KeyMaskMap
kmmap]
KeyMask
scl <- [KeyMask
0, KeyMaskMap -> KeyMask
maskScrollLock KeyMaskMap
kmmap]
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyMask
numl forall a. Bits a => a -> a -> a
.|. KeyMask
capsl forall a. Bits a => a -> a -> a
.|. KeyMask
shiftl forall a. Bits a => a -> a -> a
.|. KeyMask
scl)
where
toNonEmpty :: [a] -> NonEmpty a
toNonEmpty [] = forall (m :: * -> *) a. Monad m => a -> m a
return a
0
toNonEmpty (a
x:[a]
rest) = a
x forall a. a -> [a] -> NonEmpty a
:| [a]
rest
keyMaskToXMods :: KeyMaskMap -> Xlib.KeyMask -> S.Set XMod
keyMaskToXMods :: KeyMaskMap -> KeyMask -> Set XMod
keyMaskToXMods KeyMaskMap
kmmap KeyMask
mask = forall a. Ord a => [a] -> Set a
S.fromListforall a b. (a -> b) -> a -> b
$ forall {a}. (KeyMaskMap -> KeyMask, a) -> [a]
toXMod forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [ (KeyMaskMap -> KeyMask
maskShift, XMod
Shift),
(KeyMaskMap -> KeyMask
maskControl, XMod
Ctrl),
(KeyMaskMap -> KeyMask
maskAlt, XMod
Alt),
(KeyMaskMap -> KeyMask
maskSuper, XMod
Super)
]
where
toXMod :: (KeyMaskMap -> KeyMask, a) -> [a]
toXMod (KeyMaskMap -> KeyMask
acc, a
mod_symbol) = if KeyMaskMap -> (KeyMaskMap -> KeyMask) -> KeyMask -> Bool
isMasked KeyMaskMap
kmmap KeyMaskMap -> KeyMask
acc KeyMask
mask
then [a
mod_symbol]
else []
addXMod :: ToXKeyEvent k => XMod -> k -> XKeyEvent
addXMod :: forall k. ToXKeyEvent k => XMod -> k -> XKeyEvent
addXMod XMod
modi k
mkey = case forall k. ToXKeyEvent k => k -> XKeyEvent
toXKeyEvent k
mkey of
XKeyEvent KeyEventType
ev_type Set XMod
mods KeySym
ks -> KeyEventType -> Set XMod -> KeySym -> XKeyEvent
XKeyEvent KeyEventType
ev_type (forall a. Ord a => a -> Set a -> Set a
S.insert XMod
modi Set XMod
mods) KeySym
ks
press :: ToXKeyEvent k => k -> XKeyEvent
press :: forall k. ToXKeyEvent k => k -> XKeyEvent
press k
k = (forall k. ToXKeyEvent k => k -> XKeyEvent
toXKeyEvent k
k) { xKeyEventType :: KeyEventType
xKeyEventType = KeyEventType
KeyPress }
release :: ToXKeyEvent k => k -> XKeyEvent
release :: forall k. ToXKeyEvent k => k -> XKeyEvent
release k
k = (forall k. ToXKeyEvent k => k -> XKeyEvent
toXKeyEvent k
k) { xKeyEventType :: KeyEventType
xKeyEventType = KeyEventType
KeyRelease }
shift :: ToXKeyEvent k => k -> XKeyEvent
shift :: forall k. ToXKeyEvent k => k -> XKeyEvent
shift = forall k. ToXKeyEvent k => XMod -> k -> XKeyEvent
addXMod XMod
Shift
ctrl :: ToXKeyEvent k => k -> XKeyEvent
ctrl :: forall k. ToXKeyEvent k => k -> XKeyEvent
ctrl = forall k. ToXKeyEvent k => XMod -> k -> XKeyEvent
addXMod XMod
Ctrl
alt :: ToXKeyEvent k => k -> XKeyEvent
alt :: forall k. ToXKeyEvent k => k -> XKeyEvent
alt = forall k. ToXKeyEvent k => XMod -> k -> XKeyEvent
addXMod XMod
Alt
super :: ToXKeyEvent k => k -> XKeyEvent
super :: forall k. ToXKeyEvent k => k -> XKeyEvent
super = forall k. ToXKeyEvent k => XMod -> k -> XKeyEvent
addXMod XMod
Super
xSendKeyEvent :: KeyMaskMap -> Xlib.Display -> Xlib.Window -> XKeyEvent -> IO ()
xSendKeyEvent :: KeyMaskMap -> Display -> KeySym -> XKeyEvent -> IO ()
xSendKeyEvent KeyMaskMap
kmmap Display
disp KeySym
target_win XKeyEvent
key_event = forall a. (XEventPtr -> IO a) -> IO a
Xlib.allocaXEvent forall a b. (a -> b) -> a -> b
$ \XEventPtr
xev -> do
XEventPtr -> IO ()
setupXEvent XEventPtr
xev
Display -> KeySym -> Bool -> KeySym -> XEventPtr -> IO ()
Xlib.sendEvent Display
disp KeySym
target_win Bool
propagate KeySym
event_mask XEventPtr
xev
Display -> Bool -> IO ()
Xlib.sync Display
disp Bool
False
where
propagate :: Bool
propagate = Bool
True
event_type :: KeyEventType
event_type = XKeyEvent -> KeyEventType
xKeyEventType XKeyEvent
key_event
event_mask :: KeySym
event_mask = case KeyEventType
event_type of
KeyEventType
KeyPress -> KeySym
Xlib.keyPressMask
KeyEventType
KeyRelease -> KeySym
Xlib.keyReleaseMask
xevent_type :: EventType
xevent_type = case KeyEventType
event_type of
KeyEventType
KeyPress -> EventType
Xlib.keyPress
KeyEventType
KeyRelease -> EventType
Xlib.keyRelease
setupXEvent :: XEventPtr -> IO ()
setupXEvent XEventPtr
xev = do
KeyCode
key_code <- Display -> KeySym -> IO KeyCode
Xlib.keysymToKeycode Display
disp forall a b. (a -> b) -> a -> b
$ XKeyEvent -> KeySym
xKeyEventKeySym XKeyEvent
key_event
XEventPtr -> EventType -> IO ()
XlibE.setEventType XEventPtr
xev EventType
xevent_type
XEventPtr
-> KeySym
-> KeySym
-> KeySym
-> KeyMask
-> KeyCode
-> Bool
-> IO ()
XlibE.setKeyEvent XEventPtr
xev KeySym
target_win (Display -> KeySym
Xlib.defaultRootWindow Display
disp) KeySym
subwindow KeyMask
key_mask KeyCode
key_code Bool
is_same_screen
subwindow :: KeySym
subwindow = KeySym
0
is_same_screen :: Bool
is_same_screen = Bool
True
key_mask :: KeyMask
key_mask = KeyMaskMap -> Set XMod -> KeyMask
xModsToKeyMask KeyMaskMap
kmmap forall a b. (a -> b) -> a -> b
$ XKeyEvent -> Set XMod
xKeyEventMods XKeyEvent
key_event