module XMonad.Actions.FloatSnap (
Direction2D(..),
snapMove,
snapGrow,
snapShrink,
snapMagicMove,
snapMagicResize,
snapMagicMouseResize,
afterDrag,
ifClick,
ifClick') where
import XMonad
import XMonad.Prelude (fromJust, isNothing, listToMaybe, sort, when)
import qualified XMonad.StackSet as W
import qualified Data.Set as S
import XMonad.Hooks.ManageDocks (calcGap)
import XMonad.Util.Types (Direction2D(..))
import XMonad.Actions.AfterDrag
snapMagicMouseResize
:: Rational
-> Maybe Int
-> Maybe Int
-> Window
-> X ()
snapMagicMouseResize :: Rational -> Maybe Int -> Maybe Int -> Window -> X ()
snapMagicMouseResize Rational
middle Maybe Int
collidedist Maybe Int
snapdist 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
(_, _, _, px, py, _, _, _) <- IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
-> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
-> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier))
-> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
-> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
queryPointer Display
d Window
w
let x = (CInt -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
px Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- WindowAttributes -> Rational
wx WindowAttributes
wa)Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/WindowAttributes -> Rational
ww WindowAttributes
wa
y = (CInt -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
py Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- WindowAttributes -> Rational
wy WindowAttributes
wa)Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/WindowAttributes -> Rational
wh WindowAttributes
wa
ml = [Direction2D
L | Rational
x Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
<= (Rational
0.5 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
middleRational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2)]
mr = [Direction2D
R | Rational
x Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> (Rational
0.5 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
middleRational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2)]
mu = [Direction2D
U | Rational
y Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
<= (Rational
0.5 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
middleRational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2)]
md = [Direction2D
D | Rational
y Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> (Rational
0.5 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
middleRational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2)]
mdir = [Direction2D]
ml[Direction2D] -> [Direction2D] -> [Direction2D]
forall a. [a] -> [a] -> [a]
++[Direction2D]
mr[Direction2D] -> [Direction2D] -> [Direction2D]
forall a. [a] -> [a] -> [a]
++[Direction2D]
mu[Direction2D] -> [Direction2D] -> [Direction2D]
forall a. [a] -> [a] -> [a]
++[Direction2D]
md
dir = if [Direction2D] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Direction2D]
mdir
then [Direction2D
L,Direction2D
R,Direction2D
U,Direction2D
D]
else [Direction2D]
mdir
snapMagicResize dir collidedist snapdist w
where
wx :: WindowAttributes -> Rational
wx = CInt -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral(CInt -> Rational)
-> (WindowAttributes -> CInt) -> WindowAttributes -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
.WindowAttributes -> CInt
wa_x
wy :: WindowAttributes -> Rational
wy = CInt -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral(CInt -> Rational)
-> (WindowAttributes -> CInt) -> WindowAttributes -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
.WindowAttributes -> CInt
wa_y
ww :: WindowAttributes -> Rational
ww = CInt -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral(CInt -> Rational)
-> (WindowAttributes -> CInt) -> WindowAttributes -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
.WindowAttributes -> CInt
wa_width
wh :: WindowAttributes -> Rational
wh = CInt -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral(CInt -> Rational)
-> (WindowAttributes -> CInt) -> WindowAttributes -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
.WindowAttributes -> CInt
wa_height
snapMagicResize
:: [Direction2D]
-> Maybe Int
-> Maybe Int
-> Window
-> X ()
snapMagicResize :: [Direction2D] -> Maybe Int -> Maybe Int -> Window -> X ()
snapMagicResize [Direction2D]
dir Maybe Int
collidedist Maybe Int
snapdist 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
(xbegin,xend) <- Bool -> Display -> WindowAttributes -> X (Int, Int)
handleAxis Bool
True Display
d WindowAttributes
wa
(ybegin,yend) <- handleAxis False d wa
let xbegin' = if Direction2D
L Direction2D -> [Direction2D] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Direction2D]
dir then Int
xbegin else WindowAttributes -> Int
wx WindowAttributes
wa
xend' = if Direction2D
R Direction2D -> [Direction2D] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Direction2D]
dir then Int
xend else WindowAttributes -> Int
wx WindowAttributes
wa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
ww WindowAttributes
wa
ybegin' = if Direction2D
U Direction2D -> [Direction2D] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Direction2D]
dir then Int
ybegin else WindowAttributes -> Int
wy WindowAttributes
wa
yend' = if Direction2D
D Direction2D -> [Direction2D] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Direction2D]
dir then Int
yend else WindowAttributes -> Int
wy WindowAttributes
wa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
wh WindowAttributes
wa
io $ moveWindow d w (fromIntegral xbegin') (fromIntegral ybegin')
io $ resizeWindow d w (fromIntegral $ xend' - xbegin') (fromIntegral $ yend' - ybegin')
float w
where
wx :: WindowAttributes -> Int
wx = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral(CInt -> Int)
-> (WindowAttributes -> CInt) -> WindowAttributes -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.WindowAttributes -> CInt
wa_x
wy :: WindowAttributes -> Int
wy = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral(CInt -> Int)
-> (WindowAttributes -> CInt) -> WindowAttributes -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.WindowAttributes -> CInt
wa_y
ww :: WindowAttributes -> Int
ww = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral(CInt -> Int)
-> (WindowAttributes -> CInt) -> WindowAttributes -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.WindowAttributes -> CInt
wa_width
wh :: WindowAttributes -> Int
wh = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral(CInt -> Int)
-> (WindowAttributes -> CInt) -> WindowAttributes -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.WindowAttributes -> CInt
wa_height
handleAxis :: Bool -> Display -> WindowAttributes -> X (Int, Int)
handleAxis Bool
horiz Display
d WindowAttributes
wa = do
((mbl,mbr,bs),(mfl,mfr,fs)) <- Bool
-> Maybe Int
-> Display
-> Window
-> X ((Maybe Int, Maybe Int, Bool), (Maybe Int, Maybe Int, Bool))
getSnap Bool
horiz Maybe Int
collidedist Display
d Window
w
let begin = if Bool
bs
then WindowAttributes -> Int
wpos WindowAttributes
wa
else case (Maybe Int
mbl,Maybe Int
mbr) of
(Just Int
bl,Just Int
br) -> if WindowAttributes -> Int
wpos WindowAttributes
wa Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
bl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
br Int -> Int -> Int
forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wpos WindowAttributes
wa then Int
bl else Int
br
(Just Int
bl,Maybe Int
Nothing) -> Int
bl
(Maybe Int
Nothing,Just Int
br) -> Int
br
(Maybe Int
Nothing,Maybe Int
Nothing) -> WindowAttributes -> Int
wpos WindowAttributes
wa
end = if Bool
fs
then WindowAttributes -> Int
wpos WindowAttributes
wa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
wdim WindowAttributes
wa
else case (if Maybe Int
mflMaybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int -> Maybe Int
forall a. a -> Maybe a
Just Int
begin then Maybe Int
forall a. Maybe a
Nothing else Maybe Int
mfl,Maybe Int
mfr) of
(Just Int
fl,Just Int
fr) -> if WindowAttributes -> Int
wpos WindowAttributes
wa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
wdim WindowAttributes
wa Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
fl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
fr Int -> Int -> Int
forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wpos WindowAttributes
wa Int -> Int -> Int
forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wdim WindowAttributes
wa then Int
fl else Int
fr
(Just Int
fl,Maybe Int
Nothing) -> Int
fl
(Maybe Int
Nothing,Just Int
fr) -> Int
fr
(Maybe Int
Nothing,Maybe Int
Nothing) -> WindowAttributes -> Int
wpos WindowAttributes
wa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
wdim WindowAttributes
wa
begin' = if Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
snapdist Bool -> Bool -> Bool
|| Int -> Int
forall a. Num a => a -> a
abs (Int
begin Int -> Int -> Int
forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wpos WindowAttributes
wa) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
snapdist then Int
begin else WindowAttributes -> Int
wpos WindowAttributes
wa
end' = if Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
snapdist Bool -> Bool -> Bool
|| Int -> Int
forall a. Num a => a -> a
abs (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wpos WindowAttributes
wa Int -> Int -> Int
forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wdim WindowAttributes
wa) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
snapdist then Int
end else WindowAttributes -> Int
wpos WindowAttributes
wa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
wdim WindowAttributes
wa
return (begin',end')
where
(WindowAttributes -> Int
wpos, WindowAttributes -> Int
wdim, Rectangle -> Int
_, Rectangle -> Int
_) = Bool
-> (WindowAttributes -> Int, WindowAttributes -> Int,
Rectangle -> Int, Rectangle -> Int)
constructors Bool
horiz
snapMagicMove
:: Maybe Int
-> Maybe Int
-> Window
-> X ()
snapMagicMove :: Maybe Int -> Maybe Int -> Window -> X ()
snapMagicMove Maybe Int
collidedist Maybe Int
snapdist 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
nx <- Bool -> Display -> WindowAttributes -> X Int
handleAxis Bool
True Display
d WindowAttributes
wa
ny <- handleAxis False d wa
io $ moveWindow d w (fromIntegral nx) (fromIntegral ny)
float w
where
handleAxis :: Bool -> Display -> WindowAttributes -> X Int
handleAxis Bool
horiz Display
d WindowAttributes
wa = do
((mbl,mbr,bs),(mfl,mfr,fs)) <- Bool
-> Maybe Int
-> Display
-> Window
-> X ((Maybe Int, Maybe Int, Bool), (Maybe Int, Maybe Int, Bool))
getSnap Bool
horiz Maybe Int
collidedist Display
d Window
w
return $ if bs || fs
then wpos wa
else let b = case (Maybe Int
mbl,Maybe Int
mbr) of
(Just Int
bl,Just Int
br) -> if WindowAttributes -> Int
wpos WindowAttributes
wa Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
bl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
br Int -> Int -> Int
forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wpos WindowAttributes
wa then Int
bl else Int
br
(Just Int
bl,Maybe Int
Nothing) -> Int
bl
(Maybe Int
Nothing,Just Int
br) -> Int
br
(Maybe Int
Nothing,Maybe Int
Nothing) -> WindowAttributes -> Int
wpos WindowAttributes
wa
f = case (Maybe Int
mfl,Maybe Int
mfr) of
(Just Int
fl,Just Int
fr) -> if WindowAttributes -> Int
wpos WindowAttributes
wa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
wdim WindowAttributes
wa Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
fl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
fr Int -> Int -> Int
forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wpos WindowAttributes
wa Int -> Int -> Int
forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wdim WindowAttributes
wa then Int
fl else Int
fr
(Just Int
fl,Maybe Int
Nothing) -> Int
fl
(Maybe Int
Nothing,Just Int
fr) -> Int
fr
(Maybe Int
Nothing,Maybe Int
Nothing) -> WindowAttributes -> Int
wpos WindowAttributes
wa
newpos = if Int -> Int
forall a. Num a => a -> a
abs (Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wpos WindowAttributes
wa) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Int
forall a. Num a => a -> a
abs (Int
f Int -> Int -> Int
forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wpos WindowAttributes
wa Int -> Int -> Int
forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wdim WindowAttributes
wa) then Int
b else Int
f Int -> Int -> Int
forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wdim WindowAttributes
wa
in if isNothing snapdist || abs (newpos - wpos wa) <= fromJust snapdist then newpos else wpos wa
where
(WindowAttributes -> Int
wpos, WindowAttributes -> Int
wdim, Rectangle -> Int
_, Rectangle -> Int
_) = Bool
-> (WindowAttributes -> Int, WindowAttributes -> Int,
Rectangle -> Int, Rectangle -> Int)
constructors Bool
horiz
snapMove
:: Direction2D
-> Maybe Int
-> Window
-> X ()
snapMove :: Direction2D -> Maybe Int -> Window -> X ()
snapMove Direction2D
L = Bool -> Bool -> Maybe Int -> Window -> X ()
doSnapMove Bool
True Bool
True
snapMove Direction2D
R = Bool -> Bool -> Maybe Int -> Window -> X ()
doSnapMove Bool
True Bool
False
snapMove Direction2D
U = Bool -> Bool -> Maybe Int -> Window -> X ()
doSnapMove Bool
False Bool
True
snapMove Direction2D
D = Bool -> Bool -> Maybe Int -> Window -> X ()
doSnapMove Bool
False Bool
False
doSnapMove :: Bool -> Bool -> Maybe Int -> Window -> X ()
doSnapMove :: Bool -> Bool -> Maybe Int -> Window -> X ()
doSnapMove Bool
horiz Bool
rev Maybe Int
collidedist 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
((bl,br,_),(fl,fr,_)) <- Bool
-> Maybe Int
-> Display
-> Window
-> X ((Maybe Int, Maybe Int, Bool), (Maybe Int, Maybe Int, Bool))
getSnap Bool
horiz Maybe Int
collidedist Display
d Window
w
let (mb,mf) = if rev then (bl,fl)
else (br,fr)
newpos = Int -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Position) -> Int -> Position
forall a b. (a -> b) -> a -> b
$ case (Maybe Int
mb,Maybe Int
mf) of
(Just Int
b,Maybe Int
Nothing) -> Int
b
(Maybe Int
Nothing,Just Int
f) -> Int
f Int -> Int -> Int
forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wdim WindowAttributes
wa
(Just Int
b,Just Int
f) -> if Bool
rev Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= (Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
f Int -> Int -> Int
forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wdim WindowAttributes
wa)
then Int
b
else Int
f Int -> Int -> Int
forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wdim WindowAttributes
wa
(Maybe Int, Maybe Int)
_ -> WindowAttributes -> Int
wpos WindowAttributes
wa
if horiz then io $ moveWindow d w newpos (fromIntegral $ wa_y wa)
else io $ moveWindow d w (fromIntegral $ wa_x wa) newpos
float w
where
(WindowAttributes -> Int
wpos, WindowAttributes -> Int
wdim, Rectangle -> Int
_, Rectangle -> Int
_) = Bool
-> (WindowAttributes -> Int, WindowAttributes -> Int,
Rectangle -> Int, Rectangle -> Int)
constructors Bool
horiz
snapGrow
:: Direction2D
-> Maybe Int
-> Window
-> X ()
snapGrow :: Direction2D -> Maybe Int -> Window -> X ()
snapGrow = Bool -> Direction2D -> Maybe Int -> Window -> X ()
snapResize Bool
True
snapShrink
:: Direction2D
-> Maybe Int
-> Window
-> X ()
snapShrink :: Direction2D -> Maybe Int -> Window -> X ()
snapShrink = Bool -> Direction2D -> Maybe Int -> Window -> X ()
snapResize Bool
False
snapResize :: Bool -> Direction2D -> Maybe Int -> Window -> X ()
snapResize :: Bool -> Direction2D -> Maybe Int -> Window -> X ()
snapResize Bool
grow Direction2D
dir Maybe Int
collidedist 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
mr <- case Direction2D
dir of
Direction2D
L -> do ((mg,ms,_),(_,_,_)) <- Bool
-> Maybe Int
-> Display
-> Window
-> X ((Maybe Int, Maybe Int, Bool), (Maybe Int, Maybe Int, Bool))
getSnap Bool
True Maybe Int
collidedist Display
d Window
w
return $ case (if grow then mg else ms) of
Just Int
v -> (Int, Int, Int, Int) -> Maybe (Int, Int, Int, Int)
forall a. a -> Maybe a
Just (Int
v, WindowAttributes -> Int
wy WindowAttributes
wa, WindowAttributes -> Int
ww WindowAttributes
wa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
wx WindowAttributes
wa Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
v, WindowAttributes -> Int
wh WindowAttributes
wa)
Maybe Int
_ -> Maybe (Int, Int, Int, Int)
forall a. Maybe a
Nothing
Direction2D
R -> do ((_,_,_),(ms,mg,_)) <- Bool
-> Maybe Int
-> Display
-> Window
-> X ((Maybe Int, Maybe Int, Bool), (Maybe Int, Maybe Int, Bool))
getSnap Bool
True Maybe Int
collidedist Display
d Window
w
return $ case (if grow then mg else ms) of
Just Int
v -> (Int, Int, Int, Int) -> Maybe (Int, Int, Int, Int)
forall a. a -> Maybe a
Just (WindowAttributes -> Int
wx WindowAttributes
wa, WindowAttributes -> Int
wy WindowAttributes
wa, Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wx WindowAttributes
wa, WindowAttributes -> Int
wh WindowAttributes
wa)
Maybe Int
_ -> Maybe (Int, Int, Int, Int)
forall a. Maybe a
Nothing
Direction2D
U -> do ((mg,ms,_),(_,_,_)) <- Bool
-> Maybe Int
-> Display
-> Window
-> X ((Maybe Int, Maybe Int, Bool), (Maybe Int, Maybe Int, Bool))
getSnap Bool
False Maybe Int
collidedist Display
d Window
w
return $ case (if grow then mg else ms) of
Just Int
v -> (Int, Int, Int, Int) -> Maybe (Int, Int, Int, Int)
forall a. a -> Maybe a
Just (WindowAttributes -> Int
wx WindowAttributes
wa, Int
v, WindowAttributes -> Int
ww WindowAttributes
wa, WindowAttributes -> Int
wh WindowAttributes
wa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
wy WindowAttributes
wa Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
v)
Maybe Int
_ -> Maybe (Int, Int, Int, Int)
forall a. Maybe a
Nothing
Direction2D
D -> do ((_,_,_),(ms,mg,_)) <- Bool
-> Maybe Int
-> Display
-> Window
-> X ((Maybe Int, Maybe Int, Bool), (Maybe Int, Maybe Int, Bool))
getSnap Bool
False Maybe Int
collidedist Display
d Window
w
return $ case (if grow then mg else ms) of
Just Int
v -> (Int, Int, Int, Int) -> Maybe (Int, Int, Int, Int)
forall a. a -> Maybe a
Just (WindowAttributes -> Int
wx WindowAttributes
wa, WindowAttributes -> Int
wy WindowAttributes
wa, WindowAttributes -> Int
ww WindowAttributes
wa, Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wy WindowAttributes
wa)
Maybe Int
_ -> Maybe (Int, Int, Int, Int)
forall a. Maybe a
Nothing
case mr of
Maybe (Int, Int, Int, Int)
Nothing -> () -> X ()
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (Int
nx,Int
ny,Int
nw,Int
nh) -> Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
nwInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0 Bool -> Bool -> Bool
&& Int
nhInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ 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 -> Position -> Position -> IO ()
moveWindow Display
d Window
w (Int -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nx) (Int -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ny)
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 -> Dimension -> Dimension -> IO ()
resizeWindow Display
d Window
w (Int -> Dimension
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nw) (Int -> Dimension
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nh)
float w
where
wx :: WindowAttributes -> Int
wx = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral(CInt -> Int)
-> (WindowAttributes -> CInt) -> WindowAttributes -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.WindowAttributes -> CInt
wa_x
wy :: WindowAttributes -> Int
wy = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral(CInt -> Int)
-> (WindowAttributes -> CInt) -> WindowAttributes -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.WindowAttributes -> CInt
wa_y
ww :: WindowAttributes -> Int
ww = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral(CInt -> Int)
-> (WindowAttributes -> CInt) -> WindowAttributes -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.WindowAttributes -> CInt
wa_width
wh :: WindowAttributes -> Int
wh = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral(CInt -> Int)
-> (WindowAttributes -> CInt) -> WindowAttributes -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.WindowAttributes -> CInt
wa_height
getSnap :: Bool -> Maybe Int -> Display -> Window -> X ((Maybe Int,Maybe Int,Bool),(Maybe Int,Maybe Int,Bool))
getSnap :: Bool
-> Maybe Int
-> Display
-> Window
-> X ((Maybe Int, Maybe Int, Bool), (Maybe Int, Maybe Int, Bool))
getSnap Bool
horiz Maybe Int
collidedist Display
d Window
w = do
wa <- IO WindowAttributes -> X WindowAttributes
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO WindowAttributes -> X WindowAttributes)
-> IO WindowAttributes -> X WindowAttributes
forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO WindowAttributes
getWindowAttributes Display
d Window
w
screen <- W.current <$> gets windowset
let sr = ScreenDetail -> Rectangle
screenRect (ScreenDetail -> Rectangle) -> ScreenDetail -> Rectangle
forall a b. (a -> b) -> a -> b
$ Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> ScreenDetail
forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
screen
wl = Maybe (Stack Window) -> [Window]
forall a. Maybe (Stack a) -> [a]
W.integrate' (Maybe (Stack Window) -> [Window])
-> (Workspace WorkspaceId (Layout Window) Window
-> Maybe (Stack Window))
-> Workspace WorkspaceId (Layout Window) Window
-> [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace WorkspaceId (Layout Window) Window
-> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace WorkspaceId (Layout Window) Window -> [Window])
-> Workspace WorkspaceId (Layout Window) Window -> [Window]
forall a b. (a -> b) -> a -> b
$ Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
screen
gr <- ($ sr) <$> calcGap (S.fromList [minBound .. maxBound])
wla <- filter (collides wa) <$> io (mapM (getWindowAttributes d) $ filter (/=w) wl)
return ( neighbours (back wa sr gr wla) (wpos wa)
, neighbours (front wa sr gr wla) (wpos wa + wdim wa)
)
where
wborder :: WindowAttributes -> Int
wborder = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral(CInt -> Int)
-> (WindowAttributes -> CInt) -> WindowAttributes -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.WindowAttributes -> CInt
wa_border_width
(WindowAttributes -> Int
wpos, WindowAttributes -> Int
wdim, Rectangle -> Int
rpos, Rectangle -> Int
rdim) = Bool
-> (WindowAttributes -> Int, WindowAttributes -> Int,
Rectangle -> Int, Rectangle -> Int)
constructors Bool
horiz
(WindowAttributes -> Int
refwpos, WindowAttributes -> Int
refwdim, Rectangle -> Int
_, Rectangle -> Int
_) = Bool
-> (WindowAttributes -> Int, WindowAttributes -> Int,
Rectangle -> Int, Rectangle -> Int)
constructors (Bool
-> (WindowAttributes -> Int, WindowAttributes -> Int,
Rectangle -> Int, Rectangle -> Int))
-> Bool
-> (WindowAttributes -> Int, WindowAttributes -> Int,
Rectangle -> Int, Rectangle -> Int)
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
horiz
back :: WindowAttributes
-> Rectangle -> Rectangle -> t WindowAttributes -> [Int]
back WindowAttributes
wa Rectangle
sr Rectangle
gr t WindowAttributes
wla = (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Rectangle -> Int
rpos Rectangle
sr) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$
(Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Rectangle -> Int
rpos Rectangle
sr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Rectangle -> Int
rdim Rectangle
sr) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$
[Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ Rectangle -> Int
rpos Rectangle
srInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:Rectangle -> Int
rpos Rectangle
grInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:(Rectangle -> Int
rpos Rectangle
gr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Rectangle -> Int
rdim Rectangle
gr)Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:
(WindowAttributes -> [Int] -> [Int])
-> [Int] -> t WindowAttributes -> [Int]
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\WindowAttributes
a [Int]
as -> WindowAttributes -> Int
wpos WindowAttributes
aInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:(WindowAttributes -> Int
wpos WindowAttributes
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
wdim WindowAttributes
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
wborder WindowAttributes
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
wborder WindowAttributes
wa)Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
as) [] t WindowAttributes
wla
front :: WindowAttributes
-> Rectangle -> Rectangle -> t WindowAttributes -> [Int]
front WindowAttributes
wa Rectangle
sr Rectangle
gr t WindowAttributes
wla = (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Rectangle -> Int
rpos Rectangle
sr) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$
(Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Rectangle -> Int
rpos Rectangle
sr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Rectangle -> Int
rdim Rectangle
sr) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$
[Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Rectangle -> Int
rpos Rectangle
gr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*WindowAttributes -> Int
wborder WindowAttributes
wa)Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:(Rectangle -> Int
rpos Rectangle
gr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Rectangle -> Int
rdim Rectangle
gr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*WindowAttributes -> Int
wborder WindowAttributes
wa)Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:(Rectangle -> Int
rpos Rectangle
sr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Rectangle -> Int
rdim Rectangle
sr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*WindowAttributes -> Int
wborder WindowAttributes
wa)Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:
(WindowAttributes -> [Int] -> [Int])
-> [Int] -> t WindowAttributes -> [Int]
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\WindowAttributes
a [Int]
as -> (WindowAttributes -> Int
wpos WindowAttributes
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wborder WindowAttributes
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wborder WindowAttributes
wa)Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:(WindowAttributes -> Int
wpos WindowAttributes
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
wdim WindowAttributes
a)Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
as) [] t WindowAttributes
wla
neighbours :: [a] -> a -> (Maybe a, Maybe a, Bool)
neighbours [a]
l a
v = ( [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe ([a] -> Maybe a) -> [a] -> Maybe a
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
v) [a]
l
, [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe ([a] -> Maybe a) -> [a] -> Maybe a
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
v) [a]
l
, a
v a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
l
)
collides :: WindowAttributes -> WindowAttributes -> Bool
collides WindowAttributes
wa WindowAttributes
oa = case Maybe Int
collidedist of
Maybe Int
Nothing -> Bool
True
Just Int
dist -> WindowAttributes -> Int
refwpos WindowAttributes
oa Int -> Int -> Int
forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wborder WindowAttributes
oa Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< WindowAttributes -> Int
refwpos WindowAttributes
wa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
refwdim WindowAttributes
wa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
wborder WindowAttributes
wa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dist
Bool -> Bool -> Bool
&& WindowAttributes -> Int
refwpos WindowAttributes
wa Int -> Int -> Int
forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wborder WindowAttributes
wa Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
dist Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< WindowAttributes -> Int
refwpos WindowAttributes
oa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
refwdim WindowAttributes
oa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
wborder WindowAttributes
oa
constructors :: Bool -> (WindowAttributes -> Int, WindowAttributes -> Int, Rectangle -> Int, Rectangle -> Int)
constructors :: Bool
-> (WindowAttributes -> Int, WindowAttributes -> Int,
Rectangle -> Int, Rectangle -> Int)
constructors Bool
True = ( CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral(CInt -> Int)
-> (WindowAttributes -> CInt) -> WindowAttributes -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.WindowAttributes -> CInt
wa_x
, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral(CInt -> Int)
-> (WindowAttributes -> CInt) -> WindowAttributes -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.WindowAttributes -> CInt
wa_width
, Position -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral(Position -> Int) -> (Rectangle -> Position) -> Rectangle -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Rectangle -> Position
rect_x
, Dimension -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral(Dimension -> Int) -> (Rectangle -> Dimension) -> Rectangle -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Rectangle -> Dimension
rect_width
)
constructors Bool
False = ( CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral(CInt -> Int)
-> (WindowAttributes -> CInt) -> WindowAttributes -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.WindowAttributes -> CInt
wa_y
, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral(CInt -> Int)
-> (WindowAttributes -> CInt) -> WindowAttributes -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.WindowAttributes -> CInt
wa_height
, Position -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral(Position -> Int) -> (Rectangle -> Position) -> Rectangle -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Rectangle -> Position
rect_y
, Dimension -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral(Dimension -> Int) -> (Rectangle -> Dimension) -> Rectangle -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Rectangle -> Dimension
rect_height
)