-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Hooks.Place
-- Description :  Automatic placement of floating windows.
-- Copyright   :  Quentin Moser <moserq@gmail.com>
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  orphaned
-- Stability   :  unstable
-- Portability :  unportable
--
-- Automatic placement of floating windows.
--
-----------------------------------------------------------------------------

module XMonad.Hooks.Place   ( -- * Usage
                              -- $usage

                              -- * Placement actions
                              placeFocused
                            , placeHook

                              -- * Placement policies
                              -- $placements
                            , Placement
                            , smart
                            , simpleSmart
                            , fixed
                            , underMouse
                            , inBounds
                            , withGaps

                              -- * Others
                            , 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)

-- $usage
-- This module provides a 'ManageHook' that automatically places
-- floating windows at appropriate positions on the screen, as well
-- as an 'X' action to manually trigger repositioning.
--
-- You can use this module by including the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Hooks.Place
--
-- and adding 'placeHook' to your 'manageHook', for example:
--
-- > main = xmonad $ def { manageHook = placeHook simpleSmart
-- >                                    <> manageHook def }
--
-- Note that 'placeHook' should be applied after most other hooks, especially hooks
-- such as 'doFloat' and 'doShift'. Since hooks combined with '<>' are applied from
-- right to left, this means that 'placeHook' should be the /first/ hook in your chain.
--
-- You can also define a key to manually trigger repositioning with 'placeFocused' by
-- adding the following to your keys definition:
--
-- > , ((modm, xK_w), placeFocused simpleSmart)
--
-- Both 'placeHook' and 'placeFocused' take a 'Placement' parameter, which specifies
-- the placement policy to use (smart, under the mouse, fixed position, etc.). See
-- 'Placement' for a list of available policies.



{- Placement policies -}

-- $placements
-- Placement policies determine how windows will be placed by 'placeFocused' and 'placeHook'.
--
-- A few examples:
--
-- * Basic smart placement
--
-- > myPlacement = simpleSmart
--
-- * Under the mouse (pointer at the top-left corner), but constrained
--   inside of the screen area
--
-- > myPlacement = inBounds (underMouse (0, 0))
--
-- * Smart placement with a preference for putting windows near
-- the center of the screen, and with 16px gaps at the top and bottom
-- of the screen where no window will be placed
--
-- > myPlacement = withGaps (16,0,16,0) (smart (0.5,0.5))


-- | The type of placement policies
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
(Int -> Placement -> ShowS)
-> (Placement -> String)
-> ([Placement] -> ShowS)
-> Show Placement
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]
(Int -> ReadS Placement)
-> ReadS [Placement]
-> ReadPrec Placement
-> ReadPrec [Placement]
-> Read 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
(Placement -> Placement -> Bool)
-> (Placement -> Placement -> Bool) -> Eq Placement
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)


-- | Try to place windows with as little overlap as possible
smart :: (Rational, Rational) -- ^ Where the window should be placed inside
                              -- the available area. See 'fixed'.
      -> Placement
smart :: (Rational, Rational) -> Placement
smart = (Rational, Rational) -> Placement
Smart

simpleSmart :: Placement
simpleSmart :: Placement
simpleSmart = Placement -> Placement
inBounds (Placement -> Placement) -> Placement -> Placement
forall a b. (a -> b) -> a -> b
$ (Rational, Rational) -> Placement
smart (Rational
0,Rational
0)


-- | Place windows at a fixed position
fixed :: (Rational, Rational) -- ^ Where windows should go.
                              --
                              --     * (0,0) -> top left of the screen
                              --
                              --     * (1,0) -> top right of the screen
                              --
                              --     * etc
      -> Placement
fixed :: (Rational, Rational) -> Placement
fixed = (Rational, Rational) -> Placement
Fixed


-- | Place windows under the mouse
underMouse :: (Rational, Rational) -- ^ Where the pointer should be relative to
                                   -- the window's frame; see 'fixed'.
           -> Placement
underMouse :: (Rational, Rational) -> Placement
underMouse = (Rational, Rational) -> Placement
UnderMouse


-- | Apply the given placement policy, constraining the
-- placed windows inside the screen boundaries.
inBounds :: Placement -> Placement
inBounds :: Placement -> Placement
inBounds = (Dimension, Dimension, Dimension, Dimension)
-> Placement -> Placement
Bounds (Dimension
0,Dimension
0,Dimension
0,Dimension
0)


-- | Same as 'inBounds', but allows specifying gaps along the screen's edges
withGaps :: (Dimension, Dimension, Dimension, Dimension)
         -- ^ top, right, bottom and left gaps
         -> Placement -> Placement
withGaps :: (Dimension, Dimension, Dimension, Dimension)
-> Placement -> Placement
withGaps = (Dimension, Dimension, Dimension, Dimension)
-> Placement -> Placement
Bounds



{- Placement functions -}


