    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Actions.MouseGestures
    -- Description :  Support for simple mouse gestures.
    -- Copyright   :  (c) Lukas Mai
    -- License     :  BSD3-style (see LICENSE)
    --
    -- Maintainer  :  <l.mai@web.de>
    -- Stability   :  unstable
    -- Portability :  unportable
    --
    -- Support for simple mouse gestures.
    --
    -----------------------------------------------------------------------------

    module XMonad.Actions.MouseGestures (
        -- * Usage
        -- $usage
        Direction2D(..),
        mouseGestureH,
        mouseGesture,
        mkCollect
    ) where

    import XMonad.Prelude
    import XMonad
    import XMonad.Util.Types (Direction2D(..))

    import Data.IORef
    import qualified Data.Map as M
    import Data.Map (Map)

    -- $usage
    --
    -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
    --
    -- > import XMonad.Actions.MouseGestures
    -- > import qualified XMonad.StackSet as W
    --
    -- then add an appropriate mouse binding:
    --
    -- >     , ((modm .|. shiftMask, button3), mouseGesture gestures)
    --
    -- where @gestures@ is a 'Data.Map.Map' from gestures to actions on
    -- windows, for example:
    --
    -- >     gestures = M.fromList
    -- >         [ ([], focus)
    -- >         , ([U], \w -> focus w >> windows W.swapUp)
    -- >         , ([D], \w -> focus w >> windows W.swapDown)
    -- >         , ([R, D], \_ -> sendMessage NextLayout)
    -- >         ]
    --
    -- This is just an example, of course; you can use any mouse button and
    -- gesture definitions you want.
    --
    -- For detailed instructions on editing your mouse bindings, see
    -- "XMonad.Doc.Extending#Editing_mouse_bindings".

    type Pos = (Position, Position)

    delta :: Pos -> Pos -> Position
    delta :: Pos -> Pos -> Position
    delta (Position
    ax, Position
    ay) (Position
    bx, Position
    by) = Position -> Position -> Position
    forall a. Ord a => a -> a -> a
    max (Position -> Position -> Position
    forall {a}. Num a => a -> a -> a
    d Position
    ax Position
    bx) (Position -> Position -> Position
    forall {a}. Num a => a -> a -> a
    d Position
    ay Position
    by)
        where
        d :: a -> a -> a
    d a
    a a
    b = a -> a
    forall a. Num a => a -> a
    abs (a
    a a -> a -> a
    forall {a}. Num a => a -> a -> a
    - a
    b)

    dir :: Pos -> Pos -> Direction2D
    dir :: Pos -> Pos -> Direction2D
    dir (Position
    ax, Position
    ay) (Position
    bx, Position
    by) = Double -> Direction2D
    trans (Double -> Direction2D)
    -> (Double -> Double) -> Double -> Direction2D
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Double
    forall a. Floating a => a
    pi) (Double -> Direction2D) -> Double -> Direction2D
    forall a b. (a -> b) -> a -> b
    $ Double -> Double -> Double
    forall a. RealFloat a => a -> a -> a
    atan2 (Position -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Position -> Double) -> Position -> Double
    forall a b. (a -> b) -> a -> b
    $ Position
    ay Position -> Position -> Position
    forall {a}. Num a => a -> a -> a
    - Position
    by) (Position -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Position -> Double) -> Position -> Double
    forall a b. (a -> b) -> a -> b
    $ Position
    bx Position -> Position -> Position
    forall {a}. Num a => a -> a -> a
    - Position
    ax)
        where
        trans :: Double -> Direction2D
        trans :: Double -> Direction2D
    trans Double
    x
            | Double -> Double -> Double -> Bool
    forall {a}. Ord a => a -> a -> a -> Bool
    rg (-Double
    3Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    /Double
    4) (-Double
    1Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    /Double
    4) Double
    x = Direction2D
    D
            | Double -> Double -> Double -> Bool
    forall {a}. Ord a => a -> a -> a -> Bool
    rg (-Double
    1Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    /Double
    4)  (Double
    1Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    /Double
    4) Double
    x = Direction2D
    R
            | Double -> Double -> Double -> Bool
    forall {a}. Ord a => a -> a -> a -> Bool
    rg  (Double
    1Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    /Double
    4)  (Double
    3Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    /Double
    4) Double
    x = Direction2D
    U
            | Bool
    otherwise          = Direction2D
    L
        rg :: a -> a -> a -> Bool
    rg a
    a a
    z a
    x = a
    a a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= a
    x Bool -> Bool -> Bool
    && a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    < a
    z

    gauge :: (Direction2D -> X ()) -> Pos -> IORef (Maybe (Direction2D, Pos)) -> Position -> Position -> X ()
    gauge :: (Direction2D -> X ())
    -> Pos
    -> IORef (Maybe (Direction2D, Pos))
    -> Position
    -> Position
    -> X ()
    gauge Direction2D -> X ()
    hook Pos
    op IORef (Maybe (Direction2D, Pos))
    st Position
    nx Position
    ny = do
        let np :: Pos
    np = (Position
    nx, Position
    ny)
        Maybe (Direction2D, Pos)
    stx <- IO (Maybe (Direction2D, Pos)) -> X (Maybe (Direction2D, Pos))
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (Maybe (Direction2D, Pos)) -> X (Maybe (Direction2D, Pos)))
    -> IO (Maybe (Direction2D, Pos)) -> X (Maybe (Direction2D, Pos))
    forall a b. (a -> b) -> a -> b
    $ IORef (Maybe (Direction2D, Pos)) -> IO (Maybe (Direction2D, Pos))
    forall a. IORef a -> IO a
    readIORef IORef (Maybe (Direction2D, Pos))
    st
        let pivot :: Pos
    pivot = Pos
    -> ((Direction2D, Pos) -> Pos) -> Maybe (Direction2D, Pos) -> Pos
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Pos
    op (Direction2D, Pos) -> Pos
    forall a b. (a, b) -> b
    snd Maybe (Direction2D, Pos)
    stx
        Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Pos -> Pos -> Bool
    significant Pos
    np Pos
    pivot) (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $ do
            let d' :: Direction2D
    d' = Pos -> Pos -> Direction2D
    dir Pos
    pivot Pos
    np
            Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (((Direction2D, Pos) -> Direction2D
    forall a b. (a, b) -> a
    fst ((Direction2D, Pos) -> Direction2D)
    -> Maybe (Direction2D, Pos) -> Maybe Direction2D
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe (Direction2D, Pos)
    stx) Maybe Direction2D -> Maybe Direction2D -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Direction2D -> Maybe Direction2D
    forall a. a -> Maybe a
    Just Direction2D
    d') (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $ Direction2D -> X ()
    hook Direction2D
    d'
            IO () -> X ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> X ()) -> IO () -> X ()
    forall a b. (a -> b) -> a -> b
    $ IORef (Maybe (Direction2D, Pos))
    -> Maybe (Direction2D, Pos) -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef (Maybe (Direction2D, Pos))
    st ((Direction2D, Pos) -> Maybe (Direction2D, Pos)
    forall a. a -> Maybe a
    Just (Direction2D
    d', Pos
    np))
        where
        significant :: Pos -> Pos -> Bool
    significant Pos
    a Pos
    b = Pos -> Pos -> Position
    delta Pos
    a Pos
    b Position -> Position -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Position
    10

    -- | @'mouseGestureH' moveHook endHook@ is a mouse button
    -- event handler. It collects mouse movements, calling @moveHook@ for each
    -- update; when the button is released, it calls @endHook@.
    mouseGestureH :: (Direction2D -> X ()) -> X () -> X ()
    mouseGestureH :: (Direction2D -> X ()) -> X () -> X ()
    mouseGestureH Direction2D -> X ()
    moveHook X ()
    endHook = do
        Display
    dpy <- (XConf -> Display) -> X Display
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> Display
    display
        Window
    root <- (XConf -> Window) -> X Window
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> Window
    theRoot
        (Pos
    pos, IORef (Maybe (Direction2D, Pos))
    acc) <- IO (Pos, IORef (Maybe (Direction2D, Pos)))
    -> X (Pos, IORef (Maybe (Direction2D, Pos)))
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (Pos, IORef (Maybe (Direction2D, Pos)))
     -> X (Pos, IORef (Maybe (Direction2D, Pos))))
    -> IO (Pos, IORef (Maybe (Direction2D, Pos)))
    -> X (Pos, IORef (Maybe (Direction2D, Pos)))
    forall a b. (a -> b) -> a -> b
    $ do
            (Bool
    _, Window
    _, Window
    _, CInt
    ix, CInt
    iy, CInt
    _, CInt
    _, Modifier
    _) <- Display
    -> Window
    -> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
    queryPointer Display
    dpy Window
    root
            IORef (Maybe (Direction2D, Pos))
    r <- Maybe (Direction2D, Pos) -> IO (IORef (Maybe (Direction2D, Pos)))
    forall a. a -> IO (IORef a)
    newIORef Maybe (Direction2D, Pos)
    forall a. Maybe a
    Nothing
            (Pos, IORef (Maybe (Direction2D, Pos)))
    -> IO (Pos, IORef (Maybe (Direction2D, Pos)))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((CInt -> Position
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral CInt
    ix, CInt -> Position
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral CInt
    iy), IORef (Maybe (Direction2D, Pos))
    r)
        (Position -> Position -> X ()) -> X () -> X ()
    mouseDrag ((Direction2D -> X ())
    -> Pos
    -> IORef (Maybe (Direction2D, Pos))
    -> Position
    -> Position
    -> X ()
    gauge Direction2D -> X ()
    moveHook Pos
    pos IORef (Maybe (Direction2D, Pos))
    acc) X ()
    endHook

    -- | A utility function on top of 'mouseGestureH'. It uses a 'Data.Map.Map' to
    -- look up the mouse gesture, then executes the corresponding action (if any).
    mouseGesture :: Map [Direction2D] (Window -> X ()) -> Window -> X ()
    mouseGesture :: Map [Direction2D] (Window -> X ()) -> Window -> X ()
    mouseGesture Map [Direction2D] (Window -> X ())
    tbl Window
    win = do
        (Direction2D -> X [Direction2D]
    mov, X [Direction2D]
    end) <- X (Direction2D -> X [Direction2D], X [Direction2D])
    forall (m :: * -> *) (m' :: * -> *).
    (MonadIO m, MonadIO m') =>
    m (Direction2D -> m' [Direction2D], m' [Direction2D])
    mkCollect
        (Direction2D -> X ()) -> X () -> X ()
    mouseGestureH (X [Direction2D] -> X ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (X [Direction2D] -> X ())
    -> (Direction2D -> X [Direction2D]) -> Direction2D -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Direction2D -> X [Direction2D]
    mov) (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $ X [Direction2D]
    end X [Direction2D] -> ([Direction2D] -> X ()) -> X ()
    forall a b. X a -> (a -> X b) -> X b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \[Direction2D]
    gest ->
            case [Direction2D]
    -> Map [Direction2D] (Window -> X ()) -> Maybe (Window -> X ())
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup [Direction2D]
    gest Map [Direction2D] (Window -> X ())
    tbl of
                Maybe (Window -> X ())
    Nothing -> () -> X ()
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                Just Window -> X ()
    f -> Window -> X ()
    f Window
    win

    -- | A callback generator for 'mouseGestureH'. 'mkCollect' returns two
    -- callback functions for passing to 'mouseGestureH'. The move hook will
    -- collect mouse movements (and return the current gesture as a list); the end
    -- hook will return a list of the completed gesture, which you can access with
    -- 'Control.Monad.>>='.
    mkCollect :: (MonadIO m, MonadIO m') => m (Direction2D -> m' [Direction2D], m' [Direction2D])
    mkCollect :: forall (m :: * -> *) (m' :: * -> *).
    (MonadIO m, MonadIO m') =>
    m (Direction2D -> m' [Direction2D], m' [Direction2D])
    mkCollect = IO (Direction2D -> m' [Direction2D], m' [Direction2D])
    -> m (Direction2D -> m' [Direction2D], m' [Direction2D])
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Direction2D -> m' [Direction2D], m' [Direction2D])
     -> m (Direction2D -> m' [Direction2D], m' [Direction2D]))
    -> IO (Direction2D -> m' [Direction2D], m' [Direction2D])
    -> m (Direction2D -> m' [Direction2D], m' [Direction2D])
    forall a b. (a -> b) -> a -> b
    $ do
        IORef [Direction2D]
    acc <- [Direction2D] -> IO (IORef [Direction2D])
    forall a. a -> IO (IORef a)
    newIORef []
        let
            mov :: Direction2D -> m [Direction2D]
    mov Direction2D
    d = IO [Direction2D] -> m [Direction2D]
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO [Direction2D] -> m [Direction2D])
    -> IO [Direction2D] -> m [Direction2D]
    forall a b. (a -> b) -> a -> b
    $ do
                [Direction2D]
    ds <- IORef [Direction2D] -> IO [Direction2D]
    forall a. IORef a -> IO a
    readIORef IORef [Direction2D]
    acc
                let ds' :: [Direction2D]
    ds' = Direction2D
    d Direction2D -> [Direction2D] -> [Direction2D]
    forall a. a -> [a] -> [a]
    : [Direction2D]
    ds
                IORef [Direction2D] -> [Direction2D] -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef [Direction2D]
    acc [Direction2D]
    ds'
                [Direction2D] -> IO [Direction2D]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Direction2D] -> IO [Direction2D])
    -> [Direction2D] -> IO [Direction2D]
    forall a b. (a -> b) -> a -> b
    $ [Direction2D] -> [Direction2D]
    forall a. [a] -> [a]
    reverse [Direction2D]
    ds'
            end :: m' [Direction2D]
    end = IO [Direction2D] -> m' [Direction2D]
    forall a. IO a -> m' a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO [Direction2D] -> m' [Direction2D])
    -> IO [Direction2D] -> m' [Direction2D]
    forall a b. (a -> b) -> a -> b
    $ do
                [Direction2D]
    ds <- IORef [Direction2D] -> IO [Direction2D]
    forall a. IORef a -> IO a
    readIORef IORef [Direction2D]
    acc
                IORef [Direction2D] -> [Direction2D] -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef [Direction2D]
    acc []
                [Direction2D] -> IO [Direction2D]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Direction2D] -> IO [Direction2D])
    -> [Direction2D] -> IO [Direction2D]
    forall a b. (a -> b) -> a -> b
    $ [Direction2D] -> [Direction2D]
    forall a. [a] -> [a]
    reverse [Direction2D]
    ds
        (Direction2D -> m' [Direction2D], m' [Direction2D])
    -> IO (Direction2D -> m' [Direction2D], m' [Direction2D])
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Direction2D -> m' [Direction2D]
    forall {m :: * -> *}. MonadIO m => Direction2D -> m [Direction2D]
    mov, m' [Direction2D]
    end)