mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-08-10 00:41:52 -07:00
MosaicAlt take 2
This commit is contained in:
Jamie Webb
129
MosaicAlt.hs
129
MosaicAlt.hs
@@ -21,6 +21,8 @@ module XMonadContrib.MosaicAlt (
|
||||
MosaicAlt(..)
|
||||
, shrinkWindowAlt
|
||||
, expandWindowAlt
|
||||
, tallWindowAlt
|
||||
, wideWindowAlt
|
||||
, resetAlt
|
||||
) where
|
||||
|
||||
@@ -45,6 +47,8 @@ import Graphics.X11.Types ( Window )
|
||||
-- > keys = ...
|
||||
-- > , ((modMask .|. shiftMask, xK_a), withFocused (sendMessage . expandWindowAlt))
|
||||
-- > , ((modMask .|. shiftMask, xK_z), withFocused (sendMessage . shrinkWindowAlt))
|
||||
-- > , ((modMask .|. shiftMask, xK_s), withFocused (sendMessage . tallWindowAlt))
|
||||
-- > , ((modMask .|. shiftMask, xK_d), withFocused (sendMessage . wideWindowAlt))
|
||||
-- > , ((modMask .|. controlMask, xK_space), sendMessage resetAlt)
|
||||
-- > ...
|
||||
|
||||
@@ -54,83 +58,104 @@ import Graphics.X11.Types ( Window )
|
||||
data HandleWindowAlt =
|
||||
ShrinkWindowAlt Window
|
||||
| ExpandWindowAlt Window
|
||||
| TallWindowAlt Window
|
||||
| WideWindowAlt Window
|
||||
| ResetAlt
|
||||
deriving ( Typeable, Eq )
|
||||
instance Message HandleWindowAlt
|
||||
shrinkWindowAlt, expandWindowAlt :: Window -> HandleWindowAlt
|
||||
tallWindowAlt, wideWindowAlt :: Window -> HandleWindowAlt
|
||||
shrinkWindowAlt = ShrinkWindowAlt
|
||||
expandWindowAlt = ExpandWindowAlt
|
||||
tallWindowAlt = TallWindowAlt
|
||||
wideWindowAlt = WideWindowAlt
|
||||
resetAlt :: HandleWindowAlt
|
||||
resetAlt = ResetAlt
|
||||
|
||||
type Areas = M.Map Window Rational
|
||||
data MosaicAlt a = MosaicAlt Areas deriving ( Show, Read )
|
||||
data Param = Param { area, aspect :: Rational } deriving ( Show, Read )
|
||||
type Params = M.Map Window Param
|
||||
data MosaicAlt a = MosaicAlt Params deriving ( Show, Read )
|
||||
|
||||
instance LayoutClass MosaicAlt Window where
|
||||
description _ = "MosaicAlt"
|
||||
doLayout (MosaicAlt areas) rect stack =
|
||||
return (arrange rect stack areas', Just $ MosaicAlt areas')
|
||||
doLayout (MosaicAlt params) rect stack =
|
||||
return (arrange rect stack params', Just $ MosaicAlt params')
|
||||
where
|
||||
areas' = ins (W.up stack) $ ins (W.down stack) $ ins [W.focus stack] areas
|
||||
ins wins as = foldl M.union as $ map (`M.singleton` 1) wins
|
||||
params' = ins (W.up stack) $ ins (W.down stack) $ ins [W.focus stack] params
|
||||
ins wins as = foldl M.union as $ map (`M.singleton` (Param 1 1.5)) wins
|
||||
|
||||
handleMessage (MosaicAlt areas) msg = return $ case fromMessage msg of
|
||||
Just (ShrinkWindowAlt w) -> Just $ MosaicAlt $ alter areas w (4 % 5)
|
||||
Just (ExpandWindowAlt w) -> Just $ MosaicAlt $ alter areas w (6 % 5)
|
||||
handleMessage (MosaicAlt params) msg = return $ case fromMessage msg of
|
||||
Just (ShrinkWindowAlt w) -> Just $ MosaicAlt $ alter params w (4 % 5) 1
|
||||
Just (ExpandWindowAlt w) -> Just $ MosaicAlt $ alter params w (6 % 5) 1
|
||||
Just (TallWindowAlt w) -> Just $ MosaicAlt $ alter params w 1 (3 % 4)
|
||||
Just (WideWindowAlt w) -> Just $ MosaicAlt $ alter params w 1 (5 % 4)
|
||||
Just ResetAlt -> Just $ MosaicAlt M.empty
|
||||
_ -> Nothing
|
||||
|
||||
-- Layout algorithm entry point.
|
||||
arrange :: Rectangle -> W.Stack Window -> Areas -> [(Window, Rectangle)]
|
||||
arrange rect stack areas = tree rect (sortBy areaCompare winList) totalArea areas
|
||||
where
|
||||
winList = reverse (W.up stack) ++ W.focus stack : W.down stack
|
||||
totalArea = areaSum areas winList
|
||||
areaCompare a b = or1 b `compare` or1 a
|
||||
or1 w = maybe 1 id $ M.lookup w areas
|
||||
-- Change requested params for a window.
|
||||
alter :: Params -> Window -> Rational -> Rational -> Params
|
||||
alter params win arDelta asDelta = case M.lookup win params of
|
||||
Just (Param ar as) -> M.insert win (Param (ar * arDelta) (as * asDelta)) params
|
||||
Nothing -> M.insert win (Param arDelta (1.5 * asDelta)) params
|
||||
|
||||
-- Selects a horizontal or vertical split to get the best aspect ratio.
|
||||
-- FIXME: Give the user more dynamic control.
|
||||
splitBest :: Rational -> Rectangle -> (Rectangle, Rectangle)
|
||||
splitBest ratio rect =
|
||||
if (w % h) < cutoff then splitVerticallyBy ratio rect
|
||||
else splitHorizontallyBy ratio rect
|
||||
-- Layout algorithm entry point.
|
||||
arrange :: Rectangle -> W.Stack Window -> Params -> [(Window, Rectangle)]
|
||||
arrange rect stack params = r
|
||||
where
|
||||
-- Prefer wide windows to tall ones, mainly because it makes xterms more usable.
|
||||
cutoff = if w > 1000 then 1.25
|
||||
else if w < 500 then 2.25
|
||||
else 2.25 - (w - 500) % 500
|
||||
w = rect_width rect
|
||||
h = rect_height rect
|
||||
(_, r) = findSplits 3 rect tree params
|
||||
tree = makeTree (sortBy areaCompare wins) params
|
||||
wins = reverse (W.up stack) ++ W.focus stack : W.down stack
|
||||
areaCompare a b = or1 b `compare` or1 a
|
||||
or1 w = maybe 1 area $ M.lookup w params
|
||||
|
||||
-- Recursively group windows into a binary tree. Aim to balance the tree
|
||||
-- according to the total requested area in each branch.
|
||||
tree :: Rectangle -> [Window] -> Rational -> Areas -> [(Window, Rectangle)]
|
||||
tree rect winList totalArea areas = case winList of
|
||||
[] -> []
|
||||
[x] -> [(x, rect)]
|
||||
_ -> tree aRect aWins aArea areas ++ tree bRect bWins bArea areas
|
||||
where
|
||||
(aRect, bRect) = splitBest (aArea / (aArea + bArea)) rect
|
||||
((aWins, aArea), (bWins, bArea)) = areaSplit areas winList totalArea
|
||||
|
||||
-- Sum the requested areas of a bunch of windows.
|
||||
areaSum :: Areas -> [Window] -> Rational
|
||||
areaSum areas = sum . map (maybe 1 id . flip M.lookup areas)
|
||||
data Tree = Node (Rational, Tree) (Rational, Tree) | Leaf Window | None
|
||||
makeTree :: [Window] -> Params -> Tree
|
||||
makeTree wins params = case wins of
|
||||
[] -> None
|
||||
[x] -> Leaf x
|
||||
_ -> Node (aArea, makeTree aWins params) (bArea, makeTree bWins params)
|
||||
where ((aWins, aArea), (bWins, bArea)) = areaSplit params wins
|
||||
|
||||
-- Split a list of windows in half by area.
|
||||
areaSplit :: Areas -> [Window] -> Rational -> (([Window], Rational), ([Window], Rational))
|
||||
areaSplit areas wins totalArea = ((reverse aWins, aArea), (bWins, bArea))
|
||||
areaSplit :: Params -> [Window] -> (([Window], Rational), ([Window], Rational))
|
||||
areaSplit params wins = gather [] 0 [] 0 wins
|
||||
where
|
||||
((aWins, aArea), (bWins, bArea)) = gather [] wins 0
|
||||
gather a b t = if t >= (totalArea / 2) then ((a, t), (b, totalArea - t))
|
||||
else gather (head b : a) (tail b) (t + or1 (head b))
|
||||
or1 w = maybe 1 id $ M.lookup w areas
|
||||
gather a aa b ba (r : rs) =
|
||||
if aa <= ba
|
||||
then gather (r : a) (aa + or1 r) b ba rs
|
||||
else gather a aa (r : b) (ba + or1 r) rs
|
||||
gather a aa b ba [] = ((reverse a, aa), (b, ba))
|
||||
or1 w = maybe 1 area $ M.lookup w params
|
||||
|
||||
-- Change requested area for a window.
|
||||
alter :: Areas -> Window -> Rational -> Areas
|
||||
alter areas win delta = case M.lookup win areas of
|
||||
Just v -> M.insert win (v * delta) areas
|
||||
Nothing -> M.insert win delta areas
|
||||
-- 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 _ _ None _ = (0, [])
|
||||
findSplits _ rect (Leaf w) params = (aspectBadness rect w params, [(w, rect)])
|
||||
findSplits depth rect (Node (aArea, aTree) (bArea, bTree)) params =
|
||||
if hBadness < vBadness then (hBadness, hList) else (vBadness, vList)
|
||||
where
|
||||
(hBadness, hList) = trySplit splitHorizontallyBy
|
||||
(vBadness, vList) = trySplit splitVerticallyBy
|
||||
trySplit splitBy =
|
||||
(aBadness + bBadness, aList ++ bList)
|
||||
where
|
||||
(aBadness, aList) = findSplits (depth - 1) aRect aTree params
|
||||
(bBadness, bList) = findSplits (depth - 1) bRect bTree params
|
||||
(aRect, bRect) = splitBy ratio rect
|
||||
ratio = aArea / (aArea + bArea)
|
||||
|
||||
-- Decide how much we like this rectangle.
|
||||
aspectBadness :: Rectangle -> Window -> Params -> Double
|
||||
aspectBadness rect win params =
|
||||
(if a < 1 then tall else wide) * sqrt(w * h)
|
||||
where
|
||||
tall = if w < 700 then ((1 / a) * (700 / w)) else 1 / a
|
||||
wide = if w < 700 then a else (a * w / 700)
|
||||
a = (w / h) / fromRational (maybe 1.5 aspect $ M.lookup win params)
|
||||
w = fromIntegral $ rect_width rect
|
||||
h = fromIntegral $ rect_height rect
|
||||
|
||||
-- vim: sw=4:et
|
||||
|
||||
Reference in New Issue
Block a user