module Rahm.Desktop.Submap (
    mapNextString,
    mapNextStringWithKeysym,
    submapButtonsWithKey,
    nextButton,
    nextMotion,
    nextMotionOrButton,
    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 along side the keysym.
 -
 - This function allows mappings where the mapped string might be important,
 - but also allows submappings for keys that may not have a character associated
 - with them (for example, the function keys).
 -}
mapNextStringWithKeysym :: (KeyMask -> KeySym -> String -> X a) -> X a
mapNextStringWithKeysym fn = do
  XConf { theRoot = root, display = d } <- ask
  io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime

  (m, str, keysym) <- 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, keysym)

  io $ ungrabKeyboard d currentTime

  fn m keysym str

{- Like submap, but on the character typed rather than the kysym. -}
mapNextString :: (KeyMask -> String -> X a) -> X a 
mapNextString fn = mapNextStringWithKeysym (\m _ s -> fn m s)

{- Grabs the mouse and returns the next button press. -}
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

{- Grabs the mouse and reports the next mouse motion. -}
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

{- Grabs the mouse and reports the next mouse motion or button press. -}
nextMotionOrButton :: X (Either (Int, Int) (ButtonMask, Button))
nextMotionOrButton = do
  XConf { theRoot = root, display = d } <- ask
  io $ grabPointer d root False (pointerMotionMask .|. buttonPressMask) grabModeAsync grabModeAsync 0 0 currentTime

  ret <- io $ allocaXEvent $ \xEv -> do
    maskEvent d (pointerMotionMask .|. buttonPressMask) xEv
    ev <- getEvent xEv
    case ev of
      MotionEvent { ev_x = x, ev_y = y } ->
        return $ Left (fromIntegral x, fromIntegral y)
      ButtonEvent { ev_button = button, ev_state = m } ->
        return $ Right (m, button)

  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