{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
module XMonad.Actions.FlexibleManipulate (
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)
discrete, linear, resize, position :: Double -> Double
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
linear :: Double -> Double
linear = Double -> Double
forall a. a -> a
id
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
position :: Double -> Double
position = Double -> Double -> Double
forall a b. a -> b -> a
const 0.5
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
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
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]
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./)