From 3af0d967d18ffbff07a0dd5bb491de9e1cb556bc Mon Sep 17 00:00:00 2001
From: Jamie Webb <gentoo-haskell@vcs.intern>
Date: Wed, 3 Oct 2007 18:25:33 +0200
Subject: MosaicAlt take 2
darcs-hash:20071003162533-74a73-ff23fa3763a1203efa54162b8919c38f1e1887c0.gz
---
MosaicAlt.hs | 127 +++++++++++++++++++++++++++++++++++------------------------
1 file changed, 76 insertions(+), 51 deletions(-)
diff --git a/MosaicAlt.hs b/MosaicAlt.hs
index 715fbf0..a5308e3 100644
--- a/MosaicAlt.hs
+++ b/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
+-- 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
+
-- Layout algorithm entry point.
-arrange :: Rectangle -> W.Stack Window -> Areas -> [(Window, Rectangle)]
-arrange rect stack areas = tree rect (sortBy areaCompare winList) totalArea areas
+arrange :: Rectangle -> W.Stack Window -> Params -> [(Window, Rectangle)]
+arrange rect stack params = r
where
- winList = reverse (W.up stack) ++ W.focus stack : W.down stack
- totalArea = areaSum areas winList
+ (_, 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 id $ M.lookup w areas
-
--- 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
- 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
+ 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
+ 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
+
+-- 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
- ((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
+ (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)
--- 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
+-- 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
--
cgit v1.2.3