gapless tiled layout obeying size hints

darcs-hash:20070605071716-06a25-876a9fdc91cc274e78d5dc0306002c6d2f2775ad.gz

1 files changed, 66 insertions, 0 deletions

diff --git a/HintedTile.hs b/HintedTile.hs
new file mode 100644
index 0000000..f3a811a
--- /dev/null
+++ b/HintedTile.hs
@@ -0,0 +1,66 @@
+module XMonadContrib.HintedTile (tall, wide) where
+
+import XMonad
+import Operations (Resize(..), IncMasterN(..), applySizeHints)
+import {-# SOURCE #-} Config (borderWidth)
+import Graphics.X11.Xlib
+import Graphics.X11.Xlib.Extras
+import Control.Monad
+
+-- this sucks
+addBorder, substractBorder :: (Dimension, Dimension) -> (Dimension, Dimension)
+addBorder (w, h) = (w + 2 * borderWidth, h + 2 * borderWidth)
+substractBorder (w, h) = (w - 2 * borderWidth, h - 2 * borderWidth)
+
+
+tall, wide :: Int -> Rational -> Rational -> Layout
+wide = tile splitVertically divideHorizontally
+tall = tile splitHorizontally divideVertically
+
+tile split divide nmaster delta frac =
+    Layout { doLayout     = \r w -> do { hints <- sequence (map getHints w)
+                                      ; return $ zip w (tiler frac r `uncurry` splitAt nmaster hints) }
+           , modifyLayout = \m -> fmap resize     (fromMessage m) `mplus`
+                                  fmap incmastern (fromMessage m) }
+
+    where resize Shrink = tile split divide nmaster delta (frac-delta)
+          resize Expand = tile split divide nmaster delta (frac+delta)
+          incmastern (IncMasterN d) = tile split divide (max 0 (nmaster+d)) delta frac
+
+          tiler f r masters slaves = if null masters || null slaves
+              then divide (masters ++ slaves) r
+              else split f r (divide masters) (divide slaves)
+
+getHints :: Window -> X SizeHints
+getHints w = withDisplay $ \d -> io $ getWMNormalHints d w
+
+--
+-- Divide the screen vertically (horizontally) into n subrectangles
+--
+divideVertically, divideHorizontally :: [SizeHints] -> Rectangle -> [Rectangle]
+divideVertically [] _ = [] -- there's a fold here, struggling to get out
+divideVertically (hints:rest) (Rectangle sx sy sw sh) = (Rectangle sx sy w h) :
+      (divideVertically rest (Rectangle sx (sy + fromIntegral h) sw (sh - h)))
+    where (w, h) = addBorder $ applySizeHints hints $ substractBorder
+                   (sw, sh `div` fromIntegral (1 + (length rest)))
+
+divideHorizontally [] _ = []
+divideHorizontally (hints:rest) (Rectangle sx sy sw sh) = (Rectangle sx sy w h) :
+      (divideHorizontally rest (Rectangle (sx + fromIntegral w) sy (sw - w) sh))
+    where (w, h) = addBorder $ applySizeHints hints $ substractBorder
+                   (sw `div` fromIntegral (1 + (length rest)), sh)
+
+
+-- Split the screen into two rectangles, using a rational to specify the ratio
+splitHorizontally, splitVertically :: Rational -> Rectangle -> (Rectangle -> [Rectangle]) -> (Rectangle -> [Rectangle]) -> [Rectangle]
+splitHorizontally f (Rectangle sx sy sw sh) left right = leftRects ++ rightRects
+    where leftw = floor $ fromIntegral sw * f
+          leftRects = left $ Rectangle sx sy leftw sh
+          rightx = (maximum . map rect_width) leftRects
+          rightRects = right $ Rectangle (sx + fromIntegral rightx) sy (sw - rightx) sh
+
+splitVertically f (Rectangle sx sy sw sh) top bottom = topRects ++ bottomRects
+    where toph = floor $ fromIntegral sh * f
+          topRects = top $ Rectangle sx sy sw toph
+          bottomy = (maximum . map rect_height) topRects
+          bottomRects = bottom $ Rectangle sx (sy + fromIntegral bottomy) sw (sh - bottomy)