-- | Repositions the focused window according to a placement policy. Works for
-- both \"real\" floating windows and windows in a 'WindowArranger'-based
-- layout.
placeFocused :: Placement -> X ()
placeFocused :: Placement -> X ()
placeFocused Placement
p = (Window -> X ()) -> X ()
withFocused ((Window -> X ()) -> X ()) -> (Window -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Window
window -> do
                   (Workspace String (Layout Window) Window, Rectangle)
info <- (XState -> (Workspace String (Layout Window) Window, Rectangle))
-> X (Workspace String (Layout Window) Window, Rectangle)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((XState -> (Workspace String (Layout Window) Window, Rectangle))
 -> X (Workspace String (Layout Window) Window, Rectangle))
-> (XState -> (Workspace String (Layout Window) Window, Rectangle))
-> X (Workspace String (Layout Window) Window, Rectangle)
forall a b. (a -> b) -> a -> b
$ Screen String (Layout Window) Window ScreenId ScreenDetail
-> (Workspace String (Layout Window) Window, Rectangle)
forall i l a sid.
Screen i l a sid ScreenDetail -> (Workspace i l a, Rectangle)
screenInfo (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> (Workspace String (Layout Window) Window, Rectangle))
-> (XState
    -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> (Workspace String (Layout Window) Window, Rectangle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
S.current (StackSet String (Layout Window) Window ScreenId ScreenDetail
 -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> (XState
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset
                   [Window]
floats <- (XState -> [Window]) -> X [Window]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((XState -> [Window]) -> X [Window])
-> (XState -> [Window]) -> X [Window]
forall a b. (a -> b) -> a -> b
$ Map Window RationalRect -> [Window]
forall k a. Map k a -> [k]
M.keys (Map Window RationalRect -> [Window])
-> (XState -> Map Window RationalRect) -> XState -> [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Map Window RationalRect
forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
S.floating (StackSet String (Layout Window) Window ScreenId ScreenDetail
 -> Map Window RationalRect)
-> (XState
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Map Window RationalRect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
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

                     -- use X.A.FloatKeys if the window is floating, send
                     -- a WindowArranger message otherwise.
                   if Window
window Window -> [Window] -> Bool
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 WindowArrangerMsg -> X ()
forall a. Message a => a -> X ()
sendMessage (WindowArrangerMsg -> X ()) -> WindowArrangerMsg -> X ()
forall a b. (a -> b) -> a -> b
$ Rectangle -> WindowArrangerMsg
SetGeometry Rectangle
r'


-- | Hook to automatically place windows when they are created.
placeHook :: Placement -> ManageHook
placeHook :: Placement -> ManageHook
placeHook Placement
p = do Window
window <- Query Window
forall r (m :: * -> *). MonadReader r m => m r
ask
                 Rectangle
r <- ReaderT Window X Rectangle -> Query Rectangle
forall a. ReaderT Window X a -> Query a
Query (ReaderT Window X Rectangle -> Query Rectangle)
-> ReaderT Window X Rectangle -> Query Rectangle
forall a b. (a -> b) -> a -> b
$ X Rectangle -> ReaderT Window X Rectangle
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (X Rectangle -> ReaderT Window X Rectangle)
-> X Rectangle -> ReaderT Window X Rectangle
forall a b. (a -> b) -> a -> b
$ Window -> X Rectangle
getWindowRectangle Window
window
                 Map Window Rectangle
allRs <- ReaderT Window X (Map Window Rectangle)
-> Query (Map Window Rectangle)
forall a. ReaderT Window X a -> Query a
Query (ReaderT Window X (Map Window Rectangle)
 -> Query (Map Window Rectangle))
-> ReaderT Window X (Map Window Rectangle)
-> Query (Map Window Rectangle)
forall a b. (a -> b) -> a -> b
$ X (Map Window Rectangle) -> ReaderT Window X (Map Window Rectangle)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift X (Map Window Rectangle)
getAllRectangles
                 P
pointer <- ReaderT Window X P -> Query P
forall a. ReaderT Window X a -> Query a
Query (ReaderT Window X P -> Query P) -> ReaderT Window X P -> Query P
forall a b. (a -> b) -> a -> b
$ X P -> ReaderT Window X P
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (X P -> ReaderT Window X P) -> X P -> ReaderT Window X P
forall a b. (a -> b) -> a -> b
$ Window -> X P
getPointer Window
window

                 Endo (StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> ManageHook
forall (m :: * -> *) a. Monad m => a -> m a
return (Endo
   (StackSet String (Layout Window) Window ScreenId ScreenDetail)
 -> ManageHook)
-> Endo
     (StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> ManageHook
forall a b. (a -> b) -> a -> b
$ (StackSet String (Layout Window) Window ScreenId ScreenDetail
 -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> Endo
     (StackSet String (Layout Window) Window ScreenId ScreenDetail)
forall a. (a -> a) -> Endo a
Endo ((StackSet String (Layout Window) Window ScreenId ScreenDetail
  -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
 -> Endo
      (StackSet String (Layout Window) Window ScreenId ScreenDetail))
-> (StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> Endo
     (StackSet String (Layout Window) Window ScreenId ScreenDetail)
forall a b. (a -> b) -> a -> b
$ \StackSet String (Layout Window) Window ScreenId ScreenDetail
theWS -> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Maybe
     (StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
forall a. a -> Maybe a -> a
fromMaybe StackSet String (Layout Window) Window ScreenId ScreenDetail
theWS (Maybe
   (StackSet String (Layout Window) Window ScreenId ScreenDetail)
 -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> Maybe
     (StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
forall a b. (a -> b) -> a -> b
$
                   do let currentRect :: Rectangle
currentRect = ScreenDetail -> Rectangle
screenRect (ScreenDetail -> Rectangle) -> ScreenDetail -> Rectangle
forall a b. (a -> b) -> a -> b
$ Screen String (Layout Window) Window ScreenId ScreenDetail
-> ScreenDetail
forall i l a sid sd. Screen i l a sid sd -> sd
S.screenDetail (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> ScreenDetail)
-> Screen String (Layout Window) Window ScreenId ScreenDetail
-> ScreenDetail
forall a b. (a -> b) -> a -> b
$ StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
S.current StackSet String (Layout Window) Window ScreenId ScreenDetail
theWS
                          floats :: [Window]
floats = Map Window RationalRect -> [Window]
forall k a. Map k a -> [k]
M.keys (Map Window RationalRect -> [Window])
-> Map Window RationalRect -> [Window]
forall a b. (a -> b) -> a -> b
$ StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Map Window RationalRect
forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
S.floating StackSet String (Layout Window) Window ScreenId ScreenDetail
theWS

                      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard(Window
window Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
floats )

                        -- Look for the workspace(s) on which the window is to be
                        -- spawned. Each of them also needs an associated screen
                        -- rectangle; for hidden workspaces, we use the current
                        -- workspace's screen.
                      let infos :: [(Workspace String (Layout Window) Window, Rectangle)]
infos = ((Workspace String (Layout Window) Window, Rectangle) -> Bool)
-> [(Workspace String (Layout Window) Window, Rectangle)]
-> [(Workspace String (Layout Window) Window, Rectangle)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Window
window Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) ([Window] -> Bool)
-> ((Workspace String (Layout Window) Window, Rectangle)
    -> [Window])
-> (Workspace String (Layout Window) Window, Rectangle)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Stack Window) -> [Window]
forall w. Maybe (Stack w) -> [w]
stackContents (Maybe (Stack Window) -> [Window])
-> ((Workspace String (Layout Window) Window, Rectangle)
    -> Maybe (Stack Window))
-> (Workspace String (Layout Window) Window, Rectangle)
-> [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace String (Layout Window) Window -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
S.stack (Workspace String (Layout Window) Window -> Maybe (Stack Window))
-> ((Workspace String (Layout Window) Window, Rectangle)
    -> Workspace String (Layout Window) Window)
-> (Workspace String (Layout Window) Window, Rectangle)
-> Maybe (Stack Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Workspace String (Layout Window) Window, Rectangle)
-> Workspace String (Layout Window) Window
forall a b. (a, b) -> a
fst)
                                     ([(Workspace String (Layout Window) Window, Rectangle)]
 -> [(Workspace String (Layout Window) Window, Rectangle)])
-> [(Workspace String (Layout Window) Window, Rectangle)]
-> [(Workspace String (Layout Window) Window, Rectangle)]
forall a b. (a -> b) -> a -> b
$ [Screen String (Layout Window) Window ScreenId ScreenDetail
-> (Workspace String (Layout Window) Window, Rectangle)
forall i l a sid.
Screen i l a sid ScreenDetail -> (Workspace i l a, Rectangle)
screenInfo (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> (Workspace String (Layout Window) Window, Rectangle))
-> Screen String (Layout Window) Window ScreenId ScreenDetail
-> (Workspace String (Layout Window) Window, Rectangle)
forall a b. (a -> b) -> a -> b
$ StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
S.current StackSet String (Layout Window) Window ScreenId ScreenDetail
theWS]
                                        [(Workspace String (Layout Window) Window, Rectangle)]
-> [(Workspace String (Layout Window) Window, Rectangle)]
-> [(Workspace String (Layout Window) Window, Rectangle)]
forall a. [a] -> [a] -> [a]
++ (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> (Workspace String (Layout Window) Window, Rectangle))
-> [Screen String (Layout Window) Window ScreenId ScreenDetail]
-> [(Workspace String (Layout Window) Window, Rectangle)]
forall a b. (a -> b) -> [a] -> [b]
map Screen String (Layout Window) Window ScreenId ScreenDetail
-> (Workspace String (Layout Window) Window, Rectangle)
forall i l a sid.
Screen i l a sid ScreenDetail -> (Workspace i l a, Rectangle)
screenInfo (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> [Screen String (Layout Window) Window ScreenId ScreenDetail]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
S.visible StackSet String (Layout Window) Window ScreenId ScreenDetail
theWS)
                                        [(Workspace String (Layout Window) Window, Rectangle)]
-> [(Workspace String (Layout Window) Window, Rectangle)]
-> [(Workspace String (Layout Window) Window, Rectangle)]
forall a. [a] -> [a] -> [a]
++ [Workspace String (Layout Window) Window]
-> [Rectangle]
-> [(Workspace String (Layout Window) Window, Rectangle)]
forall a b. [a] -> [b] -> [(a, b)]
zip (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> [Workspace String (Layout Window) Window]
forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
S.hidden StackSet String (Layout Window) Window ScreenId ScreenDetail
theWS) (Rectangle -> [Rectangle]
forall a. a -> [a]
repeat Rectangle
currentRect)

                      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard(Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Workspace String (Layout Window) Window, Rectangle)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Workspace String (Layout Window) Window, Rectangle)]
infos)

                      let (Workspace String (Layout Window) Window
workspace, Rectangle
screen) = [(Workspace String (Layout Window) Window, Rectangle)]
-> (Workspace String (Layout Window) Window, Rectangle)
forall a. [a] -> a
head [(Workspace String (Layout Window) Window, Rectangle)]
infos
                          rs :: [Rectangle]
rs = (Window -> Maybe Rectangle) -> [Window] -> [Rectangle]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Window -> Map Window Rectangle -> Maybe Rectangle
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map Window Rectangle
allRs)
                               ([Window] -> [Rectangle]) -> [Window] -> [Rectangle]
forall a b. (a -> b) -> a -> b
$ Workspace String (Layout Window) Window
-> Window -> [Window] -> [Window]
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 = Window
-> RationalRect
-> Map Window RationalRect
-> Map Window RationalRect
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Window
window RationalRect
newRect (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Map Window RationalRect
forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
S.floating StackSet String (Layout Window) Window ScreenId ScreenDetail
theWS)

                      StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Maybe
     (StackSet String (Layout Window) Window ScreenId ScreenDetail)
forall (m :: * -> *) a. Monad m => a -> m a
return (StackSet String (Layout Window) Window ScreenId ScreenDetail
 -> Maybe
      (StackSet String (Layout Window) Window ScreenId ScreenDetail))
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Maybe
     (StackSet String (Layout Window) Window ScreenId ScreenDetail)
forall a b. (a -> b) -> a -> b
$ StackSet String (Layout Window) Window ScreenId ScreenDetail
theWS { floating :: Map Window RationalRect
S.floating = Map Window RationalRect
newFloats }


placeWindow :: Placement -> Window
            -> (S.Workspace WorkspaceId (Layout Window) Window, Rectangle)
                 -- ^ The workspace with reference to which the window should be placed,
                 -- and the screen's geometry.
            -> [Window]
                 -- ^ The list of floating windows.
            -> 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
       Rectangle -> X Rectangle
forall (m :: * -> *) a. Monad m => a -> m a
return (Rectangle -> X Rectangle) -> Rectangle -> X Rectangle
forall a b. (a -> b) -> a -> b
$ Placement
-> Rectangle -> [Rectangle] -> P -> Rectangle -> Rectangle
purePlaceWindow Placement
p Rectangle
s [Rectangle]
rs P
pointer Rectangle
r


-- | Compute the new position of a window according to a placement policy.
purePlaceWindow :: Placement -- ^ The placement strategy
                -> Rectangle -- ^ The screen
                -> [Rectangle] -- ^ The other visible windows
                -> (Position, Position) -- ^ The pointer's position.
                -> Rectangle -- ^ The window to be placed
                -> 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 Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
l) (Position
sy Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
t) (Dimension
sw Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
l Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
r) (Dimension
sh Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
t Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
b)
    in Rectangle -> Rectangle -> Rectangle
checkBounds Rectangle
s' (Rectangle -> Rectangle) -> Rectangle -> Rectangle
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 Position -> Position -> Position
forall a. Num a => a -> a -> a
- Rational -> Position
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Rational
rx Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Dimension -> Rational
forall a b. (Integral a, Num b) => a -> b
fi Dimension
w)) (Position
py Position -> Position -> Position
forall a. Num a => a -> a -> a
- Rational -> Position
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Rational
ry Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Dimension -> Rational
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)


-- | Helper: Places a Rectangle at a fixed position indicated by two Rationals
-- inside another,
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 (Rational -> Position -> Position -> Position
forall a b. (RealFrac a, Integral b) => a -> b -> b -> b
scale Rational
rx Position
x1 (Position
x1 Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
w1 Position -> Position -> Position
forall a. Num a => a -> a -> a
- Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
w2))
              (Rational -> Position -> Position -> Position
forall a b. (RealFrac a, Integral b) => a -> b -> b -> b
scale Rational
ry Position
y1 (Position
y1 Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
h1 Position -> Position -> Position
forall a. Num a => a -> a -> a
- Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
h2))
              Dimension
w2 Dimension
h2


-- | Helper: Ensures its second parameter is contained inside the first
-- by possibly moving it.
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 (Position -> Position -> Position
forall a. Ord a => a -> a -> a
max Position
x1 (Position -> Position -> Position
forall a. Ord a => a -> a -> a
min (Position
x1 Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
w1 Position -> Position -> Position
forall a. Num a => a -> a -> a
- Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
w2) Position
x2))
              (Position -> Position -> Position
forall a. Ord a => a -> a -> a
max Position
y1 (Position -> Position -> Position
forall a. Ord a => a -> a -> a
min (Position
y1 Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
h1 Position -> Position -> Position
forall a. Num a => a -> a -> a
- Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
h2) Position
y2))
              Dimension
w2 Dimension
h2





{- Utilities -}

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 = a -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
r a -> a -> a
forall a. Num a => a -> a -> a
* b -> a
forall a b. (Integral a, Num b) => a -> b
fi b
n2 a -> a -> a
forall a. Num a => a -> a -> a
+ (a
1 a -> a -> a
forall a. Num a => a -> a -> a
- a
r) a -> a -> a
forall a. Num a => a -> a -> a
* b -> 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 ((Position -> Integer
forall a b. (Integral a, Num b) => a -> b
fi Position
xInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Position -> Integer
forall a b. (Integral a, Num b) => a -> b
fi Position
x0) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Dimension -> Integer
forall a b. (Integral a, Num b) => a -> b
fi Dimension
w0)
                   ((Position -> Integer
forall a b. (Integral a, Num b) => a -> b
fi Position
yInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Position -> Integer
forall a b. (Integral a, Num b) => a -> b
fi Position
y0) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Dimension -> Integer
forall a b. (Integral a, Num b) => a -> b
fi Dimension
h0)
                   (Dimension -> Integer
forall a b. (Integral a, Num b) => a -> b
fi Dimension
w Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Dimension -> Integer
forall a b. (Integral a, Num b) => a -> b
fi Dimension
w0)
                   (Dimension -> Integer
forall a b. (Integral a, Num b) => a -> b
fi Dimension
h Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Dimension -> Integer
forall a b. (Integral a, Num b) => a -> b
fi Dimension
h0)



{- Querying stuff -}

stackContents :: Maybe (S.Stack w) -> [w]
stackContents :: forall w. Maybe (Stack w) -> [w]
stackContents = [w] -> (Stack w -> [w]) -> Maybe (Stack w) -> [w]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Stack w -> [w]
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 <- (XConf -> Display) -> X Display
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
_) <- IO
  (Window, Position, Position, Dimension, Dimension, Dimension, CInt)
-> X (Window, Position, Position, Dimension, Dimension, Dimension,
      CInt)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO
   (Window, Position, Position, Dimension, Dimension, Dimension, CInt)
 -> X (Window, Position, Position, Dimension, Dimension, Dimension,
       CInt))
-> IO
     (Window, Position, Position, Dimension, Dimension, Dimension, CInt)
-> X (Window, Position, Position, Dimension, Dimension, Dimension,
      CInt)
forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> IO
     (Window, Position, Position, Dimension, Dimension, Dimension, CInt)
getGeometry Display
d Window
window

         -- We can't use the border width returned by
         -- getGeometry because it will be 0 if the
         -- window isn't mapped yet.
       Dimension
b <- (XConf -> Dimension) -> X Dimension
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((XConf -> Dimension) -> X Dimension)
-> (XConf -> Dimension) -> X Dimension
forall a b. (a -> b) -> a -> b
$ XConfig Layout -> Dimension
forall (l :: * -> *). XConfig l -> Dimension
borderWidth (XConfig Layout -> Dimension)
-> (XConf -> XConfig Layout) -> XConf -> Dimension
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config

       Rectangle -> X Rectangle
forall (m :: * -> *) a. Monad m => a -> m a
return (Rectangle -> X Rectangle) -> Rectangle -> X Rectangle
forall a b. (a -> b) -> a -> b
$ Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y (Dimension
w Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
+ Dimension
2Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
*Dimension
b) (Dimension
h Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
+ Dimension
2Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
*Dimension
b)

getAllRectangles :: X (M.Map Window Rectangle)
getAllRectangles :: X (Map Window Rectangle)
getAllRectangles = do StackSet String (Layout Window) Window ScreenId ScreenDetail
ws <- (XState
 -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X (StackSet String (Layout Window) Window ScreenId ScreenDetail)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset
                      let allWindows :: [Window]
allWindows = [[Window]] -> [Window]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Window]] -> [Window]) -> [[Window]] -> [Window]
forall a b. (a -> b) -> a -> b
$ (Workspace String (Layout Window) Window -> [Window])
-> [Workspace String (Layout Window) Window] -> [[Window]]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe (Stack Window) -> [Window]
forall w. Maybe (Stack w) -> [w]
stackContents (Maybe (Stack Window) -> [Window])
-> (Workspace String (Layout Window) Window
    -> Maybe (Stack Window))
-> Workspace String (Layout Window) Window
-> [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace String (Layout Window) Window -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
S.stack)
                                         ([Workspace String (Layout Window) Window] -> [[Window]])
-> [Workspace String (Layout Window) Window] -> [[Window]]
forall a b. (a -> b) -> a -> b
$ (Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
S.workspace (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> Workspace String (Layout Window) Window)
-> (StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
S.current) StackSet String (Layout Window) Window ScreenId ScreenDetail
ws
                                         Workspace String (Layout Window) Window
-> [Workspace String (Layout Window) Window]
-> [Workspace String (Layout Window) Window]
forall a. a -> [a] -> [a]
: ((Screen String (Layout Window) Window ScreenId ScreenDetail
 -> Workspace String (Layout Window) Window)
-> [Screen String (Layout Window) Window ScreenId ScreenDetail]
-> [Workspace String (Layout Window) Window]
forall a b. (a -> b) -> [a] -> [b]
map Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
S.workspace ([Screen String (Layout Window) Window ScreenId ScreenDetail]
 -> [Workspace String (Layout Window) Window])
-> (StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> [Screen String (Layout Window) Window ScreenId ScreenDetail])
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> [Workspace String (Layout Window) Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet String (Layout Window) Window ScreenId ScreenDetail
-> [Screen String (Layout Window) Window ScreenId ScreenDetail]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
S.visible) StackSet String (Layout Window) Window ScreenId ScreenDetail
ws
                                         [Workspace String (Layout Window) Window]
-> [Workspace String (Layout Window) Window]
-> [Workspace String (Layout Window) Window]
forall a. [a] -> [a] -> [a]
++ StackSet String (Layout Window) Window ScreenId ScreenDetail
-> [Workspace String (Layout Window) Window]
forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
S.hidden StackSet String (Layout Window) Window ScreenId ScreenDetail
ws
                      [Rectangle]
allRects <- (Window -> X Rectangle) -> [Window] -> X [Rectangle]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Window -> X Rectangle
getWindowRectangle [Window]
allWindows

                      Map Window Rectangle -> X (Map Window Rectangle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Window Rectangle -> X (Map Window Rectangle))
-> Map Window Rectangle -> X (Map Window Rectangle)
forall a b. (a -> b) -> a -> b
$ [(Window, Rectangle)] -> Map Window Rectangle
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Window, Rectangle)] -> Map Window Rectangle)
-> [(Window, Rectangle)] -> Map Window Rectangle
forall a b. (a -> b) -> a -> b
$ [Window] -> [Rectangle] -> [(Window, Rectangle)]
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) = (Window -> Bool) -> [Window] -> ([Window], [Window])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
floats) ([Window] -> ([Window], [Window]))
-> [Window] -> ([Window], [Window])
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] -> [Window]) -> [Window] -> [Window]
forall a b. (a -> b) -> a -> b
$ Maybe (Stack Window) -> [Window]
forall w. Maybe (Stack w) -> [w]
stackContents (Maybe (Stack Window) -> [Window])
-> Maybe (Stack Window) -> [Window]
forall a b. (a -> b) -> a -> b
$ Workspace a b Window -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
S.stack Workspace a b Window
ws
    in [Window] -> [Window]
