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 = do eventType <- getEventKeyType eventKey maybeString <- getEventKeyString eventKey modifiers <- getEventKeyState eventKey len <- getEventKeyLength eventKey keyval <- getEventKeyKeyval eventKey isMod <- getEventKeyIsModifier eventKey keycode <- getEventKeyHardwareKeycode eventKey putStrLn "key press event:" putStrLn $ " type = " <> show eventType putStrLn $ " str = " <> show maybeString putStrLn $ " mods = " <> show modifiers putStrLn $ " isMod = " <> show isMod putStrLn $ " len = " <> show len putStrLn $ " keyval = " <> show keyval putStrLn $ " keycode = " <> show keycode putStrLn "" pure True data Key = Key { keyVal :: !Word32 , keyMods :: !(Set ModifierType) } deriving (Eq, Ord, Show) toKey :: Word32 -> Set ModifierType -> Key toKey = Key keyMap :: Map Key (TMState -> TMWindowId -> IO Bool) keyMap = let numKeys :: [Word32] numKeys = [ KEY_1 , KEY_2 , KEY_3 , KEY_4 , KEY_5 , KEY_6 , KEY_7 , KEY_8 , KEY_9 , KEY_0 ] altNumKeys :: [(Key, TMState -> TMWindowId -> IO Bool)] altNumKeys = imap (\i k -> (toKey k [ModifierTypeMod1Mask], stopProp (altNumSwitchTerm i)) ) numKeys in Map.fromList altNumKeys stopProp :: (TMState -> TMWindowId -> IO a) -> TMState -> TMWindowId -> IO Bool stopProp callback terState tmWinId = callback terState tmWinId $> True removeStrangeModifiers :: Key -> Key removeStrangeModifiers Key{keyVal, keyMods} = let reservedModifiers :: Set ModifierType reservedModifiers = [ ModifierTypeModifierReserved13Mask , ModifierTypeModifierReserved14Mask , ModifierTypeModifierReserved15Mask , ModifierTypeModifierReserved16Mask , ModifierTypeModifierReserved17Mask , ModifierTypeModifierReserved18Mask , ModifierTypeModifierReserved19Mask , ModifierTypeModifierReserved20Mask , ModifierTypeModifierReserved21Mask , ModifierTypeModifierReserved22Mask , ModifierTypeModifierReserved23Mask , ModifierTypeModifierReserved24Mask , ModifierTypeModifierReserved25Mask , ModifierTypeModifierReserved29Mask ] in Key keyVal (Set.difference keyMods reservedModifiers) handleKeyPress :: TMState -> TMWindowId -> EventKey -> IO Bool handleKeyPress terState tmWindowId eventKey = do -- void $ showKeys eventKey keyval <- getEventKeyKeyval eventKey modifiers <- getEventKeyState eventKey let oldKey = toKey keyval (Set.fromList modifiers) newKey = removeStrangeModifiers oldKey maybeAction = Map.lookup newKey keyMap case maybeAction of Just action -> action terState tmWindowId Nothing -> pure False