{-# LANGUAGE TupleSections #-}
module XMonad.Hooks.Place (
placeFocused
, placeHook
, Placement
, smart
, simpleSmart
, fixed
, underMouse
, inBounds
, withGaps
, purePlaceWindow ) where
import XMonad
import XMonad.Prelude
import qualified XMonad.StackSet as S
import XMonad.Layout.WindowArranger
import XMonad.Actions.FloatKeys
import qualified Data.Map as M
import Data.Ratio ((%))
import Control.Monad.Trans (lift)
data Placement = Smart (Rational, Rational)
| Fixed (Rational, Rational)
| UnderMouse (Rational, Rational)
| Bounds (Dimension, Dimension, Dimension, Dimension) Placement
deriving (Int -> Placement -> ShowS
[Placement] -> ShowS
Placement -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Placement] -> ShowS
$cshowList :: [Placement] -> ShowS
show :: Placement -> String
$cshow :: Placement -> String
showsPrec :: Int -> Placement -> ShowS
$cshowsPrec :: Int -> Placement -> ShowS
Show, ReadPrec [Placement]
ReadPrec Placement
Int -> ReadS Placement
ReadS [Placement]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Placement]
$creadListPrec :: ReadPrec [Placement]
readPrec :: ReadPrec Placement
$creadPrec :: ReadPrec Placement
readList :: ReadS [Placement]
$creadList :: ReadS [Placement]
readsPrec :: Int -> ReadS Placement
$creadsPrec :: Int -> ReadS Placement
Read, Placement -> Placement -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Placement -> Placement -> Bool
$c/= :: Placement -> Placement -> Bool
== :: Placement -> Placement -> Bool
$c== :: Placement -> Placement -> Bool
Eq)
smart :: (Rational, Rational)
-> Placement
smart :: (Rational, Rational) -> Placement
smart = (Rational, Rational) -> Placement
Smart
simpleSmart :: Placement
simpleSmart :: Placement
simpleSmart = Placement -> Placement
inBounds forall a b. (a -> b) -> a -> b
$ (Rational, Rational) -> Placement
smart (Rational
0,Rational
0)
fixed :: (Rational, Rational)
-> Placement
fixed :: (Rational, Rational) -> Placement
fixed = (Rational, Rational) -> Placement
Fixed
underMouse :: (Rational, Rational)
-> Placement
underMouse :: (Rational, Rational) -> Placement
underMouse = (Rational, Rational) -> Placement
UnderMouse
inBounds :: Placement -> Placement
inBounds :: Placement -> Placement
inBounds = (Dimension, Dimension, Dimension, Dimension)
-> Placement -> Placement
Bounds (Dimension
0,Dimension
0,Dimension
0,Dimension
0)
withGaps :: (Dimension, Dimension, Dimension, Dimension)
-> Placement -> Placement
withGaps :: (Dimension, Dimension, Dimension, Dimension)
-> Placement -> Placement
withGaps = (Dimension, Dimension, Dimension, Dimension)
-> Placement -> Placement
Bounds
placeFocused :: Placement -> X ()
placeFocused :: Placement -> X ()
placeFocused Placement
p = (Window -> X ()) -> X ()
withFocused forall a b. (a -> b) -> a -> b
$ \Window
window -> do
(Workspace String (Layout Window) Window, Rectangle)
info <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall i l a sid.
Screen i l a sid ScreenDetail -> (Workspace i l a, Rectangle)
screenInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
S.current forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
[Window]
floats <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [k]
M.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
S.floating forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
r' :: Rectangle
r'@(Rectangle Position
x' Position
y' Dimension
_ Dimension
_) <- Placement
-> Window
-> (Workspace String (Layout Window) Window, Rectangle)
-> [Window]
-> X Rectangle
placeWindow Placement
p Window
window (Workspace String (Layout Window) Window, Rectangle)
info [Window]
floats
if Window
window forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
floats
then P -> (Rational, Rational) -> Window -> X ()
keysMoveWindowTo (Position
x', Position
y') (Rational
0, Rational
0) Window
window
else forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ Rectangle -> WindowArrangerMsg
SetGeometry Rectangle
r'
placeHook :: Placement -> ManageHook
placeHook :: Placement -> ManageHook
placeHook Placement
p = do Window
window <- forall r (m :: * -> *). MonadReader r m => m r
ask
Rectangle
r <- forall a. ReaderT Window X a -> Query a
Query forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Window -> X Rectangle
getWindowRectangle Window
window
Map Window Rectangle
allRs <- forall a. ReaderT Window X a -> Query a
Query forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift X (Map Window Rectangle)
getAllRectangles
P
pointer <- forall a. ReaderT Window X a -> Query a
Query forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Window -> X P
getPointer Window
window
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> Endo a
Endo forall a b. (a -> b) -> a -> b
$ \WindowSet
theWS -> forall a. a -> Maybe a -> a
fromMaybe WindowSet
theWS forall a b. (a -> b) -> a -> b
$
do let currentRect :: Rectangle
currentRect = ScreenDetail -> Rectangle
screenRect forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. Screen i l a sid sd -> sd
S.screenDetail forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
S.current WindowSet
theWS
floats :: [Window]
floats = forall k a. Map k a -> [k]
M.keys forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
S.floating WindowSet
theWS
forall (f :: * -> *). Alternative f => Bool -> f ()
guard(Window
window forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
floats )
let infos :: Maybe (Workspace String (Layout Window) Window, Rectangle)
infos = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Window
window forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w. Maybe (Stack w) -> [w]
stackContents forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
S.stack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
forall a b. (a -> b) -> a -> b
$ [forall i l a sid.
Screen i l a sid ScreenDetail -> (Workspace i l a, Rectangle)
screenInfo forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
S.current WindowSet
theWS]
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall i l a sid.
Screen i l a sid ScreenDetail -> (Workspace i l a, Rectangle)
screenInfo (forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
S.visible WindowSet
theWS)
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (, Rectangle
currentRect) (forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
S.hidden WindowSet
theWS)
case Maybe (Workspace String (Layout Window) Window, Rectangle)
infos of
Maybe (Workspace String (Layout Window) Window, Rectangle)
Nothing -> forall (f :: * -> *) a. Alternative f => f a
empty
Just (Workspace String (Layout Window) Window, Rectangle)
info -> do
let (Workspace String (Layout Window) Window
workspace, Rectangle
screen) = (Workspace String (Layout Window) Window, Rectangle)
info
rs :: [Rectangle]
rs = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map Window Rectangle
allRs)
forall a b. (a -> b) -> a -> b
$ forall a b. Workspace a b Window -> Window -> [Window] -> [Window]
organizeClients Workspace String (Layout Window) Window
workspace Window
window [Window]
floats
r' :: Rectangle
r' = Placement
-> Rectangle -> [Rectangle] -> P -> Rectangle -> Rectangle
purePlaceWindow Placement
p Rectangle
screen [Rectangle]
rs P
pointer Rectangle
r
newRect :: RationalRect
newRect = Rectangle -> Rectangle -> RationalRect
r2rr Rectangle
screen Rectangle
r'
newFloats :: Map Window RationalRect
newFloats = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Window
window RationalRect
newRect (forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
S.floating WindowSet
theWS)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ WindowSet
theWS { floating :: Map Window RationalRect
S.floating = Map Window RationalRect
newFloats }
placeWindow :: Placement -> Window
-> (S.Workspace WorkspaceId (Layout Window) Window, Rectangle)
-> [Window]
-> X Rectangle
placeWindow :: Placement
-> Window
-> (Workspace String (Layout Window) Window, Rectangle)
-> [Window]
-> X Rectangle
placeWindow Placement
p Window
window (Workspace String (Layout Window) Window
ws, Rectangle
s) [Window]
floats
= do (Rectangle
r, [Rectangle]
rs, P
pointer) <- Window
-> Workspace String (Layout Window) Window
-> [Window]
-> X (Rectangle, [Rectangle], P)
getNecessaryData Window
window Workspace String (Layout Window) Window
ws [Window]
floats
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Placement
-> Rectangle -> [Rectangle] -> P -> Rectangle -> Rectangle
purePlaceWindow Placement
p Rectangle
s [Rectangle]
rs P
pointer Rectangle
r
purePlaceWindow :: Placement
-> Rectangle
-> [Rectangle]
-> (Position, Position)
-> Rectangle
-> Rectangle
purePlaceWindow :: Placement
-> Rectangle -> [Rectangle] -> P -> Rectangle -> Rectangle
purePlaceWindow (Bounds (Dimension
t,Dimension
r,Dimension
b,Dimension
l) Placement
p') (Rectangle Position
sx Position
sy Dimension
sw Dimension
sh) [Rectangle]
rs P
p Rectangle
w
= let s' :: Rectangle
s' = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
sx forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
l) (Position
sy forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
t) (Dimension
sw forall a. Num a => a -> a -> a
- Dimension
l forall a. Num a => a -> a -> a
- Dimension
r) (Dimension
sh forall a. Num a => a -> a -> a
- Dimension
t forall a. Num a => a -> a -> a
- Dimension
b)
in Rectangle -> Rectangle -> Rectangle
checkBounds Rectangle
s' forall a b. (a -> b) -> a -> b
$ Placement
-> Rectangle -> [Rectangle] -> P -> Rectangle -> Rectangle
purePlaceWindow Placement
p' Rectangle
s' [Rectangle]
rs P
p Rectangle
w
purePlaceWindow (Fixed (Rational, Rational)
ratios) Rectangle
s [Rectangle]
_ P
_ Rectangle
w = (Rational, Rational) -> Rectangle -> Rectangle -> Rectangle
placeRatio (Rational, Rational)
ratios Rectangle
s Rectangle
w
purePlaceWindow (UnderMouse (Rational
rx, Rational
ry)) Rectangle
_ [Rectangle]
_ (Position
px, Position
py) (Rectangle Position
_ Position
_ Dimension
w Dimension
h)
= Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
px forall a. Num a => a -> a -> a
- forall a b. (RealFrac a, Integral b) => a -> b
truncate (Rational
rx forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fi Dimension
w)) (Position
py forall a. Num a => a -> a -> a
- forall a b. (RealFrac a, Integral b) => a -> b
truncate (Rational
ry forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fi Dimension
h)) Dimension
w Dimension
h
purePlaceWindow (Smart (Rational, Rational)
ratios) Rectangle
s [Rectangle]
rs P
_ Rectangle
w
= (Rational, Rational)
-> Rectangle -> [Rectangle] -> Dimension -> Dimension -> Rectangle
placeSmart (Rational, Rational)
ratios Rectangle
s [Rectangle]
rs (Rectangle -> Dimension
rect_width Rectangle
w) (Rectangle -> Dimension
rect_height Rectangle
w)
placeRatio :: (Rational, Rational) -> Rectangle -> Rectangle -> Rectangle
placeRatio :: (Rational, Rational) -> Rectangle -> Rectangle -> Rectangle
placeRatio (Rational
rx, Rational
ry) (Rectangle Position
x1 Position
y1 Dimension
w1 Dimension
h1) (Rectangle Position
_ Position
_ Dimension
w2 Dimension
h2)
= Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (forall a b. (RealFrac a, Integral b) => a -> b -> b -> b
scale Rational
rx Position
x1 (Position
x1 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
w1 forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Dimension
w2))
(forall a b. (RealFrac a, Integral b) => a -> b -> b -> b
scale Rational
ry Position
y1 (Position
y1 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
h1 forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Dimension
h2))
Dimension
w2 Dimension
h2
checkBounds :: Rectangle -> Rectangle -> Rectangle
checkBounds :: Rectangle -> Rectangle -> Rectangle
checkBounds (Rectangle Position
x1 Position
y1 Dimension
w1 Dimension
h1) (Rectangle Position
x2 Position
y2 Dimension
w2 Dimension
h2)
= Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (forall a. Ord a => a -> a -> a
max Position
x1 (forall a. Ord a => a -> a -> a
min (Position
x1 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
w1 forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Dimension
w2) Position
x2))
(forall a. Ord a => a -> a -> a
max Position
y1 (forall a. Ord a => a -> a -> a
min (Position
y1 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
h1 forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Dimension
h2) Position
y2))
Dimension
w2 Dimension
h2
scale :: (RealFrac a, Integral b) => a -> b -> b -> b
scale :: forall a b. (RealFrac a, Integral b) => a -> b -> b -> b
scale a
r b
n1 b
n2 = forall a b. (RealFrac a, Integral b) => a -> b
truncate forall a b. (a -> b) -> a -> b
$ a
r forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fi b
n2 forall a. Num a => a -> a -> a
+ (a
1 forall a. Num a => a -> a -> a
- a
r) forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fi b
n1
r2rr :: Rectangle -> Rectangle -> S.RationalRect
r2rr :: Rectangle -> Rectangle -> RationalRect
r2rr (Rectangle Position
x0 Position
y0 Dimension
w0 Dimension
h0) (Rectangle Position
x Position
y Dimension
w Dimension
h)
= Rational -> Rational -> Rational -> Rational -> RationalRect
S.RationalRect ((forall a b. (Integral a, Num b) => a -> b
fi Position
xforall a. Num a => a -> a -> a
-forall a b. (Integral a, Num b) => a -> b
fi Position
x0) forall a. Integral a => a -> a -> Ratio a
% forall a b. (Integral a, Num b) => a -> b
fi Dimension
w0)
((forall a b. (Integral a, Num b) => a -> b
fi Position
yforall a. Num a => a -> a -> a
-forall a b. (Integral a, Num b) => a -> b
fi Position
y0) forall a. Integral a => a -> a -> Ratio a
% forall a b. (Integral a, Num b) => a -> b
fi Dimension
h0)
(forall a b. (Integral a, Num b) => a -> b
fi Dimension
w forall a. Integral a => a -> a -> Ratio a
% forall a b. (Integral a, Num b) => a -> b
fi Dimension
w0)
(forall a b. (Integral a, Num b) => a -> b
fi Dimension
h forall a. Integral a => a -> a -> Ratio a
% forall a b. (Integral a, Num b) => a -> b
fi Dimension
h0)
stackContents :: Maybe (S.Stack w) -> [w]
stackContents :: forall w. Maybe (Stack w) -> [w]
stackContents = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall a. Stack a -> [a]
S.integrate
screenInfo :: S.Screen i l a sid ScreenDetail -> (S.Workspace i l a, Rectangle)
screenInfo :: forall i l a sid.
Screen i l a sid ScreenDetail -> (Workspace i l a, Rectangle)
screenInfo S.Screen{ workspace :: forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
S.workspace = Workspace i l a
ws, screenDetail :: forall i l a sid sd. Screen i l a sid sd -> sd
S.screenDetail = (SD Rectangle
s)} = (Workspace i l a
ws, Rectangle
s)
getWindowRectangle :: Window -> X Rectangle
getWindowRectangle :: Window -> X Rectangle
getWindowRectangle Window
window
= do Display
d <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
(Window
_, Position
x, Position
y, Dimension
w, Dimension
h, Dimension
_, CInt
_) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> IO
(Window, Position, Position, Dimension, Dimension, Dimension, CInt)
getGeometry Display
d Window
window
Dimension
b <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *). XConfig l -> Dimension
borderWidth forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y (Dimension
w forall a. Num a => a -> a -> a
+ Dimension
2forall a. Num a => a -> a -> a
*Dimension
b) (Dimension
h forall a. Num a => a -> a -> a
+ Dimension
2forall a. Num a => a -> a -> a
*Dimension
b)
getAllRectangles :: X (M.Map Window Rectangle)
getAllRectangles :: X (Map Window Rectangle)
getAllRectangles = do WindowSet
ws <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
let allWindows :: [Window]
allWindows = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall w. Maybe (Stack w) -> [w]
stackContents forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
S.stack)
forall a b. (a -> b) -> a -> b
$ (forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
S.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
S.current) WindowSet
ws
forall a. a -> [a] -> [a]
: (forall a b. (a -> b) -> [a] -> [b]
map forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
S.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
S.visible) WindowSet
ws
forall a. [a] -> [a] -> [a]
++ forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
S.hidden WindowSet
ws
[Rectangle]
allRects <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Window -> X Rectangle
getWindowRectangle [Window]
allWindows
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Window]
allWindows [Rectangle]
allRects
organizeClients :: S.Workspace a b Window -> Window -> [Window] -> [Window]
organizeClients :: forall a b. Workspace a b Window -> Window -> [Window] -> [Window]
organizeClients Workspace a b Window
ws Window
w [Window]
floats
= let ([Window]
floatCs, [Window]
layoutCs) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
floats) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Window
w)
forall a b. (a -> b) -> a -> b
$ forall w. Maybe (Stack w) -> [w]
stackContents forall a b. (a -> b) -> a -> b
$ forall i l a. Workspace i l a -> Maybe (Stack a)
S.stack Workspace a b Window
ws
in forall a. [a] -> [a]
reverse [Window]
layoutCs forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
reverse [Window]
floatCs
getPointer :: Window -> X (Position, Position)
getPointer :: Window -> X P
getPointer Window
window = do Display
d <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
(Bool
_,Window
_,Window
_,CInt
x,CInt
y,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
window
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (Integral a, Num b) => a -> b
fi CInt
x,forall a b. (Integral a, Num b) => a -> b
fi CInt
y)
getNecessaryData :: Window
-> S.Workspace WorkspaceId (Layout Window) Window
-> [Window]
-> X (Rectangle, [Rectangle], (Position, Position))
getNecessaryData :: Window
-> Workspace String (Layout Window) Window
-> [Window]
-> X (Rectangle, [Rectangle], P)
getNecessaryData Window
window Workspace String (Layout Window) Window
ws [Window]
floats
= do Rectangle
r <- Window -> X Rectangle
getWindowRectangle Window
window
[Rectangle]
rs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Window -> X Rectangle
getWindowRectangle (forall a b. Workspace a b Window -> Window -> [Window] -> [Window]
organizeClients Workspace String (Layout Window) Window
ws Window
window [Window]
floats)
P
pointer <- Window -> X P
getPointer Window
window
forall (m :: * -> *) a. Monad m => a -> m a
return (Rectangle
r, [Rectangle]
rs, P
pointer)
data SmartRectangle a = SR
{ forall a. SmartRectangle a -> a
sr_x0, forall a. SmartRectangle a -> a
sr_y0 :: a
, forall a. SmartRectangle a -> a
sr_x1, forall a. SmartRectangle a -> a
sr_y1 :: a
} deriving (Int -> SmartRectangle a -> ShowS
forall a. Show a => Int -> SmartRectangle a -> ShowS
forall a. Show a => [SmartRectangle a] -> ShowS
forall a. Show a => SmartRectangle a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SmartRectangle a] -> ShowS
$cshowList :: forall a. Show a => [SmartRectangle a] -> ShowS
show :: SmartRectangle a -> String
$cshow :: forall a. Show a => SmartRectangle a -> String
showsPrec :: Int -> SmartRectangle a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> SmartRectangle a -> ShowS
Show, SmartRectangle a -> SmartRectangle a -> Bool
forall a. Eq a => SmartRectangle a -> SmartRectangle a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SmartRectangle a -> SmartRectangle a -> Bool
$c/= :: forall a. Eq a => SmartRectangle a -> SmartRectangle a -> Bool
== :: SmartRectangle a -> SmartRectangle a -> Bool
$c== :: forall a. Eq a => SmartRectangle a -> SmartRectangle a -> Bool
Eq)
r2sr :: Rectangle -> SmartRectangle Position
r2sr :: Rectangle -> SmartRectangle Position
r2sr (Rectangle Position
x Position
y Dimension
w Dimension
h) = forall a. a -> a -> a -> a -> SmartRectangle a
SR Position
x Position
y (Position
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
w) (Position
y forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
h)
sr2r :: SmartRectangle Position -> Rectangle
sr2r :: SmartRectangle Position -> Rectangle
sr2r (SR Position
x0 Position
y0 Position
x1 Position
y1) = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x0 Position
y0 (forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ Position
x1 forall a. Num a => a -> a -> a
- Position
x0) (forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ Position
y1 forall a. Num a => a -> a -> a
- Position
y0)
width :: Num a => SmartRectangle a -> a
width :: forall a. Num a => SmartRectangle a -> a
width SmartRectangle a
r = forall a. SmartRectangle a -> a
sr_x1 SmartRectangle a
r forall a. Num a => a -> a -> a
- forall a. SmartRectangle a -> a
sr_x0 SmartRectangle a
r
height :: Num a => SmartRectangle a -> a
height :: forall a. Num a => SmartRectangle a -> a
height SmartRectangle a
r = forall a. SmartRectangle a -> a
sr_y1 SmartRectangle a
r forall a. Num a => a -> a -> a
- forall a. SmartRectangle a -> a
sr_y0 SmartRectangle a
r
isEmpty :: Real a => SmartRectangle a -> Bool
isEmpty :: forall a. Real a => SmartRectangle a -> Bool
isEmpty SmartRectangle a
r = (forall a. Num a => SmartRectangle a -> a
width SmartRectangle a
r forall a. Ord a => a -> a -> Bool
<= a
0) Bool -> Bool -> Bool
|| (forall a. Num a => SmartRectangle a -> a
height SmartRectangle a
r forall a. Ord a => a -> a -> Bool
<= a
0)
contains :: Real a => SmartRectangle a -> SmartRectangle a -> Bool
contains :: forall a. Real a => SmartRectangle a -> SmartRectangle a -> Bool
contains SmartRectangle a
r1 SmartRectangle a
r2 = forall a. SmartRectangle a -> a
sr_x0 SmartRectangle a
r1 forall a. Ord a => a -> a -> Bool
<= forall a. SmartRectangle a -> a
sr_x0 SmartRectangle a
r2
Bool -> Bool -> Bool
&& forall a. SmartRectangle a -> a
sr_y0 SmartRectangle a
r1 forall a. Ord a => a -> a -> Bool
<= forall a. SmartRectangle a -> a
sr_y0 SmartRectangle a
r2
Bool -> Bool -> Bool
&& forall a. SmartRectangle a -> a
sr_x1 SmartRectangle a
r1 forall a. Ord a => a -> a -> Bool
>= forall a. SmartRectangle a -> a
sr_x1 SmartRectangle a
r2
Bool -> Bool -> Bool
&& forall a. SmartRectangle a -> a
sr_y1 SmartRectangle a
r1 forall a. Ord a => a -> a -> Bool
>= forall a. SmartRectangle a -> a
sr_y1 SmartRectangle a
r2
placeSmart :: (Rational, Rational)
-> Rectangle
-> [Rectangle]
-> Dimension
-> Dimension
-> Rectangle
placeSmart :: (Rational, Rational)
-> Rectangle -> [Rectangle] -> Dimension -> Dimension -> Rectangle
placeSmart (Rational
rx, Rational
ry) s :: Rectangle
s@(Rectangle Position
sx Position
sy Dimension
sw Dimension
sh) [Rectangle]
rs Dimension
w Dimension
h
= let free :: [Rectangle]
free = forall a b. (a -> b) -> [a] -> [b]
map SmartRectangle Position -> Rectangle
sr2r forall a b. (a -> b) -> a -> b
$ forall a.
Real a =>
SmartRectangle a
-> [SmartRectangle a] -> a -> a -> [SmartRectangle a]
findSpace (Rectangle -> SmartRectangle Position
r2sr Rectangle
s) (forall a b. (a -> b) -> [a] -> [b]
map Rectangle -> SmartRectangle Position
r2sr [Rectangle]
rs) (forall a b. (Integral a, Num b) => a -> b
fi Dimension
w) (forall a b. (Integral a, Num b) => a -> b
fi Dimension
h)
in [Rectangle]
-> Position -> Position -> Dimension -> Dimension -> Rectangle
position [Rectangle]
free (forall a b. (RealFrac a, Integral b) => a -> b -> b -> b
scale Rational
rx Position
sx (Position
sx forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
sw forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Dimension
w))
(forall a b. (RealFrac a, Integral b) => a -> b -> b -> b
scale Rational
ry Position
sy (Position
sy forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
sh forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Dimension
h))
Dimension
w Dimension
h
position :: [Rectangle]
-> Position -> Position
-> Dimension -> Dimension
-> Rectangle
position :: [Rectangle]
-> Position -> Position -> Dimension -> Dimension -> Rectangle
position [Rectangle]
rs Position
x Position
y Dimension
w Dimension
h = forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy Rectangle -> Rectangle -> Ordering
distanceOrder forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Rectangle -> Rectangle
closest [Rectangle]
rs
where distanceOrder :: Rectangle -> Rectangle -> Ordering
distanceOrder Rectangle
r1 Rectangle
r2
= forall a. Ord a => a -> a -> Ordering
compare (forall {b} {a}. (Integral b, Integral a) => (a, a) -> (a, a) -> b
distance (Rectangle -> Position
rect_x Rectangle
r1,Rectangle -> Position
rect_y Rectangle
r1) (Position
x,Position
y) :: Dimension)
(forall {b} {a}. (Integral b, Integral a) => (a, a) -> (a, a) -> b
distance (Rectangle -> Position
rect_x Rectangle
r2,Rectangle -> Position
rect_y Rectangle
r2) (Position
x,Position
y) :: Dimension)
distance :: (a, a) -> (a, a) -> b
distance (a
x1,a
y1) (a
x2,a
y2) = forall a b. (RealFrac a, Integral b) => a -> b
truncate forall a b. (a -> b) -> a -> b
$ (forall a. Floating a => a -> a
sqrt :: Double -> Double)
forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ (a
x1 forall a. Num a => a -> a -> a
- a
x2)forall a b. (Num a, Integral b) => a -> b -> a
^(Int
2::Int)
forall a. Num a => a -> a -> a
+ (a
y1 forall a. Num a => a -> a -> a
- a
y2)forall a b. (Num a, Integral b) => a -> b -> a
^(Int
2::Int)
closest :: Rectangle -> Rectangle
closest Rectangle
r = Rectangle -> Rectangle -> Rectangle
checkBounds Rectangle
r (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y Dimension
w Dimension
h)
findSpace :: Real a =>
SmartRectangle a
-> [SmartRectangle a]
-> a
-> a
-> [SmartRectangle a]
findSpace :: forall a.
Real a =>
SmartRectangle a
-> [SmartRectangle a] -> a -> a -> [SmartRectangle a]
findSpace SmartRectangle a
total [] a
_ a
_ = [SmartRectangle a
total]
findSpace SmartRectangle a
total rs :: [SmartRectangle a]
rs@(SmartRectangle a
_:[SmartRectangle a]
rs') a
w a
h
= case forall a. (a -> Bool) -> [a] -> [a]
filter SmartRectangle a -> Bool
largeEnough forall a b. (a -> b) -> a -> b
$ forall a. Real a => [SmartRectangle a] -> [SmartRectangle a]
cleanup forall a b. (a -> b) -> a -> b
$ forall a.
Real a =>
SmartRectangle a -> [SmartRectangle a] -> [SmartRectangle a]
subtractRects SmartRectangle a
total [SmartRectangle a]
rs of
[] -> forall a.
Real a =>
SmartRectangle a
-> [SmartRectangle a] -> a -> a -> [SmartRectangle a]
findSpace SmartRectangle a
total [SmartRectangle a]
rs' a
w a
h
[SmartRectangle a]
as -> [SmartRectangle a]
as
where largeEnough :: SmartRectangle a -> Bool
largeEnough SmartRectangle a
r = forall a. Num a => SmartRectangle a -> a
width SmartRectangle a
r forall a. Ord a => a -> a -> Bool
>= a
w Bool -> Bool -> Bool
&& forall a. Num a => SmartRectangle a -> a
height SmartRectangle a
r forall a. Ord a => a -> a -> Bool
>= a
h
subtractRects :: Real a => SmartRectangle a
-> [SmartRectangle a] -> [SmartRectangle a]
subtractRects :: forall a.
Real a =>
SmartRectangle a -> [SmartRectangle a] -> [SmartRectangle a]
subtractRects SmartRectangle a
total [] = [SmartRectangle a
total]
subtractRects SmartRectangle a
total (SmartRectangle a
r:[SmartRectangle a]
rs)
= do SmartRectangle a
total' <- forall a.
Real a =>
SmartRectangle a -> [SmartRectangle a] -> [SmartRectangle a]
subtractRects SmartRectangle a
total [SmartRectangle a]
rs
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => SmartRectangle a -> Bool
isEmpty)
[ SmartRectangle a
total' {sr_y1 :: a
sr_y1 = forall a. Ord a => a -> a -> a
min (forall a. SmartRectangle a -> a
sr_y1 SmartRectangle a
total') (forall a. SmartRectangle a -> a
sr_y0 SmartRectangle a
r)}
, SmartRectangle a
total' {sr_x0 :: a
sr_x0 = forall a. Ord a => a -> a -> a
max (forall a. SmartRectangle a -> a
sr_x0 SmartRectangle a
total') (forall a. SmartRectangle a -> a
sr_x1 SmartRectangle a
r)}
, SmartRectangle a
total' {sr_y0 :: a
sr_y0 = forall a. Ord a => a -> a -> a
max (forall a. SmartRectangle a -> a
sr_y0 SmartRectangle a
total') (forall a. SmartRectangle a -> a
sr_y1 SmartRectangle a
r)}
, SmartRectangle a
total' {sr_x1 :: a
sr_x1 = forall a. Ord a => a -> a -> a
min (forall a. SmartRectangle a -> a
sr_x1 SmartRectangle a
total') (forall a. SmartRectangle a -> a
sr_x0 SmartRectangle a
r)}
]
cleanup :: Real a => [SmartRectangle a] -> [SmartRectangle a]
cleanup :: forall a. Real a => [SmartRectangle a] -> [SmartRectangle a]
cleanup [SmartRectangle a]
rs = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a.
Real a =>
SmartRectangle a -> [SmartRectangle a] -> [SmartRectangle a]
dropIfContained [] forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy forall a.
Real a =>
SmartRectangle a -> SmartRectangle a -> Ordering
sizeOrder [SmartRectangle a]
rs
sizeOrder :: Real a => SmartRectangle a -> SmartRectangle a -> Ordering
sizeOrder :: forall a.
Real a =>
SmartRectangle a -> SmartRectangle a -> Ordering
sizeOrder SmartRectangle a
r1 SmartRectangle a
r2 | a
w1 forall a. Ord a => a -> a -> Bool
< a
w2 = Ordering
LT
| a
w1 forall a. Eq a => a -> a -> Bool
== a
w2 Bool -> Bool -> Bool
&& a
h1 forall a. Ord a => a -> a -> Bool
< a
h2 = Ordering
LT
| a
w1 forall a. Eq a => a -> a -> Bool
== a
w2 Bool -> Bool -> Bool
&& a
h1 forall a. Eq a => a -> a -> Bool
== a
h2 = Ordering
EQ
| Bool
otherwise = Ordering
GT
where w1 :: a
w1 = forall a. Num a => SmartRectangle a -> a
width SmartRectangle a
r1
w2 :: a
w2 = forall a. Num a => SmartRectangle a -> a
width SmartRectangle a
r2
h1 :: a
h1 = forall a. Num a => SmartRectangle a -> a
height SmartRectangle a
r1
h2 :: a
h2 = forall a. Num a => SmartRectangle a -> a
height SmartRectangle a
r2
dropIfContained :: Real a => SmartRectangle a
-> [SmartRectangle a] -> [SmartRectangle a]
dropIfContained :: forall a.
Real a =>
SmartRectangle a -> [SmartRectangle a] -> [SmartRectangle a]
dropIfContained SmartRectangle a
r [SmartRectangle a]
rs = if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Real a => SmartRectangle a -> SmartRectangle a -> Bool
`contains` SmartRectangle a
r) [SmartRectangle a]
rs
then [SmartRectangle a]
rs
else SmartRectangle a
rforall a. a -> [a] -> [a]
:[SmartRectangle a]
rs