module Montis.Standard.Bindings where

import Control.Monad (unless, when)
import Control.Monad.IO.Class (liftIO)
import Data.Data (Typeable)
import Data.Default.Class (Default (..))
import Data.Set qualified as Set
import Data.Word (Word32)
import Montis.Base.Foreign.WlRoots (seatKeyboardNotifyKey, seatPointerNotifyButton)
import Montis.Core.Events (ButtonEvent (..), ButtonState (..), KeyEvent (..), KeyState (..))
import Montis.Core.Monad (Montis, xConfigGet, xStateGet, xStateModify)
import Montis.Core.Runtime (getSeat)
import Montis.Core.State
  ( Config (startingHooks),
    ConfigModule (..),
    Hooks (keyHook, buttonHook),
    StateExtension (..),
  )

data InputEvent where
  InputEvent :: Either KeyEvent ButtonEvent -> InputEvent

-- | Configuration for the keybindings.
data InputsConfig where
  InputsConfig ::
    { startCont :: InputEvent -> Montis Bool
    } ->
    InputsConfig
  deriving (Typeable)

instance Default InputsConfig where
  def = InputsConfig $ \_ -> return False

subkeys :: (InputEvent -> Montis Bool) -> Montis Bool
subkeys fn = do
  xStateModify $ \keyState ->
    keyState
      { awaiting = Just fn
      }
  return True

-- | State of the keys right now.
data InputsState where
  InputsState ::
    { awaiting :: Maybe (InputEvent -> Montis Bool),
      ignoredKeys :: Set.Set Word32
    } ->
    InputsState

instance StateExtension InputsState where
  initialValue = InputsState Nothing Set.empty
  marshalExtension = const Nothing
  demarshalExtension = const Nothing

-- | Configurable module for keys.
instance ConfigModule Montis InputsConfig where
  alterConfig _ c =
    let oh = keyHook (startingHooks c)
        obh = buttonHook (startingHooks c)
     in c
          { startingHooks =
              (startingHooks c)
                { keyHook = \ev -> runEv (InputEvent (Left ev)) >> oh ev,
                  buttonHook = \ev -> runEv (InputEvent (Right ev)) >> obh ev
                }
          }
    where
      isKeyPress ev = keyEvent_state ev == KeyPressed
      isKeyRelease ev = keyEvent_state ev == KeyReleased
      shouldIgnoreEvent ev = do
        InputsState {ignoredKeys} <- xStateGet
        return $ Set.member (keyEvent_keycode ev) ignoredKeys
      runEv :: InputEvent -> Montis ()
      runEv iv@(InputEvent (Right ev)) = do
        handler' <- awaiting <$> xStateGet
        handler <- maybe (startCont <$> xConfigGet) return handler'
        xStateModify $ \st ->
          st {awaiting = Nothing}
        handled <- handler iv
        unless handled $
          forwardButtonToSeat ev
      runEv iv@(InputEvent (Left ev)) = do
        shouldIgnore <- shouldIgnoreEvent ev
        if isKeyRelease ev && shouldIgnore
          then xStateModify $ \ks ->
            ks {ignoredKeys = Set.delete (keyEvent_keycode ev) (ignoredKeys ks)}
          else do
            handled <-
              if isKeyPress ev
                then do
                  handler' <- awaiting <$> xStateGet
                  handler <- maybe (startCont <$> xConfigGet) return handler'
                  -- Reset the hadler.
                  xStateModify $ \st ->
                    st {awaiting = Nothing}
                  handler iv
                else return False

            if not handled
              then forwardKeyToSeat ev
              else when (isKeyPress ev) $
                xStateModify $
                  \ks ->
                    ks
                      { ignoredKeys =
                          Set.insert (keyEvent_keycode ev) (ignoredKeys ks)
                      }

forwardKeyToSeat :: KeyEvent -> Montis ()
forwardKeyToSeat ev = do
  mseat <- getSeat
  case mseat of
    Nothing -> return ()
    Just seat ->
      liftIO $
        seatKeyboardNotifyKey
          seat
          (keyEvent_timeMs ev)
          (keyEvent_keycode ev)
          (keyStateToWord32 (keyEvent_state ev))

forwardButtonToSeat :: ButtonEvent -> Montis ()
forwardButtonToSeat ev = do
  mseat <- getSeat
  case mseat of
    Nothing -> return ()
    Just seat ->
      liftIO $
        seatPointerNotifyButton
          seat
          (buttonEvent_timeMs ev)
          (buttonEvent_button ev)
          (buttonStateToWord32 (buttonEvent_state ev))

buttonStateToWord32 :: ButtonState -> Word32
buttonStateToWord32 ButtonReleased = 0
buttonStateToWord32 ButtonPressed = 1

keyStateToWord32 :: KeyState -> Word32
keyStateToWord32 KeyReleased = 0
keyStateToWord32 KeyPressed = 1