{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.MosaicAlt
-- Description :  An alternative version of "XMonad.Layout.Mosaic".
-- Copyright   :  (c) 2007 James Webb
-- License     :  BSD-style (see xmonad/LICENSE)
--
-- Maintainer  :  xmonad#jwebb,sygneca,com
-- Stability   :  unstable
-- Portability :  unportable
--
-- A layout which gives each window a specified amount of screen space
-- relative to the others. Compared to the 'Mosaic' layout, this one
-- divides the space in a more balanced way.
--
-----------------------------------------------------------------------------

module XMonad.Layout.MosaicAlt (
        -- * Usage:
        -- $usage
        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

-- $usage
-- You can use this module with the following in your @xmonad.hs@:
--
-- > import XMonad.Layout.MosaicAlt
-- > import qualified Data.Map as M
--
-- Then edit your @layoutHook@ by adding the MosaicAlt layout:
--
-- > myLayout = MosaicAlt M.empty ||| Full ||| etc..
-- > main = xmonad def { layoutHook = myLayout }
--
-- 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".
--
-- In the key-bindings, do something like:
--
-- >     , ((modm .|. shiftMask  , xK_a    ), withFocused (sendMessage . expandWindowAlt))
-- >     , ((modm .|. shiftMask  , xK_z    ), withFocused (sendMessage . shrinkWindowAlt))
-- >     , ((modm .|. shiftMask  , xK_s    ), withFocused (sendMessage . tallWindowAlt))
-- >     , ((modm .|. shiftMask  , xK_d    ), withFocused (sendMessage . wideWindowAlt))
-- >     , ((modm .|. controlMask, xK_space), sendMessage resetAlt)
-- >     ...
--
-- For detailed instruction on editing the key binding see:
--
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.

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

-- Change requested params for a window.
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

-- Layout algorithm entry point.
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

-- Recursively group windows into a binary tree. Aim to balance the tree
-- according to the total requested area in each branch.
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

-- Split a list of windows in half by area.
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

-- Figure out which ways to split the space, by exhaustive search.
-- Complexity is quadratic in the number of windows.
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)

-- Decide how much we like this rectangle.
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

-- vim: sw=4:et