forall a. [a] -> [a]
reverse [Window]
layoutCs [Window] -> [Window] -> [Window]
forall a. [a] -> [a] -> [a]
++ [Window] -> [Window]
forall a. [a] -> [a]
reverse [Window]
floatCs
      -- About the ordering: the smart algorithm will overlap windows
      -- starting ith the head of the list. So:
      --  - we put the non-floating windows first since they'll
      --    probably be below the floating ones,
      --  - we reverse the lists, since the newer/more important
      --    windows are usually near the head.

getPointer :: Window -> X (Position, Position)
getPointer :: Window -> X P
getPointer Window
window = do Display
d <- (XConf -> Display) -> X Display
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
_) <- 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
window
                       P -> X P
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fi CInt
x,CInt -> Position
forall a b. (Integral a, Num b) => a -> b
fi CInt
y)

-- | Return values are, in order: window's rectangle,
-- other windows' rectangles and pointer's coordinates.
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 <- (Window -> X Rectangle) -> [Window] -> X [Rectangle]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Window -> X Rectangle
getWindowRectangle (Workspace String (Layout Window) Window
-> Window -> [Window] -> [Window]
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

       (Rectangle, [Rectangle], P) -> X (Rectangle, [Rectangle], P)
forall (m :: * -> *) a. Monad m => a -> m a
return (Rectangle
r, [Rectangle]
rs, P
pointer)




{- Smart placement algorithm -}

-- | Alternate representation for rectangles.
data SmartRectangle a = SR
  { forall a. SmartRectangle a -> a
sr_x0, forall a. SmartRectangle a -> a
sr_y0 :: a -- ^ Top left coordinates, inclusive
  , forall a. SmartRectangle a -> a
sr_x1, forall a. SmartRectangle a -> a
sr_y1 :: a -- ^ Bottom right coorsinates, exclusive
  } deriving (Int -> SmartRectangle a -> ShowS
[SmartRectangle a] -> ShowS
SmartRectangle a -> String
(Int -> SmartRectangle a -> ShowS)
-> (SmartRectangle a -> String)
-> ([SmartRectangle a] -> ShowS)
-> Show (SmartRectangle a)
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
(SmartRectangle a -> SmartRectangle a -> Bool)
-> (SmartRectangle a -> SmartRectangle a -> Bool)
-> Eq (SmartRectangle a)
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) = Position
-> Position -> Position -> Position -> SmartRectangle Position
forall a. a -> a -> a -> a -> SmartRectangle a
SR Position
x Position
y (Position
x Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
w) (Position
y Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
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 (Position -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi (Position -> Dimension) -> Position -> Dimension
forall a b. (a -> b) -> a -> b
$ Position
x1 Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
x0) (Position -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi (Position -> Dimension) -> Position -> Dimension
forall a b. (a -> b) -> a -> b
$ Position
y1 Position -> Position -> Position
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 = SmartRectangle a -> a
forall a. SmartRectangle a -> a
sr_x1 SmartRectangle a
r a -> a -> a
forall a. Num a => a -> a -> a
- SmartRectangle 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 = SmartRectangle a -> a
forall a. SmartRectangle a -> a
sr_y1 SmartRectangle a
r a -> a -> a
forall a. Num a => a -> a -> a
- SmartRectangle 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 = (SmartRectangle a -> a
forall a. Num a => SmartRectangle a -> a
width SmartRectangle a
r a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0) Bool -> Bool -> Bool
|| (SmartRectangle a -> a
forall a. Num a => SmartRectangle a -> a
height SmartRectangle a
r a -> a -> Bool
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 = SmartRectangle a -> a
forall a. SmartRectangle a -> a
sr_x0 SmartRectangle a
r1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= SmartRectangle a -> a
forall a. SmartRectangle a -> a
sr_x0 SmartRectangle a
r2
                 Bool -> Bool -> Bool
&& SmartRectangle a -> a
forall a. SmartRectangle a -> a
sr_y0 SmartRectangle a
r1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= SmartRectangle a -> a
forall a. SmartRectangle a -> a
sr_y0 SmartRectangle a
r2
                 Bool -> Bool -> Bool
&& SmartRectangle a -> a
forall a. SmartRectangle a -> a
sr_x1 SmartRectangle a
r1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= SmartRectangle a -> a
forall a. SmartRectangle a -> a
sr_x1 SmartRectangle a
r2
                 Bool -> Bool -> Bool
&& SmartRectangle a -> a
forall a. SmartRectangle a -> a
sr_y1 SmartRectangle a
r1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= SmartRectangle a -> a
forall a. SmartRectangle a -> a
sr_y1 SmartRectangle a
r2


-- | Main placement function
placeSmart :: (Rational, Rational) -- ^ point of the screen where windows
                                   -- should be placed first, if possible.
           -> Rectangle -- ^ screen
           -> [Rectangle] -- ^ other clients
           -> Dimension -- ^ width
           -> Dimension -- ^ height
           -> 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 = (SmartRectangle Position -> Rectangle)
-> [SmartRectangle Position] -> [Rectangle]
forall a b. (a -> b) -> [a] -> [b]
map SmartRectangle Position -> Rectangle
sr2r ([SmartRectangle Position] -> [Rectangle])
-> [SmartRectangle Position] -> [Rectangle]
forall a b. (a -> b) -> a -> b
$ SmartRectangle Position
-> [SmartRectangle Position]
-> Position
-> Position
-> [SmartRectangle Position]
forall a.
Real a =>
SmartRectangle a
-> [SmartRectangle a] -> a -> a -> [SmartRectangle a]
findSpace (Rectangle -> SmartRectangle Position
r2sr Rectangle
s) ((Rectangle -> SmartRectangle Position)
-> [Rectangle] -> [SmartRectangle Position]
forall a b. (a -> b) -> [a] -> [b]
map Rectangle -> SmartRectangle Position
r2sr [Rectangle]
rs) (Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
w) (Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
h)
    in [Rectangle]
-> Position -> Position -> Dimension -> Dimension -> Rectangle
position [Rectangle]
free (Rational -> Position -> Position -> Position
forall a b. (RealFrac a, Integral b) => a -> b -> b -> b
scale Rational
rx Position
sx (Position
sx Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
sw Position -> Position -> Position
forall a. Num a => a -> a -> a
- Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
w))
                     (Rational -> Position -> Position -> Position
forall a b. (RealFrac a, Integral b) => a -> b -> b -> b
scale Rational
ry Position
sy (Position
sy Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
sh Position -> Position -> Position
forall a. Num a => a -> a -> a
- Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
h))
                     Dimension
w Dimension
h

-- | Second part of the algorithm:
-- Chooses the best position in which to place a window,
-- according to a list of free areas and an ideal position for
-- the top-left corner.
-- We can't use semi-open surfaces for this, so we go back to
-- X11 Rectangles/Positions/etc instead.
position :: [Rectangle] -- ^ Free areas
         -> Position -> Position -- ^ Ideal coordinates
         -> Dimension -> Dimension -- ^ Width and height of the window
         -> Rectangle
position :: [Rectangle]
-> Position -> Position -> Dimension -> Dimension -> Rectangle
position [Rectangle]
rs Position
x Position
y Dimension
w Dimension
h = (Rectangle -> Rectangle -> Ordering) -> [Rectangle] -> Rectangle
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy Rectangle -> Rectangle -> Ordering
distanceOrder ([Rectangle] -> Rectangle) -> [Rectangle] -> Rectangle
forall a b. (a -> b) -> a -> b
$ (Rectangle -> Rectangle) -> [Rectangle] -> [Rectangle]
forall a b. (a -> b) -> [a] -> [b]
map Rectangle -> Rectangle
closest [Rectangle]
rs
  where distanceOrder :: Rectangle -> Rectangle -> Ordering
distanceOrder Rectangle
r1 Rectangle
r2
          = Dimension -> Dimension -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (P -> P -> Dimension
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)
                    (P -> P -> 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) = Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double -> b) -> Double -> b
forall a b. (a -> b) -> a -> b
$ (Double -> Double
forall a. Floating a => a -> a
sqrt :: Double -> Double)
                                   (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ a -> Double
forall a b. (Integral a, Num b) => a -> b
fi (a -> Double) -> a -> Double
forall a b. (a -> b) -> a -> b
$ (a
x1 a -> a -> a
forall a. Num a => a -> a -> a
- a
x2)a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
2::Int)
                                        a -> a -> a
forall a. Num a => a -> a -> a
+ (a
y1 a -> a -> a
forall a. Num a => a -> a -> a
- a
y2)a -> Int -> a
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)


-- | First part of the algorithm:
-- Tries to find an area in which to place a new
-- rectangle so that it overlaps as little as possible with
-- other rectangles already present. The first rectangles in
-- the list will be overlapped first.
findSpace :: Real a =>
             SmartRectangle a -- ^ The total available area
          -> [SmartRectangle a] -- ^ The parts already in use
          -> a -- ^ Width of the rectangle to place
          -> a -- ^ Height of the rectangle to place
          -> [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 (SmartRectangle a -> Bool)
-> [SmartRectangle a] -> [SmartRectangle a]
forall a. (a -> Bool) -> [a] -> [a]
filter SmartRectangle a -> Bool
largeEnough ([SmartRectangle a] -> [SmartRectangle a])
-> [SmartRectangle a] -> [SmartRectangle a]
forall a b. (a -> b) -> a -> b
$ [SmartRectangle a] -> [SmartRectangle a]
forall a. Real a => [SmartRectangle a] -> [SmartRectangle a]
cleanup ([SmartRectangle a] -> [SmartRectangle a])
-> [SmartRectangle a] -> [SmartRectangle a]
forall a b. (a -> b) -> a -> b
$ SmartRectangle a -> [SmartRectangle a] -> [SmartRectangle a]
forall a.
Real a =>
SmartRectangle a -> [SmartRectangle a] -> [SmartRectangle a]
subtractRects SmartRectangle a
total [SmartRectangle a]
rs of
      [] -> SmartRectangle a
-> [SmartRectangle a] -> a -> a -> [SmartRectangle a]
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 = SmartRectangle a -> a
forall a. Num a => SmartRectangle a -> a
width SmartRectangle a
r a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
w Bool -> Bool -> Bool
&& SmartRectangle a -> a
forall a. Num a => SmartRectangle a -> a
height SmartRectangle a
r a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
h


-- | Subtracts smaller rectangles from a total rectangle
-- , returning a list of remaining rectangular areas.
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' <- SmartRectangle a -> [SmartRectangle a] -> [SmartRectangle a]
forall a.
Real a =>
SmartRectangle a -> [SmartRectangle a] -> [SmartRectangle a]
subtractRects SmartRectangle a
total [SmartRectangle a]
rs
       (SmartRectangle a -> Bool)
-> [SmartRectangle a] -> [SmartRectangle a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (SmartRectangle a -> Bool) -> SmartRectangle a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SmartRectangle a -> Bool
forall a. Real a => SmartRectangle a -> Bool
isEmpty)
                [ SmartRectangle a
total' {sr_y1 :: a
sr_y1 = a -> a -> a
forall a. Ord a => a -> a -> a
min (SmartRectangle a -> a
forall a. SmartRectangle a -> a
sr_y1 SmartRectangle a
total') (SmartRectangle a -> a
forall a. SmartRectangle a -> a
sr_y0 SmartRectangle a
r)} -- Above
                , SmartRectangle a
total' {sr_x0 :: a
sr_x0 = a -> a -> a
forall a. Ord a => a -> a -> a
max (SmartRectangle a -> a
forall a. SmartRectangle a -> a
sr_x0 SmartRectangle a
total') (SmartRectangle a -> a
forall a. SmartRectangle a -> a
sr_x1 SmartRectangle a
r)} -- Right
                , SmartRectangle a
total' {sr_y0 :: a
sr_y0 = a -> a -> a
forall a. Ord a => a -> a -> a
max (SmartRectangle a -> a
forall a. SmartRectangle a -> a
sr_y0 SmartRectangle a
total') (SmartRectangle a -> a
forall a. SmartRectangle a -> a
sr_y1 SmartRectangle a
r)} -- Below
                , SmartRectangle a
total' {sr_x1 :: a
sr_x1 = a -> a -> a
forall a. Ord a => a -> a -> a
min (SmartRectangle a -> a
forall a. SmartRectangle a -> a
sr_x1 SmartRectangle a
total') (SmartRectangle a -> a
forall a. SmartRectangle a -> a
sr_x0 SmartRectangle a
r)} -- Left
                ]


