From ee995e4d26a9c081acfc7da86bc9f0cdf9e293d8 Mon Sep 17 00:00:00 2001 From: Spencer Janssen Date: Thu, 22 Nov 2007 06:11:57 +0100 Subject: HintedTile: - code formatting - refactoring, based on TilePrime work by Eric Mertens - use the current border width of the window, this improves interaction with the No/SmartBorders extensions darcs-hash:20071122051157-a5988-ef674af0e5eb146e654fbf7d60708b4519a90f4d.gz --- XMonad/Layout/HintedTile.hs | 96 ++++++++++++++++++++++++--------------------- 1 file changed, 51 insertions(+), 45 deletions(-) (limited to 'XMonad') diff --git a/XMonad/Layout/HintedTile.hs b/XMonad/Layout/HintedTile.hs index 0f9d766..ff79601 100644 --- a/XMonad/Layout/HintedTile.hs +++ b/XMonad/Layout/HintedTile.hs @@ -21,11 +21,12 @@ module XMonad.Layout.HintedTile ( HintedTile(..), Orientation(..)) where import XMonad -import XMonad.Layouts ( Resize(..), IncMasterN(..) ) -import XMonad.Operations ( applySizeHints ) +import XMonad.Layouts (Resize(..), IncMasterN(..)) +import XMonad.Operations (applySizeHints, D) import qualified XMonad.StackSet as W import Graphics.X11.Xlib import Graphics.X11.Xlib.Extras +import Control.Applicative ((<$>)) import Control.Monad.Reader -- $usage @@ -51,61 +52,66 @@ data HintedTile a = HintedTile data Orientation = Wide | Tall deriving ( Show, Read ) instance LayoutClass HintedTile Window where - doLayout c rect w' = let w = W.integrate w' - in do { hints <- sequence (map getHints w) - ; b <- asks (borderWidth . config) - ; return (zip w (tiler b (frac c) rect `uncurry` splitAt (nmaster c) hints) - , Nothing) } - where - (split, divide) = - case orientation c of - Tall -> (splitHorizontally, divideVertically) - Wide -> (splitVertically, divideHorizontally) - tiler b f r masters slaves = - if null masters || null slaves - then divide b (masters ++ slaves) r - else split f r (divide b masters) (divide b slaves) + doLayout c rect w' = do + bhs <- mapM getHints w + let (masters, slaves) = splitAt (nmaster c) bhs + return (zip w (tiler (frac c) rect masters slaves), Nothing) + where + w = W.integrate w' + (split, divide) = case orientation c of + Tall -> (splitHorizontally, divideVertically) + Wide -> (splitVertically, divideHorizontally) + tiler f r masters slaves + | null masters || null slaves = divide (masters ++ slaves) r + | otherwise = split f r (divide masters) (divide slaves) pureMessage c m = fmap resize (fromMessage m) `mplus` fmap incmastern (fromMessage m) - where - resize Shrink = c { frac = max 0 $ frac c - delta c } - resize Expand = c { frac = min 1 $ frac c + delta c } - incmastern (IncMasterN d) = c { nmaster = max 0 $ nmaster c + d } + where + resize Shrink = c { frac = max 0 $ frac c - delta c } + resize Expand = c { frac = min 1 $ frac c + delta c } + incmastern (IncMasterN d) = c { nmaster = max 0 $ nmaster c + d } description l = "HintedTile " ++ show (orientation l) -addBorder, substractBorder :: Dimension -> (Dimension, Dimension) -> (Dimension, Dimension) -addBorder b (w, h) = (w + 2 * b, h + 2 * b) -substractBorder b (w, h) = (w - 2 * b, h - 2 * b) +adjBorder :: Dimension -> Dimension -> D -> D +adjBorder n b (w, h) = (w + n * 2 * b, h + n * 2 * b) -getHints :: Window -> X SizeHints -getHints w = withDisplay $ \d -> io $ getWMNormalHints d w +-- | Transform a function on dimensions into one without regard for borders +hintsUnderBorder :: (Dimension, SizeHints) -> D -> D +hintsUnderBorder (bW, h) = adjBorder bW 1 . applySizeHints h . adjBorder bW (-1) + +getHints :: Window -> X (Dimension, SizeHints) +getHints w = withDisplay $ \d -> io $ liftM2 (,) + (fromIntegral . wa_border_width <$> getWindowAttributes d w) + (getWMNormalHints d w) -- Divide the screen vertically (horizontally) into n subrectangles -divideVertically, divideHorizontally :: Dimension -> [SizeHints] -> Rectangle -> [Rectangle] -divideVertically _ [] _ = [] -- there's a fold here, struggling to get out -divideVertically b (hints:rest) (Rectangle sx sy sw sh) = (Rectangle sx sy w h) : - (divideVertically b rest (Rectangle sx (sy + fromIntegral h) sw (sh - h))) - where (w, h) = addBorder b $ applySizeHints hints $ substractBorder b - (sw, sh `div` fromIntegral (1 + (length rest))) +divideVertically, divideHorizontally :: [(Dimension, SizeHints)] -> Rectangle -> [Rectangle] +divideVertically [] _ = [] -- there's a fold here, struggling to get out +divideVertically (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle sx sy w h) : + (divideVertically bhs (Rectangle sx (sy + fromIntegral h) sw (sh - h))) + where (w, h) = hintsUnderBorder bh (sw, sh `div` fromIntegral (1 + (length bhs))) -divideHorizontally _ [] _ = [] -divideHorizontally b (hints:rest) (Rectangle sx sy sw sh) = (Rectangle sx sy w h) : - (divideHorizontally b rest (Rectangle (sx + fromIntegral w) sy (sw - w) sh)) - where (w, h) = addBorder b $ applySizeHints hints $ substractBorder b - (sw `div` fromIntegral (1 + (length rest)), sh) +divideHorizontally [] _ = [] +divideHorizontally (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle sx sy w h) : + (divideHorizontally bhs (Rectangle (sx + fromIntegral w) sy (sw - w) sh)) + where + (w, h) = hintsUnderBorder bh (sw `div` fromIntegral (1 + (length bhs)), sh) -- Split the screen into two rectangles, using a rational to specify the ratio -splitHorizontally, splitVertically :: Rational -> Rectangle -> (Rectangle -> [Rectangle]) -> (Rectangle -> [Rectangle]) -> [Rectangle] +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 + 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) + 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) -- cgit v1.2.3