module Internal.Submap (
    mapNextString,
    submapButtonsWithKey,
    nextButton,
    nextMotion,
    module X) where

import XMonad hiding (keys)
import Control.Monad.Fix (fix)
import qualified Data.Map as Map
import Data.Map (Map)

import XMonad.Actions.Submap as X

{- Like submap fram XMonad.Actions.Submap, but sends the string from
 - XLookupString to the function rather than the KeySym.
 -}
mapNextString :: (KeyMask -> String -> X a) -> X a
mapNextString fn = do
  XConf { theRoot = root, display = d } <- ask
  io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime

  (m, str) <- io $ allocaXEvent $ \p -> fix $ \nextkey -> do
    maskEvent d keyPressMask p
    KeyEvent { ev_keycode = code, ev_state = m } <- getEvent p
    keysym <- keycodeToKeysym d code 0
    (_, str) <- lookupString (asKeyEvent p)

    if isModifierKey keysym
        then nextkey
        else return (m, str)

  io $ ungrabKeyboard d currentTime

  fn m str

nextButton :: X (ButtonMask, Button)
nextButton = do
  XConf { theRoot = root, display = d } <- ask
  io $ grabPointer d root False buttonPressMask grabModeAsync grabModeAsync 0 0 currentTime

  ret <- io $ allocaXEvent $ \xEv -> do
    maskEvent d buttonPressMask xEv
    ButtonEvent { ev_button = button, ev_state = m } <- getEvent xEv
    return (m, button)

  io $ ungrabPointer d currentTime

  return ret

nextMotion :: X (Int, Int)
nextMotion = do
  XConf { theRoot = root, display = d } <- ask
  io $ grabPointer d root False pointerMotionMask grabModeAsync grabModeAsync 0 0 currentTime

  ret <- io $ allocaXEvent $ \xEv -> do
    maskEvent d pointerMotionMask xEv
    MotionEvent { ev_x = x, ev_y = y } <- getEvent xEv
    return (fromIntegral x, fromIntegral y)

  io $ ungrabPointer d currentTime

  return ret

submapButtonsWithKey ::
    ((ButtonMask, Button) -> Window -> X ()) -> Map (ButtonMask, Button) (Window -> X ()) -> Window -> X ()
submapButtonsWithKey defaultAction actions window = do
  arg <- nextButton

  case Map.lookup arg actions of
    Nothing -> defaultAction arg window
    Just fn -> fn window