-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.FloatSnap
-- Description :  Snap to other windows or the edge of the screen while moving or resizing.
-- Copyright   :  (c) 2009 Anders Engstrom <ankaan@gmail.com>
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Anders Engstrom <ankaan@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Move and resize floating windows using other windows and the edge of the
-- screen as guidelines.
-----------------------------------------------------------------------------

module XMonad.Actions.FloatSnap (
                -- * Usage
                -- $usage
                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

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- >    import XMonad.Actions.FloatSnap
--
-- Then add appropriate key bindings, for example:
--
-- >        , ((modm,               xK_Left),  withFocused $ snapMove L Nothing)
-- >        , ((modm,               xK_Right), withFocused $ snapMove R Nothing)
-- >        , ((modm,               xK_Up),    withFocused $ snapMove U Nothing)
-- >        , ((modm,               xK_Down),  withFocused $ snapMove D Nothing)
-- >        , ((modm .|. shiftMask, xK_Left),  withFocused $ snapShrink R Nothing)
-- >        , ((modm .|. shiftMask, xK_Right), withFocused $ snapGrow R Nothing)
-- >        , ((modm .|. shiftMask, xK_Up),    withFocused $ snapShrink D Nothing)
-- >        , ((modm .|. shiftMask, xK_Down),  withFocused $ snapGrow D Nothing)
--
-- For detailed instructions on editing your key bindings, see
-- "XMonad.Doc.Extending#Editing_key_bindings".
--
-- And possibly add appropriate mouse bindings, for example:
--
-- >        , ((modm,               button1), (\w -> focus w >> mouseMoveWindow w >> ifClick (snapMagicMove (Just 50) (Just 50) w)))
-- >        , ((modm .|. shiftMask, button1), (\w -> focus w >> mouseMoveWindow w >> ifClick (snapMagicResize [L,R,U,D] (Just 50) (Just 50) w)))
-- >        , ((modm,               button3), (\w -> focus w >> mouseResizeWindow w >> ifClick (snapMagicResize [R,D] (Just 50) (Just 50) w)))
--
-- For detailed instructions on editing your mouse bindings, see
-- "XMonad.Doc.Extending#Editing_mouse_bindings".
--
-- Using these mouse bindings, it will not snap while moving, but allow you to click the window once after it has been moved or resized to snap it into place.
-- Note that the order in which the commands are applied in the mouse bindings are important. Snapping can also be used together with other window resizing
-- functions, such as those from "XMonad.Actions.FlexibleResize"
--
-- An alternative set of mouse bindings that will always snap after the drag is:
--
-- >        , ((modm,               button1), (\w -> focus w >> mouseMoveWindow w >> afterDrag (snapMagicMove (Just 50) (Just 50) w)))
-- >        , ((modm .|. shiftMask, button1), (\w -> focus w >> mouseMoveWindow w >> afterDrag (snapMagicResize [L,R,U,D] (Just 50) (Just 50) w)))
-- >        , ((modm,               button3), (\w -> focus w >> mouseResizeWindow w >> afterDrag (snapMagicResize [R,D] (Just 50) (Just 50) w)))
--
-- Interesting values for the distance to look for window in the orthogonal axis are Nothing (to snap against every window), Just 0 (to only snap
-- against windows that we should collide with geometrically while moving) and Just 1 (to also snap against windows we brush against).
--
-- For 'snapMagicMove', 'snapMagicResize' and 'snapMagicMouseResize', try instead setting it to the same as the maximum snapping distance.
--
-- When a value is specified it can be geometrically conceived as adding a border with the specified width around the window and then checking which
-- windows it should collide with.

-- | Resize the window by each edge independently to snap against the closest part of other windows or the edge of the screen. Use the location of the
--   mouse over the window to decide which edges to snap. In corners, the two adjoining edges will be snapped, along the middle of an edge only that edge
--   will be snapped. In the center of the window all edges will snap. Intended to be used together with "XMonad.Actions.FlexibleResize" or
--   "XMonad.Actions.FlexibleManipulate".
snapMagicMouseResize
    :: Rational  -- ^ How big the middle snap area of each axis should be.
    -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window.
    -> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary.
    -> Window    -- ^ The window to move and resize.
    -> 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 -> do
    WindowAttributes
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
    (Bool
_, Window
_, Window
_, CInt
px, CInt
py, CInt
_, CInt
_, Modifier
_) <- 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 :: Rational
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 :: Rational
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]
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]
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]
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]
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]
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 :: [Direction2D]
dir = if [Direction2D] -> Bool
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 = 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

