An alternative mosaic layout implementation

MetaModule.hs

@@ -46,6 +46,7 @@ import XMonadContrib.LayoutScreens ()
 import XMonadContrib.MagicFocus ()
 import XMonadContrib.Magnifier ()
 import XMonadContrib.Mosaic ()
+import XMonadContrib.MosaicAlt ()
 import XMonadContrib.NamedWindows ()
 import XMonadContrib.NoBorders ()
 import XMonadContrib.Roledex ()

MosaicAlt.hs

@@ -0,0 +1,136 @@
+{-# OPTIONS -fglasgow-exts #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonadContrib.MosaicAlt
+-- 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 XMonadContrib.MosaicAlt (
+        -- * Usage:
+        -- $usage
+        MosaicAlt(..)
+        , shrinkWindowAlt
+        , expandWindowAlt
+        , resetAlt
+    ) where
+
+import XMonad
+import Operations
+import Graphics.X11.Xlib
+import qualified StackSet as W
+import qualified Data.Map as M
+import Data.List ( sortBy )
+import Data.Ratio
+import Graphics.X11.Types ( Window )
+
+-- $usage
+-- You can use this module with the following in your configuration file:
+--
+-- > import XMonadContrib.MosaicAlt
+--
+-- > defaultLayouts = ...
+-- >                  , SomeLayout $ MosaicAlt M.empty
+-- >                  ...
+--
+-- > keys = ...
+-- >     , ((modMask .|. shiftMask, xK_a), withFocused (sendMessage . expandWindowAlt))
+-- >     , ((modMask .|. shiftMask, xK_z), withFocused (sendMessage . shrinkWindowAlt))
+-- >     , ((modMask .|. controlMask, xK_space), sendMessage resetAlt)
+-- >     ...
+
+-- %import XMonadContrib.MosaicAlt
+-- %layout , SomeLayout $ MosaicAlt M.empty
+
+data HandleWindowAlt =
+    ShrinkWindowAlt Window
+    | ExpandWindowAlt Window
+    | ResetAlt
+    deriving ( Typeable, Eq )
+instance Message HandleWindowAlt
+shrinkWindowAlt, expandWindowAlt :: Window -> HandleWindowAlt
+shrinkWindowAlt = ShrinkWindowAlt
+expandWindowAlt = ExpandWindowAlt
+resetAlt :: HandleWindowAlt
+resetAlt = ResetAlt
+
+type Areas = M.Map Window Rational
+data MosaicAlt a = MosaicAlt Areas deriving ( Show, Read )
+
+instance Layout MosaicAlt Window where
+    description _ = "MosaicAlt"
+    doLayout (MosaicAlt areas) rect stack =
+            return (arrange rect stack areas', Just $ MosaicAlt areas')
+        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
+
+    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)
+        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
+
+-- 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
+
+-- 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)
+
+-- 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))
+    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
+
+-- 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
+
+-- vim: sw=4:et