{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.HintedTile
-- Description :  A gapless tiled layout that obeys window size hints.
-- Copyright   :  (c) Peter De Wachter <pdewacht@gmail.com>
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Peter De Wachter <pdewacht@gmail.com>
--                Andrea Rossato <andrea.rossato@unibz.it>
-- Stability   :  unstable
-- Portability :  unportable
--
-- A gapless tiled layout that attempts to obey window size hints,
-- rather than simply ignoring them.
--
-----------------------------------------------------------------------------

module XMonad.Layout.HintedTile (
    -- * Usage
    -- $usage
    HintedTile(..), Orientation(..), Alignment(..)
) where

import XMonad hiding (Tall(..))
import qualified XMonad.StackSet as W
import XMonad.Prelude

-- $usage
-- You can use this module with the following in your @xmonad.hs@:
--
-- > import XMonad.Layout.HintedTile
--
-- Then edit your @layoutHook@ by adding the HintedTile layout:
--
-- > myLayout = hintedTile Tall ||| hintedTile Wide ||| Full ||| etc..
-- >   where
-- >      hintedTile = HintedTile nmaster delta ratio TopLeft
-- >      nmaster    = 1
-- >      ratio      = 1/2
-- >      delta      = 3/100
-- > main = xmonad def { layoutHook = myLayout }
--
-- Because both Xmonad and Xmonad.Layout.HintedTile define Tall,
-- you need to disambiguate Tall. If you are replacing the
-- built-in Tall with HintedTile, change @import Xmonad@ to
-- @import Xmonad hiding (Tall)@.
--
-- For more detailed instructions on editing the layoutHook see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and
-- "XMonad.Doc.Extending#Editing_the_layout_hook".

data HintedTile a = HintedTile
    { forall a. HintedTile a -> Int
nmaster     :: !Int         -- ^ number of windows in the master pane
    , forall a. HintedTile a -> Rational
delta       :: !Rational    -- ^ how much to change when resizing
    , forall a. HintedTile a -> Rational
frac        :: !Rational    -- ^ ratio between master/nonmaster panes
    , forall a. HintedTile a -> Alignment
alignment   :: !Alignment   -- ^ Where to place windows that are smaller
                                  --   than their preordained rectangles.
    , forall a. HintedTile a -> Orientation
orientation :: !Orientation -- ^ Tall or Wide (mirrored) layout?
    } deriving ( Int -> HintedTile a -> ShowS
forall a. Int -> HintedTile a -> ShowS
forall a. [HintedTile a] -> ShowS
forall a. HintedTile a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HintedTile a] -> ShowS
$cshowList :: forall a. [HintedTile a] -> ShowS
show :: HintedTile a -> String
$cshow :: forall a. HintedTile a -> String
showsPrec :: Int -> HintedTile a -> ShowS
$cshowsPrec :: forall a. Int -> HintedTile a -> ShowS
Show, ReadPrec [HintedTile a]
ReadPrec (HintedTile a)
ReadS [HintedTile a]
forall a. ReadPrec [HintedTile a]
forall a. ReadPrec (HintedTile a)
forall a. Int -> ReadS (HintedTile a)
forall a. ReadS [HintedTile a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HintedTile a]
$creadListPrec :: forall a. ReadPrec [HintedTile a]
readPrec :: ReadPrec (HintedTile a)
$creadPrec :: forall a. ReadPrec (HintedTile a)
readList :: ReadS [HintedTile a]
$creadList :: forall a. ReadS [HintedTile a]
readsPrec :: Int -> ReadS (HintedTile a)
$creadsPrec :: forall a. Int -> ReadS (HintedTile a)
Read )

