-----------------------------------------------------------------------------
-- |
-- 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 Dimension) Dimension ScreenId ScreenDetail
-> ScreenId
forall i l a sid sd. Screen i l a sid sd -> sid
W.screen (Screen
   WorkspaceId (Layout Dimension) Dimension ScreenId ScreenDetail
 -> ScreenId)
-> Screen
     WorkspaceId (Layout Dimension) Dimension ScreenId ScreenDetail
-> ScreenId
forall a b. (a -> b) -> a -> b
$ WindowSet
-> Screen
     WorkspaceId (Layout Dimension) Dimension 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 :: Dimension -> Position -> Position -> X ()
warp Dimension
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
-> Dimension
-> Dimension
-> Position
-> Position
-> Dimension
-> Dimension
-> Position
-> Position
-> IO ()
warpPointer Display
d Dimension
none Dimension
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 -> (Dimension -> X ()) -> X ()
withFocused ((Dimension -> X ()) -> X ()) -> (Dimension -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Dimension
w ->
  Display -> Dimension -> (WindowAttributes -> X ()) -> X ()
withWindowAttributes Display
d Dimension
w ((WindowAttributes -> X ()) -> X ())
-> (WindowAttributes -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \WindowAttributes
wa ->
    Dimension -> Position -> Position -> X ()
warp Dimension
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
    Dimension
root <- (XConf -> Dimension) -> X Dimension
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Dimension
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 Dimension) Dimension 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 Dimension) Dimension 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 Dimension) Dimension ScreenId ScreenDetail
 -> Rectangle)
-> Maybe
     (Screen
        WorkspaceId (Layout Dimension) Dimension 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 Dimension) Dimension ScreenId ScreenDetail
    -> ScreenDetail)
-> Screen
     WorkspaceId (Layout Dimension) Dimension ScreenId ScreenDetail
-> Rectangle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen
  WorkspaceId (Layout Dimension) Dimension ScreenId ScreenDetail
-> ScreenDetail
forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail) (Maybe
   (Screen
      WorkspaceId (Layout Dimension) Dimension ScreenId ScreenDetail)
 -> Maybe Rectangle)
-> ([Screen
       WorkspaceId (Layout Dimension) Dimension ScreenId ScreenDetail]
    -> Maybe
         (Screen
            WorkspaceId (Layout Dimension) Dimension ScreenId ScreenDetail))
-> [Screen
      WorkspaceId (Layout Dimension) Dimension ScreenId ScreenDetail]
-> Maybe Rectangle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Screen
   WorkspaceId (Layout Dimension) Dimension ScreenId ScreenDetail
 -> Bool)
-> [Screen
      WorkspaceId (Layout Dimension) Dimension ScreenId ScreenDetail]
-> Maybe
     (Screen
        WorkspaceId (Layout Dimension) Dimension 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 Dimension) Dimension ScreenId ScreenDetail
    -> ScreenId)
-> Screen
     WorkspaceId (Layout Dimension) Dimension ScreenId ScreenDetail
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen
  WorkspaceId (Layout Dimension) Dimension ScreenId ScreenDetail
-> ScreenId
forall i l a sid sd. Screen i l a sid sd -> sid
W.screen) ([Screen
    WorkspaceId (Layout Dimension) Dimension ScreenId ScreenDetail]
 -> Maybe Rectangle)
-> [Screen
      WorkspaceId (Layout Dimension) Dimension ScreenId ScreenDetail]
-> Maybe Rectangle
forall a b. (a -> b) -> a -> b
$ Screen
  WorkspaceId (Layout Dimension) Dimension ScreenId ScreenDetail
x Screen
  WorkspaceId (Layout Dimension) Dimension ScreenId ScreenDetail
-> [Screen
      WorkspaceId (Layout Dimension) Dimension ScreenId ScreenDetail]
-> [Screen
      WorkspaceId (Layout Dimension) Dimension ScreenId ScreenDetail]
forall a. a -> [a] -> [a]
: [Screen
   WorkspaceId (Layout Dimension) Dimension ScreenId ScreenDetail]
xs)
        ((Rectangle -> X ()) -> X ()) -> (Rectangle -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Rectangle
r ->
            Dimension -> Position -> Position -> X ()
warp Dimension
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))