    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Actions.Warp
    -- Description :  Warp the pointer to a given window or screen.
    -- Copyright   :  (c) daniel@wagner-home.com
    -- License     :  BSD3-style (see LICENSE)
    --
    -- Maintainer  :  daniel@wagner-home.com
    -- Stability   :  unstable
    -- Portability :  unportable
    --
    -- Warp the pointer to a given window or screen.
    --
    -----------------------------------------------------------------------------

    module XMonad.Actions.Warp (
                               -- * Usage
                               -- $usage
                               banish,
                               banishScreen,
                               Corner(..),
                               warpToScreen,
                               warpToWindow
                              ) where

    import XMonad.Prelude
    import XMonad
    import XMonad.StackSet as W

    {- $usage
    You can use this module with the following in your @xmonad.hs@:

    > import XMonad.Actions.Warp

    then add appropriate keybindings to warp the pointer; for example:

    > , ((modm,   xK_z     ), warpToWindow (1%2) (1%2)) -- @@ Move pointer to currently focused window
    >
    >-- mod-ctrl-{w,e,r} @@ Move mouse pointer to screen 1, 2, or 3
    >
    >   [((modm .|. controlMask, key), warpToScreen sc (1%2) (1%2))
    >       | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]]

    Note that warping to a particular screen may change the focus.
    -}

    -- For detailed instructions on editing your key bindings, see
    -- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.

    data Corner = UpperLeft | UpperRight | LowerLeft | LowerRight

    {- | Move the mouse cursor to a corner of the focused window. Useful for
       uncluttering things.

       Internally, this uses numerical parameters. We parametrize on the 'Corner'
       type so the user need not see the violence inherent in
       the system.

       'warpToScreen' and 'warpToWindow' can be used in a variety of
       ways. Suppose you wanted to emulate Ratpoison's \'banish\' command,
       which moves the mouse pointer to a corner? warpToWindow can do that! -}
    banish :: Corner -> X ()
    banish :: Corner -> X ()
    banish Corner
    direction = case Corner
    direction of
                         Corner
    LowerRight -> Rational -> Rational -> X ()
    warpToWindow Rational
    1 Rational
    1
                         Corner
    LowerLeft  -> Rational -> Rational -> X ()
    warpToWindow Rational
    0 Rational
    1
                         Corner
    UpperLeft  -> Rational -> Rational -> X ()
    warpToWindow Rational
    0 Rational
    0
                         Corner
    UpperRight -> Rational -> Rational -> X ()
    warpToWindow Rational
    1 Rational
    0

    {- | Same as 'banish' but moves the mouse to the corner of the
       currently focused screen -}
    banishScreen :: Corner -> X ()
    banishScreen :: Corner -> X ()
    banishScreen Corner
    direction = case Corner
    direction of
                               Corner
    LowerRight -> Rational -> Rational -> X ()
    warpToCurrentScreen Rational
    1 Rational
    1
                               Corner
    LowerLeft  -> Rational -> Rational -> X ()
    warpToCurrentScreen Rational
    0 Rational
    1
                               Corner
    UpperLeft  -> Rational -> Rational -> X ()
    warpToCurrentScreen Rational
    0 Rational
    0
                               Corner
    UpperRight -> Rational -> Rational -> X ()
    warpToCurrentScreen Rational
    1 Rational
    0
        where
          warpToCurrentScreen :: Rational -> Rational -> X ()
    warpToCurrentScreen Rational
    h Rational
    v =
              do WindowSet
    ws <- (XState -> WindowSet) -> X WindowSet
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XState -> WindowSet
    windowset
                 ScreenId -> Rational -> Rational -> X ()
    warpToScreen (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> ScreenId
    forall i l a sid sd. Screen i l a sid sd -> sid
    W.screen (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
     -> ScreenId)
    -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> ScreenId
    forall a b. (a -> b) -> a -> b
    $ WindowSet
    -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
    current WindowSet
    ws) Rational
    h Rational
    v
                 (WindowSet -> WindowSet) -> X ()
    windows (WindowSet -> WindowSet -> WindowSet
    forall a b. a -> b -> a
    const WindowSet
    ws)

    fraction :: (Integral a, Integral b) => Rational -> a -> b
    fraction :: forall a b. (Integral a, Integral b) => Rational -> a -> b
    fraction Rational
    f a
    x = Rational -> b
    forall b. Integral b => Rational -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (Rational
    f Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * a -> Rational
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    x)

    warp :: Window -> Position -> Position -> X ()
    warp :: Window -> Position -> Position -> X ()
    warp Window
    w Position
    x Position
    y = (Display -> X ()) -> X ()
    forall a. (Display -> X a) -> X a
    withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
    forall a b. (a -> b) -> a -> b
    $ \Display
    d -> IO () -> X ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> X ()) -> IO () -> X ()
    forall a b. (a -> b) -> a -> b
    $ Display
    -> Window
    -> Window
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> Position
    -> Position
    -> IO ()
    warpPointer Display
    d Window
    none Window
    w Position
    0 Position
    0 Dimension
    0 Dimension
    0 Position
    x Position
    y

    -- | Warp the pointer to a given position relative to the currently
    --   focused window.  Top left = (0,0), bottom right = (1,1).
    warpToWindow :: Rational -> Rational -> X ()
    warpToWindow :: Rational -> Rational -> X ()
    warpToWindow Rational
    h Rational
    v = (Display -> X ()) -> X ()
    forall a. (Display -> X a) -> X a
    withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
    forall a b. (a -> b) -> a -> b
    $ \Display
    d -> (Window -> X ()) -> X ()
    withFocused ((Window -> X ()) -> X ()) -> (Window -> X ()) -> X ()
    forall a b. (a -> b) -> a -> b
    $ \Window
    w ->
      Display -> Window -> (WindowAttributes -> X ()) -> X ()
    withWindowAttributes Display
    d Window
    w ((WindowAttributes -> X ()) -> X ())
    -> (WindowAttributes -> X ()) -> X ()
    forall a b. (a -> b) -> a -> b
    $ \WindowAttributes
    wa ->
        Window -> Position -> Position -> X ()
    warp Window
    w (Rational -> CInt -> Position
    forall a b. (Integral a, Integral b) => Rational -> a -> b
    fraction Rational
    h (WindowAttributes -> CInt
    wa_width WindowAttributes
    wa)) (Rational -> CInt -> Position
    forall a b. (Integral a, Integral b) => Rational -> a -> b
    fraction Rational
    v (WindowAttributes -> CInt
    wa_height WindowAttributes
    wa))

    -- | Warp the pointer to the given position (top left = (0,0), bottom
    --   right = (1,1)) on the given screen.
    warpToScreen :: ScreenId -> Rational -> Rational -> X ()
    warpToScreen :: ScreenId -> Rational -> Rational -> X ()
    warpToScreen ScreenId
    n Rational
    h Rational
    v = do
        Window
    root <- (XConf -> Window) -> X Window
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> Window
    theRoot
        StackSet{current :: forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
    current = Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    x, visible :: forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
    visible = [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
    xs} <- (XState -> WindowSet) -> X WindowSet
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XState -> WindowSet
    windowset
        Maybe Rectangle -> (Rectangle -> X ()) -> X ()
    forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
    whenJust ((Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
     -> Rectangle)
    -> Maybe
         (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
    -> Maybe Rectangle
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (ScreenDetail -> Rectangle
    screenRect (ScreenDetail -> Rectangle)
    -> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
        -> ScreenDetail)
    -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> Rectangle
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> ScreenDetail
    forall i l a sid sd. Screen i l a sid sd -> sd
    W.screenDetail) (Maybe
       (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
     -> Maybe Rectangle)
    -> ([Screen
           WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
        -> Maybe
             (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
    -> [Screen
          WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
    -> Maybe Rectangle
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
     -> Bool)
    -> [Screen
          WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
    -> Maybe
         (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find ((ScreenId
    nScreenId -> ScreenId -> Bool
    forall a. Eq a => a -> a -> Bool
    ==) (ScreenId -> Bool)
    -> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
        -> ScreenId)
    -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> ScreenId
    forall i l a sid sd. Screen i l a sid sd -> sid
    W.screen) ([Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
     -> Maybe Rectangle)
    -> [Screen
          WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
    -> Maybe Rectangle
    forall a b. (a -> b) -> a -> b
    $ Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    x Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> [Screen
          WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
    -> [Screen
          WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
    forall a. a -> [a] -> [a]
    : [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
    xs)
            ((Rectangle -> X ()) -> X ()) -> (Rectangle -> X ()) -> X ()
    forall a b. (a -> b) -> a -> b
    $ \Rectangle
    r ->
                Window -> Position -> Position -> X ()
    warp Window
    root (Rectangle -> Position
    rect_x Rectangle
    r Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Rational -> Dimension -> Position
    forall a b. (Integral a, Integral b) => Rational -> a -> b
    fraction Rational
    h (Rectangle -> Dimension
    rect_width  Rectangle
    r))
                          (Rectangle -> Position
    rect_y Rectangle
    r Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Rational -> Dimension -> Position
    forall a b. (Integral a, Integral b) => Rational -> a -> b
    fraction Rational
    v (Rectangle -> Dimension
    rect_height Rectangle
    r))