1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Layout.HintedTile
-- Copyright : (c) Peter De Wachter <pdewacht@gmail.com>
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : Peter De Wachter <pdewacht@gmail.com>
-- Stability : unstable
-- Portability : unportable
--
-- A gapless tiled layout that attempts to obey window size hints,
-- rather than simply ignoring them.
--
-----------------------------------------------------------------------------
module XMonad.Layout.HintedTile (
-- * Usage
-- $usage
tall, wide) where
import XMonad
import XMonad.Operations (Resize(..), IncMasterN(..), applySizeHints)
import qualified XMonad.StackSet as W
import {-# SOURCE #-} Config (borderWidth)
import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras
import Control.Monad
-- $usage
-- You can use this module with the following in your Config.hs file:
--
-- > import qualified XMonad.Layout.HintedTile
--
-- > layouts = [ XMonad.Layout.HintedTile.tall nmaster delta ratio, ... ]
-- %import qualified XMonad.Layout.HintedTile
--
-- %layout , XMonad.Layout.HintedTile.tall nmaster delta ratio
-- 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 Window
wide = tile splitVertically divideHorizontally
tall = tile splitHorizontally divideVertically
tile split divide nmaster delta frac =
Layout { doLayout = \r w' -> let w = W.integrate w'
in do { hints <- sequence (map getHints w)
; return (zip w (tiler frac r `uncurry` splitAt nmaster hints)
, Nothing) }
, modifyLayout = \m -> return $ 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)
|
