    module Termonad.Keys where

    import Termonad.Prelude

    import Control.Lens (imap)
    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)

    showKeys :: EventKey -> IO Bool
    showKeys :: EventKey -> IO Bool
    showKeys EventKey
    eventKey = do
      eventType <- EventKey -> IO EventType
    forall (m :: * -> *). MonadIO m => EventKey -> m EventType
    getEventKeyType EventKey
    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 = " <> tshow eventType
      putStrLn $ "  str = " <> tshow maybeString
      putStrLn $ "  mods = " <> tshow modifiers
      putStrLn $ "  isMod = " <> tshow isMod
      putStrLn $ "  len = " <> tshow len
      putStrLn $ "  keyval = " <> tshow keyval
      putStrLn $ "  keycode = " <> tshow keycode
      putStrLn ""

      pure 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 -> ShowS
    [Key] -> ShowS
    Key -> String
    (Int -> Key -> ShowS)
    -> (Key -> String) -> ([Key] -> ShowS) -> Show Key
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Key -> ShowS
    showsPrec :: Int -> Key -> ShowS
    $cshow :: Key -> String
    show :: Key -> String
    $cshowList :: [Key] -> ShowS
    showList :: [Key] -> ShowS
    Show)

    toKey :: Word32 -> Set ModifierType -> Key
    toKey :: Word32 -> Set ModifierType -> Key
    toKey = Word32 -> Set ModifierType -> Key
    Key

    keyMap :: Map Key (TMState -> IO Bool)
    keyMap :: Map Key (TMState -> IO Bool)
    keyMap =
      let 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 -> IO Bool)]
    altNumKeys =
            (Int -> Word32 -> (Key, TMState -> IO Bool))
    -> [Word32] -> [(Key, TMState -> 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 -> IO ()) -> TMState -> IO Bool
    forall a. (TMState -> IO a) -> TMState -> IO Bool
    stopProp (Int -> TMState -> IO ()
    altNumSwitchTerm Int
    i))
              )
              [Word32]
    numKeys
      in
      [(ContainerKey (Map Key (TMState -> IO Bool)),
      MapValue (Map Key (TMState -> IO Bool)))]
    -> Map Key (TMState -> IO Bool)
    forall map. IsMap map => [(ContainerKey map, MapValue map)] -> map
    mapFromList [(ContainerKey (Map Key (TMState -> IO Bool)),
      MapValue (Map Key (TMState -> IO Bool)))]
    [(Key, TMState -> IO Bool)]
    altNumKeys

    stopProp :: (TMState -> IO a) -> TMState -> IO Bool
    stopProp :: forall a. (TMState -> IO a) -> TMState -> IO Bool
    stopProp TMState -> IO a
    callback TMState
    terState = TMState -> IO a
    callback TMState
    terState 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 =
            [ 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 set. SetContainer set => set -> set -> set
    difference Set ModifierType
    keyMods Set ModifierType
    reservedModifiers)

    handleKeyPress :: TMState -> EventKey -> IO Bool
    handleKeyPress :: TMState -> EventKey -> IO Bool
    handleKeyPress TMState
    terState EventKey
    eventKey = do
      -- void $ showKeys eventKey
      keyval <- EventKey -> IO Word32
    forall (m :: * -> *). MonadIO m => EventKey -> m Word32
    getEventKeyKeyval EventKey
    eventKey
      modifiers <- getEventKeyState eventKey
      let oldKey = Word32 -> Set ModifierType -> Key
    toKey Word32
    keyval ([Element (Set ModifierType)] -> Set ModifierType
    forall set. IsSet set => [Element set] -> set
    setFromList [Element (Set ModifierType)]
    [ModifierType]
    modifiers)
          newKey = Key -> Key
    removeStrangeModifiers Key
    oldKey
          maybeAction = ContainerKey (Map Key (TMState -> IO Bool))
    -> Map Key (TMState -> IO Bool)
    -> Maybe (MapValue (Map Key (TMState -> IO Bool)))
    forall map.
    IsMap map =>
    ContainerKey map -> map -> Maybe (MapValue map)
    lookup ContainerKey (Map Key (TMState -> IO Bool))
    Key
    newKey Map Key (TMState -> IO Bool)
    keyMap
      case maybeAction of
        Just MapValue (Map Key (TMState -> IO Bool))
    action -> MapValue (Map Key (TMState -> IO Bool))
    TMState -> IO Bool
    action TMState
    terState
        Maybe (MapValue (Map Key (TMState -> IO Bool)))
    Nothing -> Bool -> IO Bool
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False