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) forall a b. (a -> b) -> a -> b
$ forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d ->
Display -> Window -> (WindowAttributes -> X ()) -> X ()
withWindowAttributes Display
d Window
w forall a b. (a -> b) -> a -> b
$ \WindowAttributes
wa -> do
(Bool
_, Window
_, Window
_, CInt
px, CInt
py, CInt
_, CInt
_, Modifier
_) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io 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 :: Rational
x = (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
px forall a. Num a => a -> a -> a
- WindowAttributes -> Rational
wx WindowAttributes
wa)forall a. Fractional a => a -> a -> a
/WindowAttributes -> Rational
ww WindowAttributes
wa
y :: Rational
y = (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
py forall a. Num a => a -> a -> a
- WindowAttributes -> Rational
wy WindowAttributes
wa)forall a. Fractional a => a -> a -> a
/WindowAttributes -> Rational
wh WindowAttributes
wa
ml :: [Direction2D]
ml = [Direction2D
L | Rational
x forall a. Ord a => a -> a -> Bool
<= (Rational
0.5 forall a. Num a => a -> a -> a
- Rational
middleforall a. Fractional a => a -> a -> a
/Rational
2)]
mr :: [Direction2D]
mr = [Direction2D
R | Rational
x forall a. Ord a => a -> a -> Bool
> (Rational
0.5 forall a. Num a => a -> a -> a
+ Rational
middleforall a. Fractional a => a -> a -> a
/Rational
2)]
mu :: [Direction2D]
mu = [Direction2D
U | Rational
y forall a. Ord a => a -> a -> Bool
<= (Rational
0.5 forall a. Num a => a -> a -> a
- Rational
middleforall a. Fractional a => a -> a -> a
/Rational
2)]
md :: [Direction2D]
md = [Direction2D
D | Rational
y forall a. Ord a => a -> a -> Bool
> (Rational
0.5 forall a. Num a => a -> a -> a
+ Rational
middleforall a. Fractional a => a -> a -> a
/Rational
2)]
mdir :: [Direction2D]
mdir = [Direction2D]
mlforall a. [a] -> [a] -> [a]
++[Direction2D]
mrforall a. [a] -> [a] -> [a]
++[Direction2D]
muforall a. [a] -> [a] -> [a]
++[Direction2D]
md
dir :: [Direction2D]
dir = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Direction2D]
mdir
then [Direction2D
L,Direction2D
R,Direction2D
U,Direction2D
D]
else [Direction2D]
mdir
[Direction2D] -> Maybe Int -> Maybe Int -> Window -> X ()
snapMagicResize [Direction2D]
dir Maybe Int
collidedist Maybe Int
snapdist Window
w
where
wx :: WindowAttributes -> Rational
wx = forall a b. (Integral a, Num b) => a -> b
fromIntegralforall b c a. (b -> c) -> (a -> b) -> a -> c
.WindowAttributes -> CInt
wa_x
wy :: WindowAttributes -> Rational
wy = forall a b. (Integral a, Num b) => a -> b
fromIntegralforall b c a. (b -> c) -> (a -> b) -> a -> c
.WindowAttributes -> CInt
wa_y
ww :: WindowAttributes -> Rational
ww = forall a b. (Integral a, Num b) => a -> b
fromIntegralforall b c a. (b -> c) -> (a -> b) -> a -> c
.WindowAttributes -> CInt
wa_width
wh :: WindowAttributes -> Rational
wh = forall a b. (Integral a, Num b) => a -> b
fromIntegralforall 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) forall a b. (a -> b) -> a -> b
$ forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d ->
Display -> Window -> (WindowAttributes -> X ()) -> X ()
withWindowAttributes Display
d Window
w forall a b. (a -> b) -> a -> b
$ \WindowAttributes
wa -> do
(Int
xbegin,Int
xend) <- Bool -> Display -> WindowAttributes -> X (Int, Int)
handleAxis Bool
True Display
d WindowAttributes
wa
(Int
ybegin,Int
yend) <- Bool -> Display -> WindowAttributes -> X (Int, Int)
handleAxis Bool
False Display
d WindowAttributes
wa
let xbegin' :: Int
xbegin' = if Direction2D
L forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Direction2D]
dir then Int
xbegin else WindowAttributes -> Int
wx WindowAttributes
wa
xend' :: Int
xend' = if Direction2D
R forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Direction2D]
dir then Int
xend else WindowAttributes -> Int
wx WindowAttributes
wa forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
ww WindowAttributes
wa
ybegin' :: Int
ybegin' = if Direction2D
U forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Direction2D]
dir then Int
ybegin else WindowAttributes -> Int
wy WindowAttributes
wa
yend' :: Int
yend' = if Direction2D
D forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Direction2D]
dir then Int
yend else WindowAttributes -> Int
wy WindowAttributes
wa forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
wh WindowAttributes
wa
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Window -> Position -> Position -> IO ()
moveWindow Display
d Window
w (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
xbegin') (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ybegin')
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Window -> Dimension -> Dimension -> IO ()
resizeWindow Display
d Window
w (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
xend' forall a. Num a => a -> a -> a
- Int
xbegin') (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
yend' forall a. Num a => a -> a -> a
- Int
ybegin')
Window -> X ()
float Window
w
where
wx :: WindowAttributes -> Int
wx = forall a b. (Integral a, Num b) => a -> b
fromIntegralforall b c a. (b -> c) -> (a -> b) -> a -> c
.WindowAttributes -> CInt
wa_x
wy :: WindowAttributes -> Int
wy = forall a b. (Integral a, Num b) => a -> b
fromIntegralforall b c a. (b -> c) -> (a -> b) -> a -> c
.WindowAttributes -> CInt
wa_y
ww :: WindowAttributes -> Int
ww = forall a b. (Integral a, Num b) => a -> b
fromIntegralforall b c a. (b -> c) -> (a -> b) -> a -> c
.WindowAttributes -> CInt
wa_width
wh :: WindowAttributes -> Int
wh = forall a b. (Integral a, Num b) => a -> b
fromIntegralforall 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
((Maybe Int
mbl,Maybe Int
mbr,Bool
bs),(Maybe Int
mfl,Maybe Int
mfr,Bool
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 :: Int
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 forall a. Num a => a -> a -> a
- Int
bl forall a. Ord a => a -> a -> Bool
< Int
br 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 :: Int
end = if Bool
fs
then WindowAttributes -> Int
wpos WindowAttributes
wa forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
wdim WindowAttributes
wa
else case (if Maybe Int
mflforall a. Eq a => a -> a -> Bool
==forall a. a -> Maybe a
Just Int
begin then 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 forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
wdim WindowAttributes
wa forall a. Num a => a -> a -> a
- Int
fl forall a. Ord a => a -> a -> Bool
< Int
fr forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wpos WindowAttributes
wa 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 forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
wdim WindowAttributes
wa
begin' :: Int
begin' = if forall a. Maybe a -> Bool
isNothing Maybe Int
snapdist Bool -> Bool -> Bool
|| forall a. Num a => a -> a
abs (Int
begin forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wpos WindowAttributes
wa) forall a. Ord a => a -> a -> Bool
<= forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
snapdist then Int
begin else WindowAttributes -> Int
wpos WindowAttributes
wa
end' :: Int
end' = if forall a. Maybe a -> Bool
isNothing Maybe Int
snapdist Bool -> Bool -> Bool
|| forall a. Num a => a -> a
abs (Int
end forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wpos WindowAttributes
wa forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wdim WindowAttributes
wa) forall a. Ord a => a -> a -> Bool
<= forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
snapdist then Int
end else WindowAttributes -> Int
wpos WindowAttributes
wa forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
wdim WindowAttributes
wa
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
begin',Int
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) forall a b. (a -> b) -> a -> b
$ forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d ->
Display -> Window -> (WindowAttributes -> X ()) -> X ()
withWindowAttributes Display
d Window
w forall a b. (a -> b) -> a -> b
$ \WindowAttributes
wa -> do
Int
nx <- Bool -> Display -> WindowAttributes -> X Int
handleAxis Bool
True Display
d WindowAttributes
wa
Int
ny <- Bool -> Display -> WindowAttributes -> X Int
handleAxis Bool
False Display
d WindowAttributes
wa
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Window -> Position -> Position -> IO ()
moveWindow Display
d Window
w (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nx) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ny)
Window -> X ()
float Window
w
where
handleAxis :: Bool -> Display -> WindowAttributes -> X Int
handleAxis Bool
horiz Display
d WindowAttributes
wa = do
((Maybe Int
mbl,Maybe Int
mbr,Bool
bs),(Maybe Int
mfl,Maybe Int
mfr,Bool
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
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
bs Bool -> Bool -> Bool
|| Bool
fs
then WindowAttributes -> Int
wpos WindowAttributes
wa
else let b :: Int
b = case (Maybe Int
mbl,Maybe Int
mbr) of
(Just Int
bl,Just Int
br) -> if WindowAttributes -> Int
wpos WindowAttributes
wa forall a. Num a => a -> a -> a
- Int
bl forall a. Ord a => a -> a -> Bool
< Int
br 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 :: Int
f = case (Maybe Int
mfl,Maybe Int
mfr) of
(Just Int
fl,Just Int
fr) -> if WindowAttributes -> Int
wpos WindowAttributes
wa forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
wdim WindowAttributes
wa forall a. Num a => a -> a -> a
- Int
fl forall a. Ord a => a -> a -> Bool
< Int
fr forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wpos WindowAttributes
wa 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 :: Int
newpos = if forall a. Num a => a -> a
abs (Int
b forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wpos WindowAttributes
wa) forall a. Ord a => a -> a -> Bool
<= forall a. Num a => a -> a
abs (Int
f forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wpos WindowAttributes
wa forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wdim WindowAttributes
wa) then Int
b else Int
f forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wdim WindowAttributes
wa
in if forall a. Maybe a -> Bool
isNothing Maybe Int
snapdist Bool -> Bool -> Bool
|| forall a. Num a => a -> a
abs (Int
newpos forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wpos WindowAttributes
wa) forall a. Ord a => a -> a -> Bool
<= forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
snapdist then Int
newpos else WindowAttributes -> Int
wpos WindowAttributes
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) forall a b. (a -> b) -> a -> b
$ forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d ->
Display -> Window -> (WindowAttributes -> X ()) -> X ()
withWindowAttributes Display
d Window
w forall a b. (a -> b) -> a -> b
$ \WindowAttributes
wa -> do
((Maybe Int
bl,Maybe Int
br,Bool
_),(Maybe Int
fl,Maybe Int
fr,Bool
_)) <- 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 (Maybe Int
mb,Maybe Int
mf) = if Bool
rev then (Maybe Int
bl,Maybe Int
fl)
else (Maybe Int
br,Maybe Int
fr)
newpos :: Position
newpos = forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wdim WindowAttributes
wa
(Just Int
b,Just Int
f) -> if Bool
rev forall a. Eq a => a -> a -> Bool
/= (Int
b forall a. Ord a => a -> a -> Bool
< Int
f forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wdim WindowAttributes
wa)
then Int
b
else Int
f forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wdim WindowAttributes
wa
(Maybe Int, Maybe Int)
_ -> WindowAttributes -> Int
wpos WindowAttributes
wa
if Bool
horiz then forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Window -> Position -> Position -> IO ()
moveWindow Display
d Window
w Position
newpos (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_y WindowAttributes
wa)
else forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Window -> Position -> Position -> IO ()
moveWindow Display
d Window
w (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_x WindowAttributes
wa) Position
newpos
Window -> X ()
float Window
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) forall a b. (a -> b) -> a -> b
$ forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d ->
Display -> Window -> (WindowAttributes -> X ()) -> X ()
withWindowAttributes Display
d Window
w forall a b. (a -> b) -> a -> b
$ \WindowAttributes
wa -> do
Maybe (Int, Int, Int, Int)
mr <- case Direction2D
dir of
Direction2D
L -> do ((Maybe Int
mg,Maybe Int
ms,Bool
_),(Maybe Int
_,Maybe Int
_,Bool
_)) <- 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
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case (if Bool
grow then Maybe Int
mg else Maybe Int
ms) of
Just Int
v -> forall a. a -> Maybe a
Just (Int
v, WindowAttributes -> Int
wy WindowAttributes
wa, WindowAttributes -> Int
ww WindowAttributes
wa forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
wx WindowAttributes
wa forall a. Num a => a -> a -> a
- Int
v, WindowAttributes -> Int
wh WindowAttributes
wa)
Maybe Int
_ -> forall a. Maybe a
Nothing
Direction2D
R -> do ((Maybe Int
_,Maybe Int
_,Bool
_),(Maybe Int
ms,Maybe Int
mg,Bool
_)) <- 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
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case (if Bool
grow then Maybe Int
mg else Maybe Int
ms) of
Just Int
v -> forall a. a -> Maybe a
Just (WindowAttributes -> Int
wx WindowAttributes
wa, WindowAttributes -> Int
wy WindowAttributes
wa, Int
v forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wx WindowAttributes
wa, WindowAttributes -> Int
wh WindowAttributes
wa)
Maybe Int
_ -> forall a. Maybe a
Nothing
Direction2D
U -> do ((Maybe Int
mg,Maybe Int
ms,Bool
_),(Maybe Int
_,Maybe Int
_,Bool
_)) <- 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
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case (if Bool
grow then Maybe Int
mg else Maybe Int
ms) of
Just Int
v -> forall a. a -> Maybe a
Just (WindowAttributes -> Int
wx WindowAttributes
wa, Int
v, WindowAttributes -> Int
ww WindowAttributes
wa, WindowAttributes -> Int
wh WindowAttributes
wa forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
wy WindowAttributes
wa forall a. Num a => a -> a -> a
- Int
v)
Maybe Int
_ -> forall a. Maybe a
Nothing
Direction2D
D -> do ((Maybe Int
_,Maybe Int
_,Bool
_),(Maybe Int
ms,Maybe Int
mg,Bool
_)) <- 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
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case (if Bool
grow then Maybe Int
mg else Maybe Int
ms) of
Just Int
v -> forall a. a -> Maybe a
Just (WindowAttributes -> Int
wx WindowAttributes
wa, WindowAttributes -> Int
wy WindowAttributes
wa, WindowAttributes -> Int
ww WindowAttributes
wa, Int
v forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wy WindowAttributes
wa)
Maybe Int
_ -> forall a. Maybe a
Nothing
case Maybe (Int, Int, Int, Int)
mr of
Maybe (Int, Int, Int, Int)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (Int
nx,Int
ny,Int
nw,Int
nh) -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
nwforall a. Ord a => a -> a -> Bool
>Int
0 Bool -> Bool -> Bool
&& Int
nhforall a. Ord a => a -> a -> Bool
>Int
0) forall a b. (a -> b) -> a -> b
$ do forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Window -> Position -> Position -> IO ()
moveWindow Display
d Window
w (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nx) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ny)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Window -> Dimension -> Dimension -> IO ()
resizeWindow Display
d Window
w (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nw) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nh)
Window -> X ()
float Window
w
where
wx :: WindowAttributes -> Int
wx = forall a b. (Integral a, Num b) => a -> b
fromIntegralforall b c a. (b -> c) -> (a -> b) -> a -> c
.WindowAttributes -> CInt
wa_x
wy :: WindowAttributes -> Int
wy = forall a b. (Integral a, Num b) => a -> b
fromIntegralforall b c a. (b -> c) -> (a -> b) -> a -> c
.WindowAttributes -> CInt
wa_y
ww :: WindowAttributes -> Int
ww = forall a b. (Integral a, Num b) => a -> b
fromIntegralforall b c a. (b -> c) -> (a -> b) -> a -> c
.WindowAttributes -> CInt
wa_width
wh :: WindowAttributes -> Int
wh = forall a b. (Integral a, Num b) => a -> b
fromIntegralforall 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
WindowAttributes
wa <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO WindowAttributes
getWindowAttributes Display
d Window
w
Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
screen <- forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
let sr :: Rectangle
sr = ScreenDetail -> Rectangle
screenRect forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
screen
wl :: [Window]
wl = forall a. Maybe (Stack a) -> [a]
W.integrate' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack forall a b. (a -> b) -> a -> b
$ 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
Rectangle
gr <- (forall a b. (a -> b) -> a -> b
$ Rectangle
sr) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Direction2D -> X (Rectangle -> Rectangle)
calcGap (forall a. Ord a => [a] -> Set a
S.fromList [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound])
[WindowAttributes]
wla <- forall a. (a -> Bool) -> [a] -> [a]
filter (WindowAttributes -> WindowAttributes -> Bool
collides WindowAttributes
wa) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Display -> Window -> IO WindowAttributes
getWindowAttributes Display
d) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=Window
w) [Window]
wl)
forall (m :: * -> *) a. Monad m => a -> m a
return ( forall {a}. Ord a => [a] -> a -> (Maybe a, Maybe a, Bool)
neighbours (forall {t :: * -> *}.
Foldable t =>
WindowAttributes
-> Rectangle -> Rectangle -> t WindowAttributes -> [Int]
back WindowAttributes
wa Rectangle
sr Rectangle
gr [WindowAttributes]
wla) (WindowAttributes -> Int
wpos WindowAttributes
wa)
, forall {a}. Ord a => [a] -> a -> (Maybe a, Maybe a, Bool)
neighbours (forall {t :: * -> *}.
Foldable t =>
WindowAttributes
-> Rectangle -> Rectangle -> t WindowAttributes -> [Int]
front WindowAttributes
wa Rectangle
sr Rectangle
gr [WindowAttributes]
wla) (WindowAttributes -> Int
wpos WindowAttributes
wa forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
wdim WindowAttributes
wa)
)
where
wborder :: WindowAttributes -> Int
wborder = forall a b. (Integral a, Num b) => a -> b
fromIntegralforall 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 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 = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Ord a => a -> a -> Bool
< Rectangle -> Int
rpos Rectangle
sr) forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Ord a => a -> a -> Bool
< Rectangle -> Int
rpos Rectangle
sr forall a. Num a => a -> a -> a
+ Rectangle -> Int
rdim Rectangle
sr) forall a b. (a -> b) -> a -> b
$
forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ Rectangle -> Int
rpos Rectangle
srforall a. a -> [a] -> [a]
:Rectangle -> Int
rpos Rectangle
grforall a. a -> [a] -> [a]
:(Rectangle -> Int
rpos Rectangle
gr forall a. Num a => a -> a -> a
+ Rectangle -> Int
rdim Rectangle
gr)forall a. a -> [a] -> [a]
:
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\WindowAttributes
a [Int]
as -> WindowAttributes -> Int
wpos WindowAttributes
aforall a. a -> [a] -> [a]
:(WindowAttributes -> Int
wpos WindowAttributes
a forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
wdim WindowAttributes
a forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
wborder WindowAttributes
a forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
wborder WindowAttributes
wa)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 = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Ord a => a -> a -> Bool
<= Rectangle -> Int
rpos Rectangle
sr) forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Ord a => a -> a -> Bool
<= Rectangle -> Int
rpos Rectangle
sr forall a. Num a => a -> a -> a
+ Rectangle -> Int
rdim Rectangle
sr) forall a b. (a -> b) -> a -> b
$
forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ (Rectangle -> Int
rpos Rectangle
gr forall a. Num a => a -> a -> a
- Int
2forall a. Num a => a -> a -> a
*WindowAttributes -> Int
wborder WindowAttributes
wa)forall a. a -> [a] -> [a]
:(Rectangle -> Int
rpos Rectangle
gr forall a. Num a => a -> a -> a
+ Rectangle -> Int
rdim Rectangle
gr forall a. Num a => a -> a -> a
- Int
2forall a. Num a => a -> a -> a
*WindowAttributes -> Int
wborder WindowAttributes
wa)forall a. a -> [a] -> [a]
:(Rectangle -> Int
rpos Rectangle
sr forall a. Num a => a -> a -> a
+ Rectangle -> Int
rdim Rectangle
sr forall a. Num a => a -> a -> a
- Int
2forall a. Num a => a -> a -> a
*WindowAttributes -> Int
wborder WindowAttributes
wa)forall a. a -> [a] -> [a]
:
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\WindowAttributes
a [Int]
as -> (WindowAttributes -> Int
wpos WindowAttributes
a forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wborder WindowAttributes
a forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wborder WindowAttributes
wa)forall a. a -> [a] -> [a]
:(WindowAttributes -> Int
wpos WindowAttributes
a forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
wdim WindowAttributes
a)forall a. a -> [a] -> [a]
:[Int]
as) [] t WindowAttributes
wla
neighbours :: [a] -> a -> (Maybe a, Maybe a, Bool)
neighbours [a]
l a
v = ( forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Ord a => a -> a -> Bool
< a
v) [a]
l
, forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Ord a => a -> a -> Bool
<= a
v) [a]
l
, a
v 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 forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wborder WindowAttributes
oa forall a. Ord a => a -> a -> Bool
< WindowAttributes -> Int
refwpos WindowAttributes
wa forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
refwdim WindowAttributes
wa forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
wborder WindowAttributes
wa forall a. Num a => a -> a -> a
+ Int
dist
Bool -> Bool -> Bool
&& WindowAttributes -> Int
refwpos WindowAttributes
wa forall a. Num a => a -> a -> a
- WindowAttributes -> Int
wborder WindowAttributes
wa forall a. Num a => a -> a -> a
- Int
dist forall a. Ord a => a -> a -> Bool
< WindowAttributes -> Int
refwpos WindowAttributes
oa forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
refwdim WindowAttributes
oa 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 = ( forall a b. (Integral a, Num b) => a -> b
fromIntegralforall b c a. (b -> c) -> (a -> b) -> a -> c
.WindowAttributes -> CInt
wa_x
, forall a b. (Integral a, Num b) => a -> b
fromIntegralforall b c a. (b -> c) -> (a -> b) -> a -> c
.WindowAttributes -> CInt
wa_width
, forall a b. (Integral a, Num b) => a -> b
fromIntegralforall b c a. (b -> c) -> (a -> b) -> a -> c
.Rectangle -> Position
rect_x
, forall a b. (Integral a, Num b) => a -> b
fromIntegralforall b c a. (b -> c) -> (a -> b) -> a -> c
.Rectangle -> Dimension
rect_width
)
constructors Bool
False = ( forall a b. (Integral a, Num b) => a -> b
fromIntegralforall b c a. (b -> c) -> (a -> b) -> a -> c
.WindowAttributes -> CInt
wa_y
, forall a b. (Integral a, Num b) => a -> b
fromIntegralforall b c a. (b -> c) -> (a -> b) -> a -> c
.WindowAttributes -> CInt
wa_height
, forall a b. (Integral a, Num b) => a -> b
fromIntegralforall b c a. (b -> c) -> (a -> b) -> a -> c
.Rectangle -> Position
rect_y
, forall a b. (Integral a, Num b) => a -> b
fromIntegralforall b c a. (b -> c) -> (a -> b) -> a -> c
.Rectangle -> Dimension
rect_height
)