From 3af0d967d18ffbff07a0dd5bb491de9e1cb556bc Mon Sep 17 00:00:00 2001 From: Jamie Webb 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