{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TupleSections #-}
module XMonad.Layout.ResizableTile (
ResizableTall(..), MirrorResize(..)
) where
import XMonad hiding (tile, splitVertically, splitHorizontallyBy)
import XMonad.Prelude
import qualified XMonad.StackSet as W
import qualified Data.Map as M
data MirrorResize = MirrorShrink | MirrorExpand
instance Message MirrorResize
data ResizableTall a = ResizableTall
{ forall a. ResizableTall a -> Int
_nmaster :: Int
, forall a. ResizableTall a -> Rational
_delta :: Rational
, forall a. ResizableTall a -> Rational
_frac :: Rational
, forall a. ResizableTall a -> [Rational]
_slaves :: [Rational]
} deriving (Int -> ResizableTall a -> ShowS
[ResizableTall a] -> ShowS
ResizableTall a -> String
(Int -> ResizableTall a -> ShowS)
-> (ResizableTall a -> String)
-> ([ResizableTall a] -> ShowS)
-> Show (ResizableTall a)
forall a. Int -> ResizableTall a -> ShowS
forall a. [ResizableTall a] -> ShowS
forall a. ResizableTall a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResizableTall a] -> ShowS
$cshowList :: forall a. [ResizableTall a] -> ShowS
show :: ResizableTall a -> String
$cshow :: forall a. ResizableTall a -> String
showsPrec :: Int -> ResizableTall a -> ShowS
$cshowsPrec :: forall a. Int -> ResizableTall a -> ShowS
Show, ReadPrec [ResizableTall a]
ReadPrec (ResizableTall a)
Int -> ReadS (ResizableTall a)
ReadS [ResizableTall a]
(Int -> ReadS (ResizableTall a))
-> ReadS [ResizableTall a]
-> ReadPrec (ResizableTall a)
-> ReadPrec [ResizableTall a]
-> Read (ResizableTall a)
forall a. ReadPrec [ResizableTall a]
forall a. ReadPrec (ResizableTall a)
forall a. Int -> ReadS (ResizableTall a)
forall a. ReadS [ResizableTall a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResizableTall a]
$creadListPrec :: forall a. ReadPrec [ResizableTall a]
readPrec :: ReadPrec (ResizableTall a)
$creadPrec :: forall a. ReadPrec (ResizableTall a)
readList :: ReadS [ResizableTall a]
$creadList :: forall a. ReadS [ResizableTall a]
readsPrec :: Int -> ReadS (ResizableTall a)
$creadsPrec :: forall a. Int -> ReadS (ResizableTall a)
Read)
instance LayoutClass ResizableTall a where
doLayout :: ResizableTall a
-> Rectangle
-> Stack a
-> X ([(a, Rectangle)], Maybe (ResizableTall a))
doLayout (ResizableTall Int
nmaster Rational
_ Rational
frac [Rational]
mfrac) Rectangle
r =
([(a, Rectangle)], Maybe (ResizableTall a))
-> X ([(a, Rectangle)], Maybe (ResizableTall a))
forall (m :: * -> *) a. Monad m => a -> m a
return (([(a, Rectangle)], Maybe (ResizableTall a))
-> X ([(a, Rectangle)], Maybe (ResizableTall a)))
-> (Stack a -> ([(a, Rectangle)], Maybe (ResizableTall a)))
-> Stack a
-> X ([(a, Rectangle)], Maybe (ResizableTall a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (, Maybe (ResizableTall a)
forall a. Maybe a
Nothing) ([(a, Rectangle)] -> ([(a, Rectangle)], Maybe (ResizableTall a)))
-> (Stack a -> [(a, Rectangle)])
-> Stack a
-> ([(a, Rectangle)], Maybe (ResizableTall a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
([a] -> [Rectangle] -> [(a, Rectangle)])
-> ([a] -> [Rectangle]) -> [a] -> [(a, Rectangle)]
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap [a] -> [Rectangle] -> [(a, Rectangle)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Rational -> [Rational] -> Rectangle -> Int -> Int -> [Rectangle]
tile Rational
frac ([Rational]
mfrac [Rational] -> [Rational] -> [Rational]
forall a. [a] -> [a] -> [a]
++ Rational -> [Rational]
forall a. a -> [a]
repeat Rational
1) Rectangle
r Int
nmaster (Int -> [Rectangle]) -> ([a] -> Int) -> [a] -> [Rectangle]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([a] -> [(a, Rectangle)])
-> (Stack a -> [a]) -> Stack a -> [(a, Rectangle)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack a -> [a]
forall a. Stack a -> [a]
W.integrate
handleMessage :: ResizableTall a -> SomeMessage -> X (Maybe (ResizableTall a))
handleMessage (ResizableTall Int
nmaster Rational
delta Rational
frac [Rational]
mfrac) SomeMessage
m =
do Maybe (Stack Window)
ms <- Workspace String (Layout Window) Window -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace String (Layout Window) Window -> Maybe (Stack Window))
-> (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window)
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Maybe (Stack Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
W.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
W.current (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Maybe (Stack Window))
-> X (StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X (Maybe (Stack Window))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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
[Window]
fs <- Map Window RationalRect -> [Window]
forall k a. Map k a -> [k]
M.keys (Map Window RationalRect -> [Window])
-> (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Map Window RationalRect)
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> [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
W.floating (StackSet String (Layout Window) Window ScreenId ScreenDetail
-> [Window])
-> X (StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X [Window]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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
Maybe (ResizableTall a) -> X (Maybe (ResizableTall a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ResizableTall a) -> X (Maybe (ResizableTall a)))
-> Maybe (ResizableTall a) -> X (Maybe (ResizableTall a))
forall a b. (a -> b) -> a -> b
$ Maybe (Stack Window)
ms Maybe (Stack Window)
-> (Stack Window -> Maybe (Stack Window)) -> Maybe (Stack Window)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Window] -> Stack Window -> Maybe (Stack Window)
forall {a}. Eq a => [a] -> Stack a -> Maybe (Stack a)
unfloat [Window]
fs Maybe (Stack Window)
-> (Stack Window -> Maybe (ResizableTall a))
-> Maybe (ResizableTall a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stack Window -> Maybe (ResizableTall a)
forall {a} {a}. Stack a -> Maybe (ResizableTall a)
handleMesg
where handleMesg :: Stack a -> Maybe (ResizableTall a)
handleMesg Stack a
s = [Maybe (ResizableTall a)] -> Maybe (ResizableTall a)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [(Resize -> ResizableTall a)
-> Maybe Resize -> Maybe (ResizableTall a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Resize -> ResizableTall a
forall {a}. Resize -> ResizableTall a
resize (SomeMessage -> Maybe Resize
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
,(MirrorResize -> ResizableTall a)
-> Maybe MirrorResize -> Maybe (ResizableTall a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MirrorResize -> Stack a -> ResizableTall a
forall {a} {a}. MirrorResize -> Stack a -> ResizableTall a
`mresize` Stack a
s) (SomeMessage -> Maybe MirrorResize
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
,(IncMasterN -> ResizableTall a)
-> Maybe IncMasterN -> Maybe (ResizableTall a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IncMasterN -> ResizableTall a
forall {a}. IncMasterN -> ResizableTall a
incmastern (SomeMessage -> Maybe IncMasterN
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)]
unfloat :: [a] -> Stack a -> Maybe (Stack a)
unfloat [a]
fs Stack a
s = if Stack a -> a
forall a. Stack a -> a
W.focus Stack a
s a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
fs
then Maybe (Stack a)
forall a. Maybe a
Nothing
else Stack a -> Maybe (Stack a)
forall a. a -> Maybe a
Just (Stack a
s { up :: [a]
W.up = Stack a -> [a]
forall a. Stack a -> [a]
W.up Stack a
s [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
\\ [a]
fs
, down :: [a]
W.down = Stack a -> [a]
forall a. Stack a -> [a]
W.down Stack a
s [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
\\ [a]
fs })
resize :: Resize -> ResizableTall a
resize Resize
Shrink = Int -> Rational -> Rational -> [Rational] -> ResizableTall a
forall a.
Int -> Rational -> Rational -> [Rational] -> ResizableTall a
ResizableTall Int
nmaster Rational
delta (Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
max Rational
0 (Rational -> Rational) -> Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Rational
fracRational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
delta) [Rational]
mfrac
resize Resize
Expand = Int -> Rational -> Rational -> [Rational] -> ResizableTall a
forall a.
Int -> Rational -> Rational -> [Rational] -> ResizableTall a
ResizableTall Int
nmaster Rational
delta (Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
min Rational
1 (Rational -> Rational) -> Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Rational
fracRational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
delta) [Rational]
mfrac
mresize :: MirrorResize -> Stack a -> ResizableTall a
mresize MirrorResize
MirrorShrink Stack a
s = Stack a -> Rational -> ResizableTall a
forall {a} {a}. Stack a -> Rational -> ResizableTall a
mresize' Stack a
s Rational
delta
mresize MirrorResize
MirrorExpand Stack a
s = Stack a -> Rational -> ResizableTall a
forall {a} {a}. Stack a -> Rational -> ResizableTall a
mresize' Stack a
s (Rational -> Rational
forall a. Num a => a -> a
negate Rational
delta)
mresize' :: Stack a -> Rational -> ResizableTall a
mresize' Stack a
s Rational
d = let n :: Int
n = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> [a] -> Int
forall a b. (a -> b) -> a -> b
$ Stack a -> [a]
forall a. Stack a -> [a]
W.up Stack a
s
total :: Int
total = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Stack a -> [a]
forall a. Stack a -> [a]
W.down Stack a
s) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
pos :: Int
pos = if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
nmasterInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
totalInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) then Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 else Int
n
mfrac' :: [Rational]
mfrac' = [Rational] -> Rational -> Int -> [Rational]
forall {t} {t}. (Eq t, Num t, Num t) => [t] -> t -> t -> [t]
modifymfrac ([Rational]
mfrac [Rational] -> [Rational] -> [Rational]
forall a. [a] -> [a] -> [a]
++ Rational -> [Rational]
forall a. a -> [a]
repeat Rational
1) Rational
d Int
pos
in Int -> Rational -> Rational -> [Rational] -> ResizableTall a
forall a.
Int -> Rational -> Rational -> [Rational] -> ResizableTall a
ResizableTall Int
nmaster Rational
delta Rational
frac ([Rational] -> ResizableTall a) -> [Rational] -> ResizableTall a
forall a b. (a -> b) -> a -> b
$ Int -> [Rational] -> [Rational]
forall a. Int -> [a] -> [a]
take Int
total [Rational]
mfrac'
modifymfrac :: [t] -> t -> t -> [t]
modifymfrac [] t
_ t
_ = []
modifymfrac (t
f:[t]
fx) t
d t
n | t
n t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 = t
ft -> t -> t
forall a. Num a => a -> a -> a
+t
d t -> [t] -> [t]
forall a. a -> [a] -> [a]
: [t]
fx
| Bool
otherwise = t
f t -> [t] -> [t]
forall a. a -> [a] -> [a]
: [t] -> t -> t -> [t]
modifymfrac [t]
fx t
d (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1)
incmastern :: IncMasterN -> ResizableTall a
incmastern (IncMasterN Int
d) = Int -> Rational -> Rational -> [Rational] -> ResizableTall a
forall a.
Int -> Rational -> Rational -> [Rational] -> ResizableTall a
ResizableTall (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
nmasterInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d)) Rational
delta Rational
frac [Rational]
mfrac
description :: ResizableTall a -> String
description ResizableTall a
_ = String
"ResizableTall"
tile :: Rational -> [Rational] -> Rectangle -> Int -> Int -> [Rectangle]
tile :: Rational -> [Rational] -> Rectangle -> Int -> Int -> [Rectangle]
tile Rational
f [Rational]
mf Rectangle
r Int
nmaster Int
n = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
nmaster Bool -> Bool -> Bool
|| Int
nmaster Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then [Rational] -> Int -> Rectangle -> [Rectangle]
forall r. RealFrac r => [r] -> Int -> Rectangle -> [Rectangle]
splitVertically [Rational]
mf Int
n Rectangle
r
else [Rational] -> Int -> Rectangle -> [Rectangle]
forall r. RealFrac r => [r] -> Int -> Rectangle -> [Rectangle]
splitVertically [Rational]
mf Int
nmaster Rectangle
r1 [Rectangle] -> [Rectangle] -> [Rectangle]
forall a. [a] -> [a] -> [a]
++ [Rational] -> Int -> Rectangle -> [Rectangle]
forall r. RealFrac r => [r] -> Int -> Rectangle -> [Rectangle]
splitVertically (Int -> [Rational] -> [Rational]
forall a. Int -> [a] -> [a]
drop Int
nmaster [Rational]
mf) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
nmaster) Rectangle
r2
where (Rectangle
r1,Rectangle
r2) = Rational -> Rectangle -> (Rectangle, Rectangle)
forall r. RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitHorizontallyBy Rational
f Rectangle
r
splitVertically :: RealFrac r => [r] -> Int -> Rectangle -> [Rectangle]
splitVertically :: forall r. RealFrac r => [r] -> Int -> Rectangle -> [Rectangle]
splitVertically [] Int
_ Rectangle
r = [Rectangle
r]
splitVertically [r]
_ Int
n Rectangle
r | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = [Rectangle
r]
splitVertically (r
f:[r]
fx) Int
n (Rectangle Position
sx Position
sy Dimension
sw Dimension
sh) = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
sx Position
sy Dimension
sw Dimension
smallh Rectangle -> [Rectangle] -> [Rectangle]
forall a. a -> [a] -> [a]
:
[r] -> Int -> Rectangle -> [Rectangle]
forall r. RealFrac r => [r] -> Int -> Rectangle -> [Rectangle]
splitVertically [r]
fx (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
sx (Position
syPosition -> Position -> Position
forall a. Num a => a -> a -> a
+Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
smallh) Dimension
sw (Dimension
shDimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
-Dimension
smallh))
where smallh :: Dimension
smallh = Dimension -> Dimension -> Dimension
forall a. Ord a => a -> a -> a
min Dimension
sh (r -> Dimension
forall a b. (RealFrac a, Integral b) => a -> b
floor (r -> Dimension) -> r -> Dimension
forall a b. (a -> b) -> a -> b
$ Dimension -> r
forall a b. (Integral a, Num b) => a -> b
fromIntegral (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
n) r -> r -> r
forall a. Num a => a -> a -> a
* r
f)
splitHorizontallyBy :: RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitHorizontallyBy :: forall r. RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitHorizontallyBy r
f (Rectangle Position
sx Position
sy Dimension
sw Dimension
sh) =
( Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
sx Position
sy Dimension
leftw Dimension
sh
, 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
leftw) Position
sy (Dimension
swDimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
-Dimension -> Dimension
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
leftw) Dimension
sh)
where leftw :: Dimension
leftw = r -> Dimension
forall a b. (RealFrac a, Integral b) => a -> b
floor (r -> Dimension) -> r -> Dimension
forall a b. (a -> b) -> a -> b
$ Dimension -> r
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
sw r -> r -> r
forall a. Num a => a -> a -> a
* r
f