-- | "Nubs" a list of rectangles, dropping all those that are
-- already contained in another rectangle of the list.
cleanup :: Real a => [SmartRectangle a] -> [SmartRectangle a]
cleanup :: forall a. Real a => [SmartRectangle a] -> [SmartRectangle a]
cleanup [SmartRectangle a]
rs = (SmartRectangle a -> [SmartRectangle a] -> [SmartRectangle a])
-> [SmartRectangle a] -> [SmartRectangle a] -> [SmartRectangle a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr SmartRectangle a -> [SmartRectangle a] -> [SmartRectangle a]
forall a.
Real a =>
SmartRectangle a -> [SmartRectangle a] -> [SmartRectangle a]
dropIfContained [] ([SmartRectangle a] -> [SmartRectangle a])
-> [SmartRectangle a] -> [SmartRectangle a]
forall a b. (a -> b) -> a -> b
$ (SmartRectangle a -> SmartRectangle a -> Ordering)
-> [SmartRectangle a] -> [SmartRectangle a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy SmartRectangle a -> SmartRectangle a -> Ordering
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 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
w2 = Ordering
LT
                | a
w1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
w2 Bool -> Bool -> Bool
&& a
h1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
h2 = Ordering
LT
                | a
w1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
w2 Bool -> Bool -> Bool
&& a
h1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
h2 = Ordering
EQ
                | Bool
otherwise = Ordering
GT
                where w1 :: a
w1 = SmartRectangle a -> a
forall a. Num a => SmartRectangle a -> a
width SmartRectangle a
r1
                      w2 :: a
w2 = SmartRectangle a -> a
forall a. Num a => SmartRectangle a -> a
width SmartRectangle a
r2
                      h1 :: a
h1 = SmartRectangle a -> a
forall a. Num a => SmartRectangle a -> a
height SmartRectangle a
r1
                      h2 :: a
h2 = SmartRectangle a -> a
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 (SmartRectangle a -> Bool) -> [SmartRectangle a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (SmartRectangle a -> SmartRectangle a -> Bool
forall a. Real a => SmartRectangle a -> SmartRectangle a -> Bool
`contains` SmartRectangle a
r) [SmartRectangle a]
rs
                        then [SmartRectangle a]
rs
                        else SmartRectangle a
rSmartRectangle a -> [SmartRectangle a] -> [SmartRectangle a]
forall a. a -> [a] -> [a]
:[SmartRectangle a]
rs