    {-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Actions.FlexibleManipulate
    -- Copyright   :  (c) Michael Sloan
    -- License     :  BSD3-style (see LICENSE)
    --
    -- Maintainer  :  <mgsloan@gmail.com>
    -- Stability   :  stable
    -- Portability :  unportable
    --
    -- Move and resize floating windows without warping the mouse.
    --
    -----------------------------------------------------------------------------

    -- Based on the FlexibleResize code by Lukas Mai (mauke).

    module XMonad.Actions.FlexibleManipulate (
            -- * Usage
            -- $usage
            mouseWindow, discrete, linear, resize, position
    ) where

    import XMonad
    import qualified Prelude as P
    import Prelude (($), (.), fst, snd, uncurry, const, id, Ord(..), Monad(..), fromIntegral, Double, Integer, map, round, otherwise)

    -- $usage
    -- First, add this import to your @~\/.xmonad\/xmonad.hs@:
    --
    -- > import qualified XMonad.Actions.FlexibleManipulate as Flex
    --
    -- Now set up the desired mouse binding, for example:
    --
    -- >     , ((modm, button1), (\w -> focus w >> Flex.mouseWindow Flex.linear w))
    --
    -- * Flex.'linear' indicates that positions between the edges and the
    --   middle indicate a combination scale\/position.
    --
    -- * Flex.'discrete' indicates that there are discrete pick
    --   regions. (The window is divided by thirds for each axis.)
    --
    -- * Flex.'resize' performs only a resize of the window, based on which
    --   quadrant the mouse is in.
    --
    -- * Flex.'position' is similar to the built-in
    --   'XMonad.Operations.mouseMoveWindow'.
    --
    -- You can also write your own function for this parameter. It should take
    -- a value between 0 and 1 indicating position, and return a value indicating
    -- the corresponding position if plain Flex.'linear' was used.
    --
    -- For detailed instructions on editing your mouse bindings, see
    -- "XMonad.Doc.Extending#Editing_mouse_bindings".

    discrete, linear, resize, position :: Double -> Double

    -- | Manipulate the window based on discrete pick regions; the window
    --   is divided into regions by thirds along each axis.
    discrete :: Double -> Double
    discrete x :: Double
    x | Double
    x Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    < 0.33 = 0
               | Double
    x Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0.66 = 1
               | Bool
    otherwise = 0.5

    -- | Scale\/reposition the window by factors obtained from the mouse
    --   position by linear interpolation. Dragging precisely on a corner
    --   resizes that corner; dragging precisely in the middle moves the
    --   window without resizing; anything else is an interpolation
    --   between the two.
    linear :: Double -> Double
    linear = Double -> Double
    forall a. a -> a
    id

    -- | Only resize the window, based on the window quadrant the mouse is in.
    resize :: Double -> Double
    resize x :: Double
    x = if Double
    x Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    < 0.5 then 0 else 1

    -- | Only reposition the window.
    position :: Double -> Double
    position = Double -> Double -> Double
    forall a b. a -> b -> a
    const 0.5

    -- | Given an interpolation function, implement an appropriate window
    --   manipulation action.
    mouseWindow :: (Double -> Double) -> Window -> X ()
    mouseWindow :: (Double -> Double) -> Window -> X ()
    mouseWindow f :: Double -> Double
    f w :: Window
    w = X Bool -> X () -> X ()
    whenX (Window -> X Bool
    isClient Window
    w) (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $ (Display -> X ()) -> X ()
    forall a. (Display -> X a) -> X a
    withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
    forall a b. (a -> b) -> a -> b
    $ \d :: Display
    d -> do
        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 -> IO ()
    raiseWindow Display
    d Window
    w
        [wpos :: Pnt
    wpos, wsize :: Pnt
    wsize] <- IO [Pnt] -> X [Pnt]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO [Pnt] -> X [Pnt]) -> IO [Pnt] -> X [Pnt]
    forall a b. (a -> b) -> a -> b
    $ Display -> Window -> IO WindowAttributes
    getWindowAttributes Display
    d Window
    w IO WindowAttributes -> (WindowAttributes -> IO [Pnt]) -> IO [Pnt]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [Pnt] -> IO [Pnt]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Pnt] -> IO [Pnt])
    -> (WindowAttributes -> [Pnt]) -> WindowAttributes -> IO [Pnt]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WindowAttributes -> [Pnt]
    winAttrs
        SizeHints
    sh <- IO SizeHints -> X SizeHints
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO SizeHints -> X SizeHints) -> IO SizeHints -> X SizeHints
    forall a b. (a -> b) -> a -> b
    $ Display -> Window -> IO SizeHints
    getWMNormalHints Display
    d Window
    w
        Pnt
    pointer <- IO Pnt -> X Pnt
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO Pnt -> X Pnt) -> IO Pnt -> X Pnt
    forall a b. (a -> b) -> a -> b
    $ Display
    -> Window
    -> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
    queryPointer Display
    d Window
    w IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
    -> ((Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
        -> IO Pnt)
    -> IO Pnt
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Pnt -> IO Pnt
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pnt -> IO Pnt)
    -> ((Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
        -> Pnt)
    -> (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
    -> IO Pnt
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier) -> Pnt
    forall a a a b c f g h.
    (Integral a, Integral a) =>
    (a, b, c, a, a, f, g, h) -> Pnt
    pointerPos

        let uv :: Pnt
    uv = (Pnt
    pointer Pnt -> Pnt -> Pnt
    forall a. Num a => (a, a) -> (a, a) -> (a, a)
    - Pnt
    wpos) Pnt -> Pnt -> Pnt
    forall a. Fractional a => (a, a) -> (a, a) -> (a, a)
    / Pnt
    wsize
            fc :: Pnt
    fc = (Double -> Double) -> Pnt -> Pnt
    forall a b. (a -> b) -> (a, a) -> (b, b)
    mapP Double -> Double
    f Pnt
    uv
            mul :: Pnt
    mul = (Double -> Double) -> Pnt -> Pnt
    forall a b. (a -> b) -> (a, a) -> (b, b)
    mapP (\x :: Double
    x -> 2 Double -> Double -> Double
    forall a. Num a => a -> a -> a
    P.- 2 Double -> Double -> Double
    forall a. Num a => a -> a -> a
    P.* Double -> Double
    forall a. Num a => a -> a
    P.abs(Double
    x Double -> Double -> Double
    forall a. Num a => a -> a -> a
    P.- 0.5)) Pnt
    fc --Fudge factors: interpolation between 1 when on edge, 2 in middle
            atl :: Pnt
    atl = ((1, 1) Pnt -> Pnt -> Pnt
    forall a. Num a => (a, a) -> (a, a) -> (a, a)
    - Pnt
    fc) Pnt -> Pnt -> Pnt
    forall a. Num a => (a, a) -> (a, a) -> (a, a)
    * Pnt
    mul
            abr :: Pnt
    abr = Pnt
    fc Pnt -> Pnt -> Pnt
    forall a. Num a => (a, a) -> (a, a) -> (a, a)
    * Pnt
    mul
        (Position -> Position -> X ()) -> X () -> X ()
    mouseDrag (\ex :: Position
    ex ey :: Position
    ey -> IO () -> X ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> X ()) -> IO () -> X ()
    forall a b. (a -> b) -> a -> b
    $ do
            let offset :: Pnt
    offset = (Position -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Position
    ex, Position -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Position
    ey) Pnt -> Pnt -> Pnt
    forall a. Num a => (a, a) -> (a, a) -> (a, a)
    - Pnt
    pointer
                npos :: Pnt
    npos = Pnt
    wpos Pnt -> Pnt -> Pnt
    forall a. Num a => (a, a) -> (a, a) -> (a, a)
    + Pnt
    offset Pnt -> Pnt -> Pnt
    forall a. Num a => (a, a) -> (a, a) -> (a, a)
    * Pnt
    atl
                nbr :: Pnt
    nbr = (Pnt
    wpos Pnt -> Pnt -> Pnt
    forall a. Num a => (a, a) -> (a, a) -> (a, a)
    + Pnt
    wsize) Pnt -> Pnt -> Pnt
    forall a. Num a => (a, a) -> (a, a) -> (a, a)
    + Pnt
    offset Pnt -> Pnt -> Pnt
    forall a. Num a => (a, a) -> (a, a) -> (a, a)
    * Pnt
    abr
                ntl :: Pnt
    ntl = Pnt -> Pnt -> Pnt
    forall a. Ord a => (a, a) -> (a, a) -> (a, a)
    minP (Pnt
    nbr Pnt -> Pnt -> Pnt
    forall a. Num a => (a, a) -> (a, a) -> (a, a)
    - (32, 32)) Pnt
    npos    --minimum size
                nwidth :: D
    nwidth = SizeHints -> (Integer, Integer) -> D
    forall a. Integral a => SizeHints -> (a, a) -> D
    applySizeHintsContents SizeHints
    sh ((Integer, Integer) -> D) -> (Integer, Integer) -> D
    forall a b. (a -> b) -> a -> b
    $ (Double -> Integer) -> Pnt -> (Integer, Integer)
    forall a b. (a -> b) -> (a, a) -> (b, b)
    mapP (Double -> Integer
    forall a b. (RealFrac a, Integral b) => a -> b
    round :: Double -> Integer) (Pnt
    nbr Pnt -> Pnt -> Pnt
    forall a. Num a => (a, a) -> (a, a) -> (a, a)
    - Pnt
    ntl)
            Display
    -> Window
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> IO ()
    moveResizeWindow Display
    d Window
    w (Double -> Position
    forall a b. (RealFrac a, Integral b) => a -> b
    round (Double -> Position) -> Double -> Position
    forall a b. (a -> b) -> a -> b
    $ Pnt -> Double
    forall a b. (a, b) -> a
    fst Pnt
    ntl) (Double -> Position
    forall a b. (RealFrac a, Integral b) => a -> b
    round (Double -> Position) -> Double -> Position
    forall a b. (a -> b) -> a -> b
    $ Pnt -> Double
    forall a b. (a, b) -> b
    snd Pnt
    ntl) (Dimension -> Dimension -> IO ()) -> D -> IO ()
    forall a b c. (a -> b -> c) -> (a, b) -> c
    `uncurry` D
    nwidth
            () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
            (Window -> X ()
    float Window
    w)

        Window -> X ()
    float Window
    w

      where
        pointerPos :: (a, b, c, a, a, f, g, h) -> Pnt
    pointerPos (_,_,_,px :: a
    px,py :: a
    py,_,_,_) = (a -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    px,a -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    py) :: Pnt
        winAttrs :: WindowAttributes -> [Pnt]
        winAttrs :: WindowAttributes -> [Pnt]
    winAttrs x :: WindowAttributes
    x = [Double] -> [Pnt]
    forall a. [a] -> [(a, a)]
    pairUp ([Double] -> [Pnt]) -> [Double] -> [Pnt]
    forall a b. (a -> b) -> a -> b
    $ ((WindowAttributes -> CInt) -> Double)
    -> [WindowAttributes -> CInt] -> [Double]
    forall a b. (a -> b) -> [a] -> [b]
    map (CInt -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (CInt -> Double)
    -> ((WindowAttributes -> CInt) -> CInt)
    -> (WindowAttributes -> CInt)
    -> Double
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((WindowAttributes -> CInt) -> WindowAttributes -> CInt
    forall a b. (a -> b) -> a -> b
    $ WindowAttributes
    x)) [WindowAttributes -> CInt
    wa_x, WindowAttributes -> CInt
    wa_y, WindowAttributes -> CInt
    wa_width, WindowAttributes -> CInt
    wa_height]

    -- I'd rather I didn't have to do this, but I hate writing component 2d math
    type Pnt = (Double, Double)

    pairUp :: [a] -> [(a,a)]
    pairUp :: [a] -> [(a, a)]
    pairUp [] = []
    pairUp [_] = []
    pairUp (x :: a
    x:y :: a
    y:xs :: [a]
    xs) = (a
    x, a
    y) (a, a) -> [(a, a)] -> [(a, a)]
    forall a. a -> [a] -> [a]
    : ([a] -> [(a, a)]
    forall a. [a] -> [(a, a)]
    pairUp [a]
    xs)

    mapP :: (a -> b) -> (a, a) -> (b, b)
    mapP :: (a -> b) -> (a, a) -> (b, b)
    mapP f :: a -> b
    f (x :: a
    x, y :: a
    y) = (a -> b
    f a
    x, a -> b
    f a
    y)
    zipP :: (a -> b -> c) -> (a,a) -> (b,b) -> (c,c)
    zipP :: (a -> b -> c) -> (a, a) -> (b, b) -> (c, c)
    zipP f :: a -> b -> c
    f (ax :: a
    ax,ay :: a
    ay) (bx :: b
    bx,by :: b
    by) = (a -> b -> c
    f a
    ax b
    bx, a -> b -> c
    f a
    ay b
    by)

    minP :: Ord a => (a,a) -> (a,a) -> (a,a)
    minP :: (a, a) -> (a, a) -> (a, a)
    minP = (a -> a -> a) -> (a, a) -> (a, a) -> (a, a)
    forall a b c. (a -> b -> c) -> (a, a) -> (b, b) -> (c, c)
    zipP a -> a -> a
    forall a. Ord a => a -> a -> a
    min

    infixl 6  +, -
    infixl 7  *, /

    (+), (-), (*) :: (P.Num a) => (a,a) -> (a,a) -> (a,a)
    + :: (a, a) -> (a, a) -> (a, a)
    (+) = (a -> a -> a) -> (a, a) -> (a, a) -> (a, a)
    forall a b c. (a -> b -> c) -> (a, a) -> (b, b) -> (c, c)
    zipP a -> a -> a
    forall a. Num a => a -> a -> a
    (P.+)
    (-) = (a -> a -> a) -> (a, a) -> (a, a) -> (a, a)
    forall a b c. (a -> b -> c) -> (a, a) -> (b, b) -> (c, c)
    zipP a -> a -> a
    forall a. Num a => a -> a -> a
    (P.-)
    * :: (a, a) -> (a, a) -> (a, a)
    (*) = (a -> a -> a) -> (a, a) -> (a, a) -> (a, a)
    forall a b c. (a -> b -> c) -> (a, a) -> (b, b) -> (c, c)
    zipP a -> a -> a
    forall a. Num a => a -> a -> a
    (P.*)
    (/) :: (P.Fractional a) => (a,a) -> (a,a) -> (a,a)
    / :: (a, a) -> (a, a) -> (a, a)
    (/) = (a -> a -> a) -> (a, a) -> (a, a) -> (a, a)
    forall a b c. (a -> b -> c) -> (a, a) -> (b, b) -> (c, c)
    zipP a -> a -> a
    forall a. Fractional a => a -> a -> a
    (P./)