data Orientation
     = Wide -- ^ Lay out windows similarly to Mirror tiled.
     | Tall -- ^ Lay out windows similarly to tiled.
    deriving ( Int -> Orientation -> ShowS
[Orientation] -> ShowS
Orientation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Orientation] -> ShowS
$cshowList :: [Orientation] -> ShowS
show :: Orientation -> String
$cshow :: Orientation -> String
showsPrec :: Int -> Orientation -> ShowS
$cshowsPrec :: Int -> Orientation -> ShowS
Show, ReadPrec [Orientation]
ReadPrec Orientation
Int -> ReadS Orientation
ReadS [Orientation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Orientation]
$creadListPrec :: ReadPrec [Orientation]
readPrec :: ReadPrec Orientation
$creadPrec :: ReadPrec Orientation
readList :: ReadS [Orientation]
$creadList :: ReadS [Orientation]
readsPrec :: Int -> ReadS Orientation
$creadsPrec :: Int -> ReadS Orientation
Read, Orientation -> Orientation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Orientation -> Orientation -> Bool
$c/= :: Orientation -> Orientation -> Bool
== :: Orientation -> Orientation -> Bool
$c== :: Orientation -> Orientation -> Bool
Eq, Eq Orientation
Orientation -> Orientation -> Bool
Orientation -> Orientation -> Ordering
Orientation -> Orientation -> Orientation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Orientation -> Orientation -> Orientation
$cmin :: Orientation -> Orientation -> Orientation
max :: Orientation -> Orientation -> Orientation
$cmax :: Orientation -> Orientation -> Orientation
>= :: Orientation -> Orientation -> Bool
$c>= :: Orientation -> Orientation -> Bool
> :: Orientation -> Orientation -> Bool
$c> :: Orientation -> Orientation -> Bool
<= :: Orientation -> Orientation -> Bool
$c<= :: Orientation -> Orientation -> Bool
< :: Orientation -> Orientation -> Bool
$c< :: Orientation -> Orientation -> Bool
compare :: Orientation -> Orientation -> Ordering
$ccompare :: Orientation -> Orientation -> Ordering
Ord )

data Alignment = TopLeft | Center | BottomRight
    deriving ( Int -> Alignment -> ShowS
[Alignment] -> ShowS
Alignment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Alignment] -> ShowS
$cshowList :: [Alignment] -> ShowS
show :: Alignment -> String
$cshow :: Alignment -> String
showsPrec :: Int -> Alignment -> ShowS
$cshowsPrec :: Int -> Alignment -> ShowS
Show, ReadPrec [Alignment]
ReadPrec Alignment
Int -> ReadS Alignment
ReadS [Alignment]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Alignment]
$creadListPrec :: ReadPrec [Alignment]
readPrec :: ReadPrec Alignment
$creadPrec :: ReadPrec Alignment
readList :: ReadS [Alignment]
$creadList :: ReadS [Alignment]
readsPrec :: Int -> ReadS Alignment
$creadsPrec :: Int -> ReadS Alignment
Read, Alignment -> Alignment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Alignment -> Alignment -> Bool
$c/= :: Alignment -> Alignment -> Bool
== :: Alignment -> Alignment -> Bool
$c== :: Alignment -> Alignment -> Bool
Eq, Eq Alignment
Alignment -> Alignment -> Bool
Alignment -> Alignment -> Ordering
Alignment -> Alignment -> Alignment
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Alignment -> Alignment -> Alignment
$cmin :: Alignment -> Alignment -> Alignment
max :: Alignment -> Alignment -> Alignment
$cmax :: Alignment -> Alignment -> Alignment
>= :: Alignment -> Alignment -> Bool
$c>= :: Alignment -> Alignment -> Bool
> :: Alignment -> Alignment -> Bool
$c> :: Alignment -> Alignment -> Bool
<= :: Alignment -> Alignment -> Bool
$c<= :: Alignment -> Alignment -> Bool
< :: Alignment -> Alignment -> Bool
$c< :: Alignment -> Alignment -> Bool
compare :: Alignment -> Alignment -> Ordering
$ccompare :: Alignment -> Alignment -> Ordering
Ord )

instance LayoutClass HintedTile Window where
    doLayout :: HintedTile Window
-> Rectangle
-> Stack Window
-> X ([(Window, Rectangle)], Maybe (HintedTile Window))
doLayout HintedTile{ orientation :: forall a. HintedTile a -> Orientation
orientation = Orientation
o, nmaster :: forall a. HintedTile a -> Int
nmaster = Int
nm, frac :: forall a. HintedTile a -> Rational
frac = Rational
f, alignment :: forall a. HintedTile a -> Alignment
alignment = Alignment
al } Rectangle
r Stack Window
w' = do
        [D -> D]