-- | Resize the window by each edge independently to snap against the closest part of other windows or the edge of the screen.
snapMagicResize
    :: [Direction2D] -- ^ The edges to snap.
    -> Maybe Int   -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window.
    -> Maybe Int   -- ^ The maximum distance to snap. Use Nothing to not impose any boundary.
    -> Window      -- ^ The window to move and resize.
    -> 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 -> do
    WindowAttributes
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

    (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 Direction2D -> [Direction2D] -> 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' :: Int
xend'   = if Direction2D
R Direction2D -> [Direction2D] -> 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' :: Int
ybegin' = if Direction2D
U Direction2D -> [Direction2D] -> 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' :: Int
yend'   = if Direction2D
D Direction2D -> [Direction2D] -> 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 () -> 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
xbegin') (Int -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ybegin')
    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 -> Dimension) -> Int -> Dimension
forall a b. (a -> b) -> a -> b
$ Int
xend' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
xbegin') (Int -> Dimension
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Dimension) -> Int -> Dimension
forall a b. (a -> b) -> a -> b
$ Int
yend' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ybegin')
    Window -> X ()
float Window
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
            ((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 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 :: Int
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' :: Int
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' :: Int
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
            (Int, Int) -> X (Int, Int)
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


-- | Move a window by both axises in any direction to snap against the closest part of other windows or the edge of the screen.
snapMagicMove
    :: Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window.
    -> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary.
    -> Window    -- ^ The window to move.
    -> 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 -> do
    WindowAttributes
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

    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

    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)
    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
            Int -> X Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> X Int) -> Int -> X Int
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 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 :: Int
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 :: Int
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 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
newpos 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
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

