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
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
|
module XMonadContrib.Mosaic ( mosaic, expandWindow, shrinkWindow, squareWindow ) where
-- This module defines a "mosaic" layout, which tries to give all windows
-- equal area, while also trying to give them a user-defined (and run-time
-- adjustable) aspect ratio. You can use mod-l and mod-h to adjust the
-- aspect ratio (which probably won't have a very interesting effect unless
-- you've got a number of windows upen.
-- My intent is to extend this layout to optimize various constraints, such
-- as windows that should have a different aspect ratio, a fixed size, or
-- minimum dimensions in certain directions.
-- You can use this module with the following in your config file:
-- import XMonadContrib.Mosaic
-- import Control.Monad.State ( gets )
-- import qualified StackSet as W ( peek )
-- defaultLayouts :: [Layout]
-- defaultLayouts = [ mosaic (1%4) (1%2) M.empty M.empty, full,
-- tall defaultDelta (1%2), wide defaultDelta (1%2) ]
-- In the key-bindings, do something like:
-- , ((modMask .|. shiftMask, xK_h ), do ws <- gets workspace
-- whenJust (W.peek ws) $ \w ->
-- layoutMsg (shrinkWindow w))
-- , ((modMask .|. shiftMask, xK_l ), do ws <- gets workspace
-- whenJust (W.peek ws) $ \w ->
-- layoutMsg (expandWindow w))
-- , ((modMask .|. shiftMask, xK_s ), do ws <- gets workspace
-- whenJust (W.peek ws) $ \w ->
-- layoutMsg (squareWindow w))
import Data.Ratio
import Graphics.X11.Xlib
import XMonad
import Operations ( ShrinkOrExpand (Shrink, Expand) )
import qualified Data.Map as M
import Data.List ( sort )
import Data.Dynamic ( Typeable, fromDynamic )
import Control.Monad ( mplus )
import System.IO.Unsafe
data HandleWindow = ExpandWindow Window | ShrinkWindow Window | SquareWindow Window
deriving ( Typeable, Eq )
expandWindow, shrinkWindow, squareWindow :: Window -> HandleWindow
expandWindow = ExpandWindow
shrinkWindow = ShrinkWindow
squareWindow = SquareWindow
mosaic :: Rational -> Rational -> M.Map Window WindowRater -> M.Map Window Area -> Layout
mosaic delta tileFrac raters areas = Layout { doLayout = mosaicL tileFrac raters areas
, modifyLayout = mlayout }
where mlayout x = (m1 `fmap` fromDynamic x) `mplus` (m2 `fmap` fromDynamic x)
m1 Shrink = mosaic delta (tileFrac/(1+delta)) raters areas
m1 Expand = mosaic delta (tileFrac*(1+delta)) raters areas
m2 (ExpandWindow w) = mosaic delta tileFrac raters
-- (add_rater (\_ (Rectangle _ _ wid h) -> delta*(1-wid///h)) w raters)
(multiply_area (1+delta) w areas)
m2 (ShrinkWindow w) = mosaic delta tileFrac raters
-- (add_rater (\_ (Rectangle _ _ wid h) -> delta*(wid///h-1)) w raters)
(multiply_area (1/(1+ delta)) w areas)
m2 (SquareWindow w) = mosaic delta tileFrac (M.insert w force_square raters) areas
force_square _ (Rectangle _ _ a b) = 100*(sqr(a///b) + sqr(b///a))
sqr a = a * a
mytrace :: String -> a -> a
mytrace s a = seq foo a
where foo = unsafePerformIO $ appendFile "/tmp/xmonad.trace" (s++"\n")
myerror :: String -> a
myerror s = seq foo $ error s
where foo = unsafePerformIO $ appendFile "/tmp/xmonad.trace" (s++"\n")
multiply_area :: Area -> Window -> M.Map Window Area -> M.Map Window Area
multiply_area a w = M.alter (Just . f) w where f Nothing = a
f (Just a') = a'*a
add_rater :: WindowRater -> Window -> M.Map Window WindowRater -> M.Map Window WindowRater
add_rater r w = M.alter f w where f Nothing= Just r
f (Just r') = Just $ \foo bar -> r foo bar + r' foo bar
type WindowRater = Window -> Rectangle -> Rational
mosaicL :: Rational -> M.Map Window WindowRater -> M.Map Window Area
-> Rectangle -> [Window] -> [(Window, Rectangle)]
mosaicL _ _ _ _ [] = []
mosaicL f raters areas origRect origws
= flattenMosaic $ the_value $ if myv < myh then myv else myh
where mean_area = area origRect / fromIntegral (length origws)
myv = my_mosaic origRect Vertical sortedws
myh = my_mosaic origRect Horizontal sortedws
sortedws = reverse $ map the_value $ sort $ map (\w -> Rated (sumareas [w]) w) origws
my_mosaic :: Rectangle -> CutDirection -> [Window]
-> Rated Rational (Mosaic (Window, Rectangle))
my_mosaic _ _ [] = Rated 0 $ M []
my_mosaic r _ [w] = Rated (rating w r) $ OM (w,r)
my_mosaic r d ws = minL $
map (fmap M . catRated .
map (\(ws',r') -> my_mosaic r' (otherDirection d) ws')) $
map (\ws' -> zip ws' $ partitionR d r $ map sumareas ws') $
init $ allsplits ws
where minL [] = myerror "minL on empty list"
minL [a] = a
minL (a:b:c) = minL (min a b:c)
partitionR :: CutDirection -> Rectangle -> [Area] -> [Rectangle]
partitionR _ _ [] = []
partitionR _ r [_] = [r]
partitionR d r (a:ars) = r1 : partitionR d r2 ars
where totarea = sum (a:ars)
(r1,r2) = split d (a/totarea) r
rating :: WindowRater
rating w r = (M.findWithDefault default_preferences w raters) w r
default_preferences :: WindowRater
default_preferences _ r@(Rectangle _ _ w h)
| fr <- w /// h = sqr(fr/f)+sqr(f/fr)-2+ toRational (mean_area/area r)
sqr a = a * a
sumareas ws = sum $ map (\w -> M.findWithDefault 1 w areas) ws
catRated :: Num v => [Rated v a] -> Rated v [a]
catRated xs = Rated (sum $ map the_rating xs) (map the_value xs)
data Rated a b = Rated !a !b
instance Functor (Rated a) where
f `fmap` (Rated v a) = Rated v (f a)
the_value :: Rated a b -> b
the_value (Rated _ b) = b
the_rating :: Rated a b -> a
the_rating (Rated a _) = a
instance Eq a => Eq (Rated a b) where
(Rated a _) == (Rated a' _) = a == a'
instance Ord a => Ord (Rated a b) where
compare (Rated a _) (Rated a' _) = compare a a'
type Area = Rational
area :: Rectangle -> Area
area (Rectangle _ _ w h) = fromIntegral w * fromIntegral h
(///) :: (Integral a, Integral b) => a -> b -> Rational
a /// b = fromIntegral a / fromIntegral b
split :: CutDirection -> Rational -> Rectangle -> (Rectangle, Rectangle)
split Vertical frac (Rectangle sx sy sw sh) = (Rectangle sx sy sw h,
Rectangle sx (sy+fromIntegral h) sw (sh-h))
where h = floor $ fromIntegral sh * frac
split Horizontal frac (Rectangle sx sy sw sh) = (Rectangle sx sy w sh,
Rectangle (sx+fromIntegral w) sy (sw-w) sh)
where w = floor $ fromIntegral sw * frac
data CutDirection = Vertical | Horizontal
otherDirection :: CutDirection -> CutDirection
otherDirection Vertical = Horizontal
otherDirection Horizontal = Vertical
data Mosaic a where
M :: [Mosaic a] -> Mosaic a
OM :: a -> Mosaic a
flattenMosaic :: Mosaic a -> [a]
flattenMosaic (OM a) = [a]
flattenMosaic (M xs) = concatMap flattenMosaic xs
allsplits :: [a] -> [[[a]]]
allsplits [] = [[[]]]
allsplits [a] = [[[a]]]
allsplits (x:xs) = (map ([x]:) splitsrest) ++
(map (maphead (x:)) splitsrest)
where splitsrest = allsplits xs
maphead :: (a->a) -> [a] -> [a]
maphead f (x:xs) = f x : xs
maphead _ [] = []
|
