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
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

  Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn Text
"key press event:"
  Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"  type = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> EventType -> Text
forall a. Show a => a -> Text
tshow EventType
eventType
  Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"  str = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Text
forall a. Show a => a -> Text
tshow Maybe Text
maybeString
  Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"  mods = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [ModifierType] -> Text
forall a. Show a => a -> Text
tshow [ModifierType]
modifiers
  Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"  isMod = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word32 -> Text
forall a. Show a => a -> Text
tshow Word32
isMod
  Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"  len = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int32 -> Text
forall a. Show a => a -> Text
tshow Int32
len
  Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"  keyval = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word32 -> Text
forall a. Show a => a -> Text
tshow Word32
keyval
  Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"  keycode = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word16 -> Text
forall a. Show a => a -> Text
tshow Word16
keycode
  Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn Text
""

  Bool -> IO Bool
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
/= :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c== :: 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
min :: Key -> Key -> Key
$cmin :: Key -> Key -> Key
max :: Key -> Key -> Key
$cmax :: Key -> Key -> Key
>= :: Key -> Key -> Bool
$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
compare :: Key -> Key -> Ordering
$ccompare :: Key -> Key -> Ordering
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
showList :: [Key] -> ShowS
$cshowList :: [Key] -> ShowS
show :: Key -> String
$cshow :: Key -> String
showsPrec :: Int -> Key -> ShowS
$cshowsPrec :: Int -> 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 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 :: Word32
keyVal :: Key -> Word32
keyVal, Set ModifierType
keyMods :: Set ModifierType
keyMods :: Key -> 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
  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 ([Element (Set ModifierType)] -> Set ModifierType
forall set. IsSet set => [Element set] -> set
setFromList [Element (Set ModifierType)]
[ModifierType]
modifiers)
      newKey :: Key
newKey = Key -> Key
removeStrangeModifiers Key
oldKey
      maybeAction :: Maybe (MapValue (Map Key (TMState -> IO Bool)))
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 Maybe (MapValue (Map Key (TMState -> IO Bool)))
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 (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False