-- | Move a window in the specified direction until it snaps against another window or the edge of the screen.
snapMove
    :: Direction2D -- ^ What direction to move the window in.
    -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window.
    -> Window    -- ^ The window to move.
    -> 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 -> do
    WindowAttributes
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
    ((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 = 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 Bool
horiz then 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 Position
newpos (CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Position) -> CInt -> Position
forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_y WindowAttributes
wa)
             else 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 (CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Position) -> CInt -> Position
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

-- | Grow the specified edge of a window until it snaps against another window or the edge of the screen.
snapGrow
    :: Direction2D -- ^ What edge of the window to grow.
    -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window.
    -> Window    -- ^ The window to grow.
    -> X ()
snapGrow :: Direction2D -> Maybe Int -> Window -> X ()
snapGrow = Bool -> Direction2D -> Maybe Int -> Window -> X ()
snapResize Bool
True

-- | Shrink the specified edge of a window until it snaps against another window or the edge of the screen.
snapShrink
    :: Direction2D -- ^ What edge of the window to shrink.
    -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window.
    -> Window    -- ^ The window to shrink.
    -> 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 -> do
    WindowAttributes
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
    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
                      Maybe (Int, Int, Int, Int) -> X (Maybe (Int, Int, Int, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Int, Int, Int, Int) -> X (Maybe (Int, Int, Int, Int)))
-> Maybe (Int, Int, Int, Int) -> X (Maybe (Int, Int, Int, Int))
forall a b. (a -> b) -> a -> b
$ case (if Bool
grow then Maybe Int
mg else Maybe Int
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 ((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
                      Maybe (Int, Int, Int, Int) -> X (Maybe (Int, Int, Int, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Int, Int, Int, Int) -> X (Maybe (Int, Int, Int, Int)))
-> Maybe (Int, Int, Int, Int) -> X (Maybe (Int, Int, Int, Int))
forall a b. (a -> b) -> a -> b
$ case (if Bool
grow then Maybe Int
mg else Maybe Int
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 ((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
                      Maybe (Int, Int, Int, Int) -> X (Maybe (Int, Int, Int, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Int, Int, Int, Int) -> X (Maybe (Int, Int, Int, Int)))
-> Maybe (Int, Int, Int, Int) -> X (Maybe (Int, Int, Int, Int))
forall a b. (a -> b) -> a -> b
$ case (if Bool
grow then Maybe Int
mg else Maybe Int
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 ((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
                      Maybe (Int, Int, Int, Int) -> X (Maybe (Int, Int, Int, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Int, Int, Int, Int) -> X (Maybe (Int, Int, Int, Int)))
-> Maybe (Int, Int, Int, Int) -> X (Maybe (Int, Int, Int, Int))
forall a b. (a -> b) -> a -> b
$ case (if Bool
grow then Maybe Int
mg else Maybe Int
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 Maybe (Int, Int, Int, Int)
mr of
        Maybe (Int, Int, Int, Int)
Nothing -> () -> X ()
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)
    Window -> X ()
float Window
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
    WindowAttributes
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 WorkspaceId (Layout Window) Window ScreenId ScreenDetail
screen <- StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> X (StackSet
        WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> X (Screen
        WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XState
 -> StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> X (StackSet
        WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
windowset
    let sr :: Rectangle
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 :: [Window]
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
    Rectangle
gr <- ((Rectangle -> Rectangle) -> Rectangle -> Rectangle
forall a b. (a -> b) -> a -> b
$Rectangle
sr) ((Rectangle -> Rectangle) -> Rectangle)
-> X (Rectangle -> Rectangle) -> X Rectangle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Direction2D -> X (Rectangle -> Rectangle)
calcGap ([Direction2D] -> Set Direction2D
forall a. Ord a => [a] -> Set a
S.fromList [Direction2D
forall a. Bounded a => a
minBound .. Direction2D
forall a. Bounded a => a
maxBound])
    [WindowAttributes]
wla <- (WindowAttributes -> Bool)
-> [WindowAttributes] -> [WindowAttributes]
forall a. (a -> Bool) -> [a] -> [a]
filter (WindowAttributes -> WindowAttributes -> Bool
collides WindowAttributes
wa) ([WindowAttributes] -> [WindowAttributes])
-> X [WindowAttributes] -> X [WindowAttributes]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [WindowAttributes] -> X [WindowAttributes]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io ((Window -> IO WindowAttributes)
-> [Window] -> IO [WindowAttributes]
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) ([Window] -> IO [WindowAttributes])
-> [Window] -> IO [WindowAttributes]
forall a b. (a -> b) -> a -> b
$ (Window -> Bool) -> [Window] -> [Window]
forall a. (a -> Bool) -> [a] -> [a]
filter (Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
/=Window
w) [Window]
wl)

    ((Maybe Int, Maybe Int, Bool), (Maybe Int, Maybe Int, Bool))
-> X ((Maybe Int, Maybe Int, Bool), (Maybe Int, Maybe Int, Bool))
forall (m :: * -> *) a. Monad m => a -> m a
return ( [Int] -> Int -> (Maybe Int, Maybe Int, Bool)
forall a. Ord a => [a] -> a -> (Maybe a, Maybe a, Bool)
neighbours (WindowAttributes
-> Rectangle -> Rectangle -> [WindowAttributes] -> [Int]
forall (t :: * -> *).
Foldable t =>
WindowAttributes
-> Rectangle -> Rectangle -> t WindowAttributes -> [Int]
back WindowAttributes
wa Rectangle
sr Rectangle
gr [WindowAttributes]
wla) (WindowAttributes -> Int
wpos WindowAttributes
wa)
           , [Int] -> Int -> (Maybe Int, Maybe Int, Bool)
forall a. Ord a => [a] -> a -> (Maybe a, Maybe a, Bool)
neighbours (WindowAttributes
-> Rectangle -> Rectangle -> [WindowAttributes] -> [Int]
forall (t :: * -> *).
Foldable t =>
WindowAttributes
-> Rectangle -> Rectangle -> t WindowAttributes -> [Int]
front WindowAttributes
wa Rectangle
sr Rectangle
gr [WindowAttributes]
wla) (WindowAttributes -> Int
wpos WindowAttributes
wa Int -> Int -> Int
forall a. Num a => a -> a -> a
+ WindowAttributes -> Int
wdim WindowAttributes
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 (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 (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 (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
                     )