bhs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Window -> X (D -> D)
mkAdjust [Window]
w
        let ([D -> D]
masters, [D -> D]
slaves) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
nm [D -> D]
bhs
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. [a] -> [b] -> [(a, b)]
zip [Window]
w ([D -> D] -> [D -> D] -> [Rectangle]
tiler [D -> D]
masters [D -> D]
slaves), forall a. Maybe a
Nothing)
     where
        w :: [Window]
w = forall a. Stack a -> [a]
W.integrate Stack Window
w'
        tiler :: [D -> D] -> [D -> D] -> [Rectangle]
tiler [D -> D]
masters [D -> D]
slaves
            | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [D -> D]
masters Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [D -> D]
slaves = Alignment -> Orientation -> [D -> D] -> Rectangle -> [Rectangle]
divide Alignment
al Orientation
o ([D -> D]
masters forall a. [a] -> [a] -> [a]
++ [D -> D]
slaves) Rectangle
r
            | Bool
otherwise = Orientation
-> Rational
-> Rectangle
-> (Rectangle -> [Rectangle])
-> (Rectangle -> [Rectangle])
-> [Rectangle]
split Orientation
o Rational
f Rectangle
r (Alignment -> Orientation -> [D -> D] -> Rectangle -> [Rectangle]
divide Alignment
al Orientation
o [D -> D]
masters) (Alignment -> Orientation -> [D -> D] -> Rectangle -> [Rectangle]
divide Alignment
al Orientation
o [D -> D]
slaves)

    pureMessage :: HintedTile Window -> SomeMessage -> Maybe (HintedTile Window)
pureMessage HintedTile Window
c SomeMessage
m = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. Resize -> HintedTile a
resize     (forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m) forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
                      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. IncMasterN -> HintedTile a
incmastern (forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
     where
        resize :: Resize -> HintedTile a
resize Resize
Shrink = HintedTile Window
c { frac :: Rational
frac = forall a. Ord a => a -> a -> a
max Rational
0 forall a b. (a -> b) -> a -> b
$ forall a. HintedTile a -> Rational
frac HintedTile Window
c forall a. Num a => a -> a -> a
- forall a. HintedTile a -> Rational
delta HintedTile Window
c }
        resize Resize
Expand = HintedTile Window
c { frac :: Rational
frac = forall a. Ord a => a -> a -> a
min Rational
1 forall a b. (a -> b) -> a -> b
$ forall a. HintedTile a -> Rational
frac HintedTile Window
c forall a. Num a => a -> a -> a
+ forall a. HintedTile a -> Rational
delta HintedTile Window
c }
        incmastern :: IncMasterN -> HintedTile a
incmastern (IncMasterN Int
d) = HintedTile Window
c { nmaster :: Int
nmaster = forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ forall a. HintedTile a -> Int
nmaster HintedTile Window
c forall a. Num a => a -> a -> a
+ Int
d }

    description :: HintedTile Window -> String
description HintedTile Window
l = forall a. Show a => a -> String
show (forall a. HintedTile a -> Orientation
orientation HintedTile Window
l)

align :: Alignment -> Position -> Dimension -> Dimension -> Position
align :: Alignment -> Position -> Dimension -> Dimension -> Position
align Alignment
TopLeft     Position
p Dimension
_ Dimension
_ = Position
p
align Alignment
Center      Position
p Dimension
a Dimension
b = Position
p forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Dimension
a forall a. Num a => a -> a -> a
- Dimension
b) forall a. Integral a => a -> a -> a
`div` Position
2
align Alignment
BottomRight Position
p Dimension
a Dimension
b = Position
p forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Dimension
a forall a. Num a => a -> a -> a
- Dimension
b)

-- Divide the screen vertically (horizontally) into n subrectangles
divide :: Alignment -> Orientation -> [D -> D] -> Rectangle -> [Rectangle]
divide :: Alignment -> Orientation -> [D -> D] -> Rectangle -> [Rectangle]
divide Alignment
_ Orientation
_ [] Rectangle
_ = []
divide Alignment
al Orientation
_ [D -> D
bh] (Rectangle Position
sx Position
sy Dimension
sw Dimension
sh) = [Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Alignment -> Position -> Dimension -> Dimension -> Position
align Alignment
al Position
sx Dimension
sw Dimension
w) (Alignment -> Position -> Dimension -> Dimension -> Position
align Alignment
al Position
sy Dimension
sh Dimension
h) Dimension
w Dimension
h]
    where
    (Dimension
w, Dimension
h) = D -> D
bh (Dimension
sw, Dimension
sh)

