    {-# LANGUAGE FlexibleInstances #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Actions.FlexibleManipulate
    -- Description :  Move and resize floating windows without warping the mouse.
    -- 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 XMonad.Prelude ((<&>), fi)
    import qualified Prelude as P
    import Prelude (Double, Integer, Ord (..), const, fromIntegral, fst, id, otherwise, round, snd, uncurry, ($))

    -- $usage
    -- First, add this import to your @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 Double
    x | Double
    x Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    < Double
    0.33 = Double
    0
               | Double
    x Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    > Double
    0.66 = Double
    1
               | Bool
    otherwise = Double
    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 Double
    x = if Double
    x Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    < Double
    0.5 then Double
    0 else Double
    1

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

    -- | Given an interpolation function, implement an appropriate window
    --   manipulation action.
    mouseWindow :: (Double -> Double) -> Window -> X ()
    mouseWindow :: (Double -> Double) -> Window -> X ()
    mouseWindow Double -> Double
    f 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
    $ \Display
    d ->
      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 -> do
        let wpos :: (Double, Double)
    wpos  = (CInt -> Double
    forall a b. (Integral a, Num b) => a -> b
    fi (WindowAttributes -> CInt
    wa_x WindowAttributes
    wa), CInt -> Double
    forall a b. (Integral a, Num b) => a -> b
    fi (WindowAttributes -> CInt
    wa_y WindowAttributes
    wa))
            wsize :: (Double, Double)
    wsize = (CInt -> Double
    forall a b. (Integral a, Num b) => a -> b
    fi (WindowAttributes -> CInt
    wa_width WindowAttributes
    wa), CInt -> Double
    forall a b. (Integral a, Num b) => a -> b
    fi (WindowAttributes -> CInt
    wa_height WindowAttributes
    wa))
        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
        pointer <- io $ queryPointer d w <&> pointerPos

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

        float w

      where
        pointerPos :: (a, b, c, a, a, f, g, h) -> (Double, Double)
    pointerPos (a
    _,b
    _,c
    _,a
    px,a
    py,f
    _,g
    _,h
    _) = (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

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

    mapP :: (a -> b) -> (a, a) -> (b, b)
    mapP :: forall a b. (a -> b) -> (a, a) -> (b, b)
    mapP a -> b
    f (a
    x, a
    y) = (a -> b
    f a
    x, a -> b
    f a
    y)
    zipP :: (a -> b -> c) -> (a,a) -> (b,b) -> (c,c)
    zipP :: forall a b c. (a -> b -> c) -> (a, a) -> (b, b) -> (c, c)
    zipP a -> b -> c
    f (a
    ax,a
    ay) (b
    bx,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 :: forall a. Ord a => (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)
    + :: forall a. Num 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.-)
    * :: forall a. Num 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.*)
    (/) :: (P.Fractional a) => (a,a) -> (a,a) -> (a,a)
    / :: forall a. Fractional 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./)