{-# 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\/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))
    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
    (Double, Double)
pointer <- IO (Double, Double) -> X (Double, Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Double, Double) -> X (Double, Double))
-> IO (Double, Double) -> X (Double, Double)
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)
    -> (Double, Double))
-> IO (Double, Double)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
-> (Double, Double)
forall {a} {a} {a} {b} {c} {f} {g} {h}.
(Integral a, Integral a) =>
(a, b, c, a, a, f, g, h) -> (Double, Double)
pointerPos

    let uv :: (Double, Double)
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)
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)
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, Double)
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)
abr = (Double, Double)
fc (Double, Double) -> (Double, Double) -> (Double, Double)
forall a. Num a => (a, a) -> (a, a) -> (a, a)
* (Double, Double)
mul
    (Position -> Position -> X ()) -> X () -> X ()
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 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 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 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)
        (Window -> X ()
float Window
w)

    Window -> X ()
float Window
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./)