divide Alignment
al Orientation
Tall (D -> D
bh:[D -> D]
bhs) (Rectangle Position
sx Position
sy Dimension
sw Dimension
sh) = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Alignment -> Position -> Dimension -> Dimension -> Position
align Alignment
al Position
sx Dimension
sw Dimension
w) Position
sy Dimension
w Dimension
h forall a. a -> [a] -> [a]
:
      Alignment -> Orientation -> [D -> D] -> Rectangle -> [Rectangle]
divide Alignment
al Orientation
Tall [D -> D]
bhs (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
sx (Position
sy forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
h) Dimension
sw (Dimension
sh forall a. Num a => a -> a -> a
- Dimension
h))
 where
    (Dimension
w, Dimension
h) = D -> D
bh (Dimension
sw, Dimension
sh forall a. Integral a => a -> a -> a
`div` forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
1 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [D -> D]
bhs))

divide Alignment
al Orientation
Wide (D -> D
bh:[D -> D]
bhs) (Rectangle Position
sx Position
sy Dimension
sw Dimension
sh) = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
sx (Alignment -> Position -> Dimension -> Dimension -> Position
align Alignment
al Position
sy Dimension
sh Dimension
h) Dimension
w Dimension
h forall a. a -> [a] -> [a]
:
      Alignment -> Orientation -> [D -> D] -> Rectangle -> [Rectangle]
divide Alignment
al Orientation
Wide [D -> D]
bhs (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
sx forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w) Position
sy (Dimension
sw forall a. Num a => a -> a -> a
- Dimension
w) Dimension
sh)
 where
    (Dimension
w, Dimension
h) = D -> D
bh (Dimension
sw forall a. Integral a => a -> a -> a
`div` forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
1 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [D -> D]
bhs), Dimension
sh)

-- Split the screen into two rectangles, using a rational to specify the ratio
split :: Orientation -> Rational -> Rectangle -> (Rectangle -> [Rectangle])
      -> (Rectangle -> [Rectangle]) -> [Rectangle]
split :: Orientation
-> Rational
-> Rectangle
-> (Rectangle -> [Rectangle])
-> (Rectangle -> [Rectangle])
-> [Rectangle]
split Orientation
Tall Rational
f (Rectangle Position
sx Position
sy Dimension
sw Dimension
sh) Rectangle -> [Rectangle]
left Rectangle -> [Rectangle]
right = [Rectangle]
leftRects forall a. [a] -> [a] -> [a]
++ [Rectangle]
rightRects
 where
    leftw :: Dimension
leftw = forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
sw forall a. Num a => a -> a -> a
* Rational
f
    leftRects :: [Rectangle]
leftRects = Rectangle -> [Rectangle]
left forall a b. (a -> b) -> a -> b
$ Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
sx Position
sy Dimension
leftw Dimension
sh
    rightx :: Dimension
rightx = (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Rectangle -> Dimension
rect_width) [Rectangle]
leftRects
    rightRects :: [Rectangle]
rightRects = Rectangle -> [Rectangle]
right forall a b. (a -> b) -> a -> b
$ Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
sx forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
rightx) Position
sy (Dimension
sw forall a. Num a => a -> a -> a
- Dimension
rightx) Dimension
sh

split Orientation
Wide Rational
f (Rectangle Position
sx Position
sy Dimension
sw Dimension
sh) Rectangle -> [Rectangle]
top Rectangle -> [Rectangle]
bottom = [Rectangle]
topRects forall a. [a] -> [a] -> [a]
++ [Rectangle]
bottomRects
 where
    toph :: Dimension
toph = forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
sh forall a. Num a => a -> a -> a
* Rational
f
    topRects :: [Rectangle]
topRects = Rectangle -> [Rectangle]
top forall a b. (a -> b) -> a -> b
$ Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
sx Position
sy Dimension
sw Dimension
toph
    bottomy :: Dimension
bottomy = (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Rectangle -> Dimension
rect_height) [Rectangle]
topRects
    bottomRects :: [Rectangle]
bottomRects = Rectangle -> [Rectangle]
bottom forall a b. (a -> b) -> a -> b
$ Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
sx (Position
sy forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
bottomy) Dimension
sw (Dimension
sh forall a. Num a => a -> a -> a
- Dimension
bottomy)