{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-}
module XMonad.Layout.HintedTile (
HintedTile(..), Orientation(..), Alignment(..)
) where
import XMonad hiding (Tall(..))
import qualified XMonad.StackSet as W
import XMonad.Prelude
data HintedTile a = HintedTile
{ forall a. HintedTile a -> Int
nmaster :: !Int
, forall a. HintedTile a -> Rational
delta :: !Rational
, forall a. HintedTile a -> Rational
frac :: !Rational
, forall a. HintedTile a -> Alignment
alignment :: !Alignment
, forall a. HintedTile a -> Orientation
orientation :: !Orientation
} deriving ( Int -> HintedTile a -> ShowS
[HintedTile a] -> ShowS
HintedTile a -> String
(Int -> HintedTile a -> ShowS)
-> (HintedTile a -> String)
-> ([HintedTile a] -> ShowS)
-> Show (HintedTile a)
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
$cshowsPrec :: forall a. Int -> HintedTile a -> ShowS
showsPrec :: Int -> HintedTile a -> ShowS
$cshow :: forall a. HintedTile a -> String
show :: HintedTile a -> String
$cshowList :: forall a. [HintedTile a] -> ShowS
showList :: [HintedTile a] -> ShowS
Show, ReadPrec [HintedTile a]
ReadPrec (HintedTile a)
Int -> ReadS (HintedTile a)
ReadS [HintedTile a]
(Int -> ReadS (HintedTile a))
-> ReadS [HintedTile a]
-> ReadPrec (HintedTile a)
-> ReadPrec [HintedTile a]
-> Read (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
$creadsPrec :: forall a. Int -> ReadS (HintedTile a)
readsPrec :: Int -> ReadS (HintedTile a)
$creadList :: forall a. ReadS [HintedTile a]
readList :: ReadS [HintedTile a]
$creadPrec :: forall a. ReadPrec (HintedTile a)
readPrec :: ReadPrec (HintedTile a)
$creadListPrec :: forall a. ReadPrec [HintedTile a]
readListPrec :: ReadPrec [HintedTile a]
Read )
data Orientation
= Wide
| Tall
deriving ( Int -> Orientation -> ShowS
[Orientation] -> ShowS
Orientation -> String
(Int -> Orientation -> ShowS)
-> (Orientation -> String)
-> ([Orientation] -> ShowS)
-> Show Orientation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Orientation -> ShowS
showsPrec :: Int -> Orientation -> ShowS
$cshow :: Orientation -> String
show :: Orientation -> String
$cshowList :: [Orientation] -> ShowS
showList :: [Orientation] -> ShowS
Show, ReadPrec [Orientation]
ReadPrec Orientation
Int -> ReadS Orientation
ReadS [Orientation]
(Int -> ReadS Orientation)
-> ReadS [Orientation]
-> ReadPrec Orientation
-> ReadPrec [Orientation]
-> Read Orientation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Orientation
readsPrec :: Int -> ReadS Orientation
$creadList :: ReadS [Orientation]
readList :: ReadS [Orientation]
$creadPrec :: ReadPrec Orientation
readPrec :: ReadPrec Orientation
$creadListPrec :: ReadPrec [Orientation]
readListPrec :: ReadPrec [Orientation]
Read, Orientation -> Orientation -> Bool
(Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool) -> Eq Orientation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Orientation -> Orientation -> Bool
== :: Orientation -> Orientation -> Bool
$c/= :: Orientation -> Orientation -> Bool
/= :: Orientation -> Orientation -> Bool
Eq, Eq Orientation
Eq Orientation =>
(Orientation -> Orientation -> Ordering)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Orientation)
-> (Orientation -> Orientation -> Orientation)
-> Ord 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
$ccompare :: Orientation -> Orientation -> Ordering
compare :: Orientation -> Orientation -> Ordering
$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
>= :: Orientation -> Orientation -> Bool
$cmax :: Orientation -> Orientation -> Orientation
max :: Orientation -> Orientation -> Orientation
$cmin :: Orientation -> Orientation -> Orientation
min :: Orientation -> Orientation -> Orientation
Ord )
data Alignment = TopLeft | Center | BottomRight
deriving ( Int -> Alignment -> ShowS
[Alignment] -> ShowS
Alignment -> String
(Int -> Alignment -> ShowS)
-> (Alignment -> String)
-> ([Alignment] -> ShowS)
-> Show Alignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Alignment -> ShowS
showsPrec :: Int -> Alignment -> ShowS
$cshow :: Alignment -> String
show :: Alignment -> String
$cshowList :: [Alignment] -> ShowS
showList :: [Alignment] -> ShowS
Show, ReadPrec [Alignment]
ReadPrec Alignment
Int -> ReadS Alignment
ReadS [Alignment]
(Int -> ReadS Alignment)
-> ReadS [Alignment]
-> ReadPrec Alignment
-> ReadPrec [Alignment]
-> Read Alignment
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Alignment
readsPrec :: Int -> ReadS Alignment
$creadList :: ReadS [Alignment]
readList :: ReadS [Alignment]
$creadPrec :: ReadPrec Alignment
readPrec :: ReadPrec Alignment
$creadListPrec :: ReadPrec [Alignment]
readListPrec :: ReadPrec [Alignment]
Read, Alignment -> Alignment -> Bool
(Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool) -> Eq Alignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Alignment -> Alignment -> Bool
== :: Alignment -> Alignment -> Bool
$c/= :: Alignment -> Alignment -> Bool
/= :: Alignment -> Alignment -> Bool
Eq, Eq Alignment
Eq Alignment =>
(Alignment -> Alignment -> Ordering)
-> (Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Alignment)
-> (Alignment -> Alignment -> Alignment)
-> Ord 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
$ccompare :: Alignment -> Alignment -> Ordering
compare :: Alignment -> Alignment -> Ordering
$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
>= :: Alignment -> Alignment -> Bool
$cmax :: Alignment -> Alignment -> Alignment
max :: Alignment -> Alignment -> Alignment
$cmin :: Alignment -> Alignment -> Alignment
min :: Alignment -> Alignment -> Alignment
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 <- (Window -> X (D -> D)) -> [Window] -> X [D -> D]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Window -> X (D -> D)
mkAdjust [Window]
w
let ([D -> D]
masters, [D -> D]
slaves) = Int -> [D -> D] -> ([D -> D], [D -> D])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
nm [D -> D]
bhs
([(Window, Rectangle)], Maybe (HintedTile Window))
-> X ([(Window, Rectangle)], Maybe (HintedTile Window))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Window] -> [Rectangle] -> [(Window, Rectangle)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Window]
w ([D -> D] -> [D -> D] -> [Rectangle]
tiler [D -> D]
masters [D -> D]
slaves), Maybe (HintedTile Window)
forall a. Maybe a
Nothing)
where
w :: [Window]
w = Stack Window -> [Window]
forall a. Stack a -> [a]
W.integrate Stack Window
w'
tiler :: [D -> D] -> [D -> D] -> [Rectangle]
tiler [D -> D]
masters [D -> D]
slaves
| [D -> D] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [D -> D]
masters Bool -> Bool -> Bool
|| [D -> D] -> Bool
forall a. [a] -> 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 [D -> D] -> [D -> D] -> [D -> D]
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 = (Resize -> HintedTile Window)
-> Maybe Resize -> Maybe (HintedTile Window)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Resize -> HintedTile Window
forall {a}. Resize -> HintedTile a
resize (SomeMessage -> Maybe Resize
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m) Maybe (HintedTile Window)
-> Maybe (HintedTile Window) -> Maybe (HintedTile Window)
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
(IncMasterN -> HintedTile Window)
-> Maybe IncMasterN -> Maybe (HintedTile Window)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IncMasterN -> HintedTile Window
forall {a}. IncMasterN -> HintedTile a
incmastern (SomeMessage -> Maybe IncMasterN
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
where
resize :: Resize -> HintedTile a
resize Resize
Shrink = HintedTile Window
c { frac = max 0 $ frac c - delta c }
resize Resize
Expand = HintedTile Window
c { frac = min 1 $ frac c + delta c }
incmastern :: IncMasterN -> HintedTile a
incmastern (IncMasterN Int
d) = HintedTile Window
c { nmaster = max 0 $ nmaster c + d }
description :: HintedTile Window -> String
description HintedTile Window
l = Orientation -> String
forall a. Show a => a -> String
show (HintedTile Window -> Orientation
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 Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Dimension
a Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
b) Position -> Position -> Position
forall a. Integral a => a -> a -> a
`div` Position
2
align Alignment
BottomRight Position
p Dimension
a Dimension
b = Position
p Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Dimension
a Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
b)
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 Rectangle -> [Rectangle] -> [Rectangle]
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 Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
h) Dimension
sw (Dimension
sh Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
h))
where
(Dimension
w, Dimension
h) = D -> D
bh (Dimension
sw, Dimension
sh Dimension -> Dimension -> Dimension
forall a. Integral a => a -> a -> a
`div` Int -> Dimension
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [D -> D] -> Int
forall a. [a] -> Int
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 Rectangle -> [Rectangle] -> [Rectangle]
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 Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w) Position
sy (Dimension
sw Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
w) Dimension
sh)
where
(Dimension
w, Dimension
h) = D -> D
bh (Dimension
sw Dimension -> Dimension -> Dimension
forall a. Integral a => a -> a -> a
`div` Int -> Dimension
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [D -> D] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [D -> D]
bhs), Dimension
sh)
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 [Rectangle] -> [Rectangle] -> [Rectangle]
forall a. [a] -> [a] -> [a]
++ [Rectangle]
rightRects
where
leftw :: Dimension
leftw = Rational -> Dimension
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational -> Dimension) -> Rational -> Dimension
forall a b. (a -> b) -> a -> b
$ Dimension -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
sw Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
f
leftRects :: [Rectangle]
leftRects = Rectangle -> [Rectangle]
left (Rectangle -> [Rectangle]) -> Rectangle -> [Rectangle]
forall a b. (a -> b) -> a -> b
$ Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
sx Position
sy Dimension
leftw Dimension
sh
rightx :: Dimension
rightx = ([Dimension] -> Dimension
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Dimension] -> Dimension)
-> ([Rectangle] -> [Dimension]) -> [Rectangle] -> Dimension
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rectangle -> Dimension) -> [Rectangle] -> [Dimension]
forall a b. (a -> b) -> [a] -> [b]
map Rectangle -> Dimension
rect_width) [Rectangle]
leftRects
rightRects :: [Rectangle]
rightRects = Rectangle -> [Rectangle]
right (Rectangle -> [Rectangle]) -> Rectangle -> [Rectangle]
forall a b. (a -> b) -> a -> b
$ 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
fromIntegral Dimension
rightx) Position
sy (Dimension
sw Dimension -> Dimension -> Dimension
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 [Rectangle] -> [Rectangle] -> [Rectangle]
forall a. [a] -> [a] -> [a]
++ [Rectangle]
bottomRects
where
toph :: Dimension
toph = Rational -> Dimension
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational -> Dimension) -> Rational -> Dimension
forall a b. (a -> b) -> a -> b
$ Dimension -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
sh Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
f
topRects :: [Rectangle]
topRects = Rectangle -> [Rectangle]
top (Rectangle -> [Rectangle]) -> Rectangle -> [Rectangle]
forall a b. (a -> b) -> a -> b
$ Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
sx Position
sy Dimension
sw Dimension
toph
bottomy :: Dimension
bottomy = ([Dimension] -> Dimension
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Dimension] -> Dimension)
-> ([Rectangle] -> [Dimension]) -> [Rectangle] -> Dimension
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rectangle -> Dimension) -> [Rectangle] -> [Dimension]
forall a b. (a -> b) -> [a] -> [b]
map Rectangle -> Dimension
rect_height) [Rectangle]
topRects
bottomRects :: [Rectangle]
bottomRects = Rectangle -> [Rectangle]
bottom (Rectangle -> [Rectangle]) -> Rectangle -> [Rectangle]
forall a b. (a -> b) -> a -> b
$ Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
sx (Position
sy Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
bottomy) Dimension
sw (Dimension
sh Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
bottomy)