module Termonad.Keys where
import Termonad.Prelude
import Control.Lens (imap)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Set (Set)
import qualified Data.Set as Set
import GI.Gdk
( EventKey
, pattern KEY_0
, pattern KEY_1
, pattern KEY_2
, pattern KEY_3
, pattern KEY_4
, pattern KEY_5
, pattern KEY_6
, pattern KEY_7
, pattern KEY_8
, pattern KEY_9
, ModifierType(..)
, getEventKeyHardwareKeycode
, getEventKeyIsModifier
, getEventKeyKeyval
, getEventKeyLength
, getEventKeyState
, getEventKeyString
, getEventKeyType
)
import Termonad.Term (altNumSwitchTerm)
import Termonad.Types (TMState, TMWindowId)
showKeys :: EventKey -> IO Bool
showKeys :: EventKey -> IO Bool
showKeys EventKey
eventKey = do
EventType
eventType <- EventKey -> IO EventType
forall (m :: * -> *). MonadIO m => EventKey -> m EventType
getEventKeyType EventKey
eventKey
Maybe Text
maybeString <- EventKey -> IO (Maybe Text)
forall (m :: * -> *). MonadIO m => EventKey -> m (Maybe Text)
getEventKeyString EventKey
eventKey
[ModifierType]
modifiers <- EventKey -> IO [ModifierType]
forall (m :: * -> *). MonadIO m => EventKey -> m [ModifierType]
getEventKeyState EventKey
eventKey
Int32
len <- EventKey -> IO Int32
forall (m :: * -> *). MonadIO m => EventKey -> m Int32
getEventKeyLength EventKey
eventKey
Word32
keyval <- EventKey -> IO Word32
forall (m :: * -> *). MonadIO m => EventKey -> m Word32
getEventKeyKeyval EventKey
eventKey
Word32
isMod <- EventKey -> IO Word32
forall (m :: * -> *). MonadIO m => EventKey -> m Word32
getEventKeyIsModifier EventKey
eventKey
Word16
keycode <- EventKey -> IO Word16
forall (m :: * -> *). MonadIO m => EventKey -> m Word16
getEventKeyHardwareKeycode EventKey
eventKey
String -> IO ()
putStrLn String
"key press event:"
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
" type = " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> EventType -> String
forall a. Show a => a -> String
show EventType
eventType
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
" str = " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> String
forall a. Show a => a -> String
show Maybe Text
maybeString
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
" mods = " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [ModifierType] -> String
forall a. Show a => a -> String
show [ModifierType]
modifiers
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
" isMod = " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word32 -> String
forall a. Show a => a -> String
show Word32
isMod
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
" len = " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int32 -> String
forall a. Show a => a -> String
show Int32
len
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
" keyval = " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word32 -> String
forall a. Show a => a -> String
show Word32
keyval
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
" keycode = " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word16 -> String
forall a. Show a => a -> String
show Word16
keycode
String -> IO ()
putStrLn String
""
Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
data Key = Key
{ Key -> Word32
keyVal :: !Word32
, Key -> Set ModifierType
keyMods :: !(Set ModifierType)
} deriving (Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
/= :: Key -> Key -> Bool
Eq, Eq Key
Eq Key
-> (Key -> Key -> Ordering)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Key)
-> (Key -> Key -> Key)
-> Ord Key
Key -> Key -> Bool
Key -> Key -> Ordering
Key -> Key -> Key
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
$ccompare :: Key -> Key -> Ordering
compare :: Key -> Key -> Ordering
$c< :: Key -> Key -> Bool
< :: Key -> Key -> Bool
$c<= :: Key -> Key -> Bool
<= :: Key -> Key -> Bool
$c> :: Key -> Key -> Bool
> :: Key -> Key -> Bool
$c>= :: Key -> Key -> Bool
>= :: Key -> Key -> Bool
$cmax :: Key -> Key -> Key
max :: Key -> Key -> Key
$cmin :: Key -> Key -> Key
min :: Key -> Key -> Key
Ord, Int -> Key -> String -> String
[Key] -> String -> String
Key -> String
(Int -> Key -> String -> String)
-> (Key -> String) -> ([Key] -> String -> String) -> Show Key
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Key -> String -> String
showsPrec :: Int -> Key -> String -> String
$cshow :: Key -> String
show :: Key -> String
$cshowList :: [Key] -> String -> String
showList :: [Key] -> String -> String
Show)
toKey :: Word32 -> Set ModifierType -> Key
toKey :: Word32 -> Set ModifierType -> Key
toKey = Word32 -> Set ModifierType -> Key
Key
keyMap :: Map Key (TMState -> TMWindowId -> IO Bool)
keyMap :: Map Key (TMState -> TMWindowId -> IO Bool)
keyMap =
let numKeys :: [Word32]
numKeys :: [Word32]
numKeys =
[ Word32
Item [Word32]
KEY_1
, Word32
Item [Word32]
KEY_2
, Word32
Item [Word32]
KEY_3
, Word32
Item [Word32]
KEY_4
, Word32
Item [Word32]
KEY_5
, Word32
Item [Word32]
KEY_6
, Word32
Item [Word32]
KEY_7
, Word32
Item [Word32]
KEY_8
, Word32
Item [Word32]
KEY_9
, Word32
Item [Word32]
KEY_0
]
altNumKeys :: [(Key, TMState -> TMWindowId -> IO Bool)]
altNumKeys :: [(Key, TMState -> TMWindowId -> IO Bool)]
altNumKeys =
(Int -> Word32 -> (Key, TMState -> TMWindowId -> IO Bool))
-> [Word32] -> [(Key, TMState -> TMWindowId -> IO Bool)]
forall a b. (Int -> a -> b) -> [a] -> [b]
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap
(\Int
i Word32
k ->
(Word32 -> Set ModifierType -> Key
toKey Word32
k [Item (Set ModifierType)
ModifierType
ModifierTypeMod1Mask], (TMState -> TMWindowId -> IO ())
-> TMState -> TMWindowId -> IO Bool
forall a.
(TMState -> TMWindowId -> IO a) -> TMState -> TMWindowId -> IO Bool
stopProp (Int -> TMState -> TMWindowId -> IO ()
altNumSwitchTerm Int
i))
)
[Word32]
numKeys
in
[(Key, TMState -> TMWindowId -> IO Bool)]
-> Map Key (TMState -> TMWindowId -> IO Bool)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Key, TMState -> TMWindowId -> IO Bool)]
altNumKeys
stopProp :: (TMState -> TMWindowId -> IO a) -> TMState -> TMWindowId -> IO Bool
stopProp :: forall a.
(TMState -> TMWindowId -> IO a) -> TMState -> TMWindowId -> IO Bool
stopProp TMState -> TMWindowId -> IO a
callback TMState
terState TMWindowId
tmWinId = TMState -> TMWindowId -> IO a
callback TMState
terState TMWindowId
tmWinId IO a -> Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True
removeStrangeModifiers :: Key -> Key
removeStrangeModifiers :: Key -> Key
removeStrangeModifiers Key{Word32
keyVal :: Key -> Word32
keyVal :: Word32
keyVal, Set ModifierType
keyMods :: Key -> Set ModifierType
keyMods :: Set ModifierType
keyMods} =
let reservedModifiers :: Set ModifierType
reservedModifiers :: Set ModifierType
reservedModifiers =
[ Item (Set ModifierType)
ModifierType
ModifierTypeModifierReserved13Mask
, Item (Set ModifierType)
ModifierType
ModifierTypeModifierReserved14Mask
, Item (Set ModifierType)
ModifierType
ModifierTypeModifierReserved15Mask
, Item (Set ModifierType)
ModifierType
ModifierTypeModifierReserved16Mask
, Item (Set ModifierType)
ModifierType
ModifierTypeModifierReserved17Mask
, Item (Set ModifierType)
ModifierType
ModifierTypeModifierReserved18Mask
, Item (Set ModifierType)
ModifierType
ModifierTypeModifierReserved19Mask
, Item (Set ModifierType)
ModifierType
ModifierTypeModifierReserved20Mask
, Item (Set ModifierType)
ModifierType
ModifierTypeModifierReserved21Mask
, Item (Set ModifierType)
ModifierType
ModifierTypeModifierReserved22Mask
, Item (Set ModifierType)
ModifierType
ModifierTypeModifierReserved23Mask
, Item (Set ModifierType)
ModifierType
ModifierTypeModifierReserved24Mask
, Item (Set ModifierType)
ModifierType
ModifierTypeModifierReserved25Mask
, Item (Set ModifierType)
ModifierType
ModifierTypeModifierReserved29Mask
]
in Word32 -> Set ModifierType -> Key
Key Word32
keyVal (Set ModifierType -> Set ModifierType -> Set ModifierType
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set ModifierType
keyMods Set ModifierType
reservedModifiers)
handleKeyPress :: TMState -> TMWindowId -> EventKey -> IO Bool
handleKeyPress :: TMState -> TMWindowId -> EventKey -> IO Bool
handleKeyPress TMState
terState TMWindowId
tmWindowId EventKey
eventKey = do
Word32
keyval <- EventKey -> IO Word32
forall (m :: * -> *). MonadIO m => EventKey -> m Word32
getEventKeyKeyval EventKey
eventKey
[ModifierType]
modifiers <- EventKey -> IO [ModifierType]
forall (m :: * -> *). MonadIO m => EventKey -> m [ModifierType]
getEventKeyState EventKey
eventKey
let oldKey :: Key
oldKey = Word32 -> Set ModifierType -> Key
toKey Word32
keyval ([ModifierType] -> Set ModifierType
forall a. Ord a => [a] -> Set a
Set.fromList [ModifierType]
modifiers)
newKey :: Key
newKey = Key -> Key
removeStrangeModifiers Key
oldKey
maybeAction :: Maybe (TMState -> TMWindowId -> IO Bool)
maybeAction = Key
-> Map Key (TMState -> TMWindowId -> IO Bool)
-> Maybe (TMState -> TMWindowId -> IO Bool)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Key
newKey Map Key (TMState -> TMWindowId -> IO Bool)
keyMap
case Maybe (TMState -> TMWindowId -> IO Bool)
maybeAction of
Just TMState -> TMWindowId -> IO Bool
action -> TMState -> TMWindowId -> IO Bool
action TMState
terState TMWindowId
tmWindowId
Maybe (TMState -> TMWindowId -> IO Bool)
Nothing -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False