{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-}
module XMonad.Layout.MosaicAlt (
MosaicAlt(..)
, shrinkWindowAlt
, expandWindowAlt
, tallWindowAlt
, wideWindowAlt
, resetAlt
, Params, Param
, HandleWindowAlt
) where
import XMonad
import qualified XMonad.StackSet as W
import qualified Data.Map as M
import XMonad.Prelude ( sortBy )
import Data.Ratio
data HandleWindowAlt =
ShrinkWindowAlt Window
| ExpandWindowAlt Window
| TallWindowAlt Window
| WideWindowAlt Window
| ResetAlt
deriving ( HandleWindowAlt -> HandleWindowAlt -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HandleWindowAlt -> HandleWindowAlt -> Bool
$c/= :: HandleWindowAlt -> HandleWindowAlt -> Bool
== :: HandleWindowAlt -> HandleWindowAlt -> Bool
$c== :: HandleWindowAlt -> HandleWindowAlt -> Bool
Eq )
instance Message HandleWindowAlt
shrinkWindowAlt, expandWindowAlt :: Window -> HandleWindowAlt
tallWindowAlt, wideWindowAlt :: Window -> HandleWindowAlt
shrinkWindowAlt :: Window -> HandleWindowAlt
shrinkWindowAlt = Window -> HandleWindowAlt
ShrinkWindowAlt
expandWindowAlt :: Window -> HandleWindowAlt
expandWindowAlt = Window -> HandleWindowAlt
ExpandWindowAlt
tallWindowAlt :: Window -> HandleWindowAlt
tallWindowAlt = Window -> HandleWindowAlt
TallWindowAlt
wideWindowAlt :: Window -> HandleWindowAlt
wideWindowAlt = Window -> HandleWindowAlt
WideWindowAlt
resetAlt :: HandleWindowAlt
resetAlt :: HandleWindowAlt
resetAlt = HandleWindowAlt
ResetAlt
data Param = Param { Param -> Rational
area, Param -> Rational
aspect :: Rational } deriving ( Int -> Param -> ShowS
[Param] -> ShowS
Param -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Param] -> ShowS
$cshowList :: [Param] -> ShowS
show :: Param -> String
$cshow :: Param -> String
showsPrec :: Int -> Param -> ShowS
$cshowsPrec :: Int -> Param -> ShowS
Show, ReadPrec [Param]
ReadPrec Param
Int -> ReadS Param
ReadS [Param]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Param]
$creadListPrec :: ReadPrec [Param]
readPrec :: ReadPrec Param
$creadPrec :: ReadPrec Param
readList :: ReadS [Param]
$creadList :: ReadS [Param]
readsPrec :: Int -> ReadS Param
$creadsPrec :: Int -> ReadS Param
Read )
type Params = M.Map Window Param
newtype MosaicAlt a = MosaicAlt Params deriving ( Int -> MosaicAlt a -> ShowS
forall a. Int -> MosaicAlt a -> ShowS
forall a. [MosaicAlt a] -> ShowS
forall a. MosaicAlt a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MosaicAlt a] -> ShowS
$cshowList :: forall a. [MosaicAlt a] -> ShowS
show :: MosaicAlt a -> String
$cshow :: forall a. MosaicAlt a -> String
showsPrec :: Int -> MosaicAlt a -> ShowS
$cshowsPrec :: forall a. Int -> MosaicAlt a -> ShowS
Show, ReadPrec [MosaicAlt a]
ReadPrec (MosaicAlt a)
ReadS [MosaicAlt a]
forall a. ReadPrec [MosaicAlt a]
forall a. ReadPrec (MosaicAlt a)
forall a. Int -> ReadS (MosaicAlt a)
forall a. ReadS [MosaicAlt a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MosaicAlt a]
$creadListPrec :: forall a. ReadPrec [MosaicAlt a]
readPrec :: ReadPrec (MosaicAlt a)
$creadPrec :: forall a. ReadPrec (MosaicAlt a)
readList :: ReadS [MosaicAlt a]
$creadList :: forall a. ReadS [MosaicAlt a]
readsPrec :: Int -> ReadS (MosaicAlt a)
$creadsPrec :: forall a. Int -> ReadS (MosaicAlt a)
Read )
instance LayoutClass MosaicAlt Window where
description :: MosaicAlt Window -> String
description MosaicAlt Window
_ = String
"MosaicAlt"
doLayout :: MosaicAlt Window
-> Rectangle
-> Stack Window
-> X ([(Window, Rectangle)], Maybe (MosaicAlt Window))
doLayout (MosaicAlt Params
params) Rectangle
rect Stack Window
stack =
forall (m :: * -> *) a. Monad m => a -> m a
return (Rectangle -> Stack Window -> Params -> [(Window, Rectangle)]
arrange Rectangle
rect Stack Window
stack Params
params', forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Params -> MosaicAlt a
MosaicAlt Params
params')
where
params' :: Params
params' = forall {k}. Ord k => [k] -> Map k Param -> Map k Param
ins (forall a. Stack a -> [a]
W.up Stack Window
stack) forall a b. (a -> b) -> a -> b
$ forall {k}. Ord k => [k] -> Map k Param -> Map k Param
ins (forall a. Stack a -> [a]
W.down Stack Window
stack) forall a b. (a -> b) -> a -> b
$ forall {k}. Ord k => [k] -> Map k Param -> Map k Param
ins [forall a. Stack a -> a
W.focus Stack Window
stack] Params
params
ins :: [k] -> Map k Param -> Map k Param
ins [k]
wins Map k Param
as = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Map k Param
as forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall k a. k -> a -> Map k a
`M.singleton` Rational -> Rational -> Param
Param Rational
1 Rational
1.5) [k]
wins
handleMessage :: MosaicAlt Window -> SomeMessage -> X (Maybe (MosaicAlt Window))
handleMessage (MosaicAlt Params
params) SomeMessage
msg = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
msg of
Just (ShrinkWindowAlt Window
w) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Params -> MosaicAlt a
MosaicAlt forall a b. (a -> b) -> a -> b
$ Params -> Window -> Rational -> Rational -> Params
alter Params
params Window
w (Integer
4 forall a. Integral a => a -> a -> Ratio a
% Integer
5) Rational
1
Just (ExpandWindowAlt Window
w) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Params -> MosaicAlt a
MosaicAlt forall a b. (a -> b) -> a -> b
$ Params -> Window -> Rational -> Rational -> Params
alter Params
params Window
w (Integer
6 forall a. Integral a => a -> a -> Ratio a
% Integer
5) Rational
1
Just (TallWindowAlt Window
w) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Params -> MosaicAlt a
MosaicAlt forall a b. (a -> b) -> a -> b
$ Params -> Window -> Rational -> Rational -> Params
alter Params
params Window
w Rational
1 (Integer
3 forall a. Integral a => a -> a -> Ratio a
% Integer
4)
Just (WideWindowAlt Window
w) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Params -> MosaicAlt a
MosaicAlt forall a b. (a -> b) -> a -> b
$ Params -> Window -> Rational -> Rational -> Params
alter Params
params Window
w Rational
1 (Integer
5 forall a. Integral a => a -> a -> Ratio a
% Integer
4)
Just HandleWindowAlt
ResetAlt -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Params -> MosaicAlt a
MosaicAlt forall k a. Map k a
M.empty
Maybe HandleWindowAlt
_ -> forall a. Maybe a
Nothing
alter :: Params -> Window -> Rational -> Rational -> Params
alter :: Params -> Window -> Rational -> Rational -> Params
alter Params
params Window
win Rational
arDelta Rational
asDelta = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Window
win Params
params of
Just (Param Rational
ar Rational
as) -> forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Window
win (Rational -> Rational -> Param
Param (Rational
ar forall a. Num a => a -> a -> a
* Rational
arDelta) (Rational
as forall a. Num a => a -> a -> a
* Rational
asDelta)) Params
params
Maybe Param
Nothing -> forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Window
win (Rational -> Rational -> Param
Param Rational
arDelta (Rational
1.5 forall a. Num a => a -> a -> a
* Rational
asDelta)) Params
params
arrange :: Rectangle -> W.Stack Window -> Params -> [(Window, Rectangle)]
arrange :: Rectangle -> Stack Window -> Params -> [(Window, Rectangle)]
arrange Rectangle
rect Stack Window
stack Params
params = [(Window, Rectangle)]
r
where
(Double
_, [(Window, Rectangle)]
r) = Int
-> Rectangle -> Tree -> Params -> (Double, [(Window, Rectangle)])
findSplits Int
3 Rectangle
rect Tree
tree Params
params
tree :: Tree
tree = [Window] -> Params -> Tree
makeTree (forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Window -> Window -> Ordering
areaCompare [Window]
wins) Params
params
wins :: [Window]
wins = forall a. [a] -> [a]
reverse (forall a. Stack a -> [a]
W.up Stack Window
stack) forall a. [a] -> [a] -> [a]
++ forall a. Stack a -> a
W.focus Stack Window
stack forall a. a -> [a] -> [a]
: forall a. Stack a -> [a]
W.down Stack Window
stack
areaCompare :: Window -> Window -> Ordering
areaCompare Window
a Window
b = Window -> Rational
or1 Window
b forall a. Ord a => a -> a -> Ordering
`compare` Window -> Rational
or1 Window
a
or1 :: Window -> Rational
or1 Window
w = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Rational
1 Param -> Rational
area forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Window
w Params
params
data Tree = Node (Rational, Tree) (Rational, Tree) | Leaf Window | None
makeTree :: [Window] -> Params -> Tree
makeTree :: [Window] -> Params -> Tree
makeTree [Window]
wins Params
params = case [Window]
wins of
[] -> Tree
None
[Window
x] -> Window -> Tree
Leaf Window
x
[Window]
_ -> (Rational, Tree) -> (Rational, Tree) -> Tree
Node (Rational
aArea, [Window] -> Params -> Tree
makeTree [Window]
aWins Params
params) (Rational
bArea, [Window] -> Params -> Tree
makeTree [Window]
bWins Params
params)
where (([Window]
aWins, Rational
aArea), ([Window]
bWins, Rational
bArea)) = Params -> [Window] -> (([Window], Rational), ([Window], Rational))
areaSplit Params
params [Window]
wins
areaSplit :: Params -> [Window] -> (([Window], Rational), ([Window], Rational))
areaSplit :: Params -> [Window] -> (([Window], Rational), ([Window], Rational))
areaSplit Params
params = [Window]
-> Rational
-> [Window]
-> Rational
-> [Window]
-> (([Window], Rational), ([Window], Rational))
gather [] Rational
0 [] Rational
0
where
gather :: [Window]
-> Rational
-> [Window]
-> Rational
-> [Window]
-> (([Window], Rational), ([Window], Rational))
gather [Window]
a Rational
aa [Window]
b Rational
ba (Window
r : [Window]
rs) =
if Rational
aa forall a. Ord a => a -> a -> Bool
<= Rational
ba
then [Window]
-> Rational
-> [Window]
-> Rational
-> [Window]
-> (([Window], Rational), ([Window], Rational))
gather (Window
r forall a. a -> [a] -> [a]
: [Window]
a) (Rational
aa forall a. Num a => a -> a -> a
+ Window -> Rational
or1 Window
r) [Window]
b Rational
ba [Window]
rs
else [Window]
-> Rational
-> [Window]
-> Rational
-> [Window]
-> (([Window], Rational), ([Window], Rational))
gather [Window]
a Rational
aa (Window
r forall a. a -> [a] -> [a]
: [Window]
b) (Rational
ba forall a. Num a => a -> a -> a
+ Window -> Rational
or1 Window
r) [Window]
rs
gather [Window]
a Rational
aa [Window]
b Rational
ba [] = ((forall a. [a] -> [a]
reverse [Window]
a, Rational
aa), ([Window]
b, Rational
ba))
or1 :: Window -> Rational
or1 Window
w = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Rational
1 Param -> Rational
area forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Window
w Params
params
findSplits :: Int -> Rectangle -> Tree -> Params -> (Double, [(Window, Rectangle)])
findSplits :: Int
-> Rectangle -> Tree -> Params -> (Double, [(Window, Rectangle)])
findSplits Int
_ Rectangle
_ Tree
None Params
_ = (Double
0, [])
findSplits Int
_ Rectangle
rect (Leaf Window
w) Params
params = (Rectangle -> Window -> Params -> Double
aspectBadness Rectangle
rect Window
w Params
params, [(Window
w, Rectangle
rect)])
findSplits Int
depth Rectangle
rect (Node (Rational
aArea, Tree
aTree) (Rational
bArea, Tree
bTree)) Params
params =
if Double
hBadness forall a. Ord a => a -> a -> Bool
< Double
vBadness then (Double
hBadness, [(Window, Rectangle)]
hList) else (Double
vBadness, [(Window, Rectangle)]
vList)
where
(Double
hBadness, [(Window, Rectangle)]
hList) = (Rational -> Rectangle -> (Rectangle, Rectangle))
-> (Double, [(Window, Rectangle)])
trySplit forall r. RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitHorizontallyBy
(Double
vBadness, [(Window, Rectangle)]
vList) = (Rational -> Rectangle -> (Rectangle, Rectangle))
-> (Double, [(Window, Rectangle)])
trySplit forall r. RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitVerticallyBy
trySplit :: (Rational -> Rectangle -> (Rectangle, Rectangle))
-> (Double, [(Window, Rectangle)])
trySplit Rational -> Rectangle -> (Rectangle, Rectangle)
splitBy =
(Double
aBadness forall a. Num a => a -> a -> a
+ Double
bBadness, [(Window, Rectangle)]
aList forall a. [a] -> [a] -> [a]
++ [(Window, Rectangle)]
bList)
where
(Double
aBadness, [(Window, Rectangle)]
aList) = Int
-> Rectangle -> Tree -> Params -> (Double, [(Window, Rectangle)])
findSplits (Int
depth forall a. Num a => a -> a -> a
- Int
1) Rectangle
aRect Tree
aTree Params
params
(Double
bBadness, [(Window, Rectangle)]
bList) = Int
-> Rectangle -> Tree -> Params -> (Double, [(Window, Rectangle)])
findSplits (Int
depth forall a. Num a => a -> a -> a
- Int
1) Rectangle
bRect Tree
bTree Params
params
(Rectangle
aRect, Rectangle
bRect) = Rational -> Rectangle -> (Rectangle, Rectangle)
splitBy Rational
ratio Rectangle
rect
ratio :: Rational
ratio = Rational
aArea forall a. Fractional a => a -> a -> a
/ (Rational
aArea forall a. Num a => a -> a -> a
+ Rational
bArea)
aspectBadness :: Rectangle -> Window -> Params -> Double
aspectBadness :: Rectangle -> Window -> Params -> Double
aspectBadness Rectangle
rect Window
win Params
params =
(if Double
a forall a. Ord a => a -> a -> Bool
< Double
1 then Double
tall else Double
wide) forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sqrt(Double
w forall a. Num a => a -> a -> a
* Double
h)
where
tall :: Double
tall = if Double
w forall a. Ord a => a -> a -> Bool
< Double
700 then (Double
1 forall a. Fractional a => a -> a -> a
/ Double
a) forall a. Num a => a -> a -> a
* (Double
700 forall a. Fractional a => a -> a -> a
/ Double
w) else Double
1 forall a. Fractional a => a -> a -> a
/ Double
a
wide :: Double
wide = if Double
w forall a. Ord a => a -> a -> Bool
< Double
700 then Double
a else Double
a forall a. Num a => a -> a -> a
* Double
w forall a. Fractional a => a -> a -> a
/ Double
700
a :: Double
a = (Double
w forall a. Fractional a => a -> a -> a
/ Double
h) forall a. Fractional a => a -> a -> a
/ forall a. Fractional a => Rational -> a
fromRational (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Rational
1.5 Param -> Rational
aspect forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Window
win Params
params)
w :: Double
w = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Rectangle -> Dimension
rect_width Rectangle
rect
h :: Double
h = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Rectangle -> Dimension
rect_height Rectangle
rect