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
|
{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable
{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeSynonymInstances #-}
-----------------------------------------------------------------------------
-- |
-- 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
, tallWindowAlt
, wideWindowAlt
, 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 .|. shiftMask, xK_s), withFocused (sendMessage . tallWindowAlt))
-- > , ((modMask .|. shiftMask, xK_d), withFocused (sendMessage . wideWindowAlt))
-- > , ((modMask .|. controlMask, xK_space), sendMessage resetAlt)
-- > ...
-- %import XMonadContrib.MosaicAlt
-- %layout , SomeLayout $ MosaicAlt M.empty
data HandleWindowAlt =
ShrinkWindowAlt Window
| ExpandWindowAlt Window
| TallWindowAlt Window
| WideWindowAlt Window
| ResetAlt
deriving ( Typeable, Eq )
instance Message HandleWindowAlt
shrinkWindowAlt, expandWindowAlt :: Window -> HandleWindowAlt
tallWindowAlt, wideWindowAlt :: Window -> HandleWindowAlt
shrinkWindowAlt = ShrinkWindowAlt
expandWindowAlt = ExpandWindowAlt
tallWindowAlt = TallWindowAlt
wideWindowAlt = WideWindowAlt
resetAlt :: HandleWindowAlt
resetAlt = ResetAlt
data Param = Param { area, aspect :: Rational } deriving ( Show, Read )
type Params = M.Map Window Param
data MosaicAlt a = MosaicAlt Params deriving ( Show, Read )
instance LayoutClass MosaicAlt Window where
description _ = "MosaicAlt"
doLayout (MosaicAlt params) rect stack =
return (arrange rect stack params', Just $ MosaicAlt params')
where
params' = ins (W.up stack) $ ins (W.down stack) $ ins [W.focus stack] params
ins wins as = foldl M.union as $ map (`M.singleton` (Param 1 1.5)) wins
handleMessage (MosaicAlt params) msg = return $ case fromMessage msg of
Just (ShrinkWindowAlt w) -> Just $ MosaicAlt $ alter params w (4 % 5) 1
Just (ExpandWindowAlt w) -> Just $ MosaicAlt $ alter params w (6 % 5) 1
Just (TallWindowAlt w) -> Just $ MosaicAlt $ alter params w 1 (3 % 4)
Just (WideWindowAlt w) -> Just $ MosaicAlt $ alter params w 1 (5 % 4)
Just ResetAlt -> Just $ MosaicAlt M.empty
_ -> Nothing
-- Change requested params for a window.
alter :: Params -> Window -> Rational -> Rational -> Params
alter params win arDelta asDelta = case M.lookup win params of
Just (Param ar as) -> M.insert win (Param (ar * arDelta) (as * asDelta)) params
Nothing -> M.insert win (Param arDelta (1.5 * asDelta)) params
-- Layout algorithm entry point.
arrange :: Rectangle -> W.Stack Window -> Params -> [(Window, Rectangle)]
arrange rect stack params = r
where
(_, r) = findSplits 3 rect tree params
tree = makeTree (sortBy areaCompare wins) params
wins = reverse (W.up stack) ++ W.focus stack : W.down stack
areaCompare a b = or1 b `compare` or1 a
or1 w = maybe 1 area $ M.lookup w params
-- Recursively group windows into a binary tree. Aim to balance the tree
-- according to the total requested area in each branch.
data Tree = Node (Rational, Tree) (Rational, Tree) | Leaf Window | None
makeTree :: [Window] -> Params -> Tree
makeTree wins params = case wins of
[] -> None
[x] -> Leaf x
_ -> Node (aArea, makeTree aWins params) (bArea, makeTree bWins params)
where ((aWins, aArea), (bWins, bArea)) = areaSplit params wins
-- Split a list of windows in half by area.
areaSplit :: Params -> [Window] -> (([Window], Rational), ([Window], Rational))
areaSplit params wins = gather [] 0 [] 0 wins
where
gather a aa b ba (r : rs) =
if aa <= ba
then gather (r : a) (aa + or1 r) b ba rs
else gather a aa (r : b) (ba + or1 r) rs
gather a aa b ba [] = ((reverse a, aa), (b, ba))
or1 w = maybe 1 area $ M.lookup w params
-- Figure out which ways to split the space, by exhaustive search.
-- Complexity is quadratic in the number of windows.
findSplits :: Int -> Rectangle -> Tree -> Params -> (Double, [(Window, Rectangle)])
findSplits _ _ None _ = (0, [])
findSplits _ rect (Leaf w) params = (aspectBadness rect w params, [(w, rect)])
findSplits depth rect (Node (aArea, aTree) (bArea, bTree)) params =
if hBadness < vBadness then (hBadness, hList) else (vBadness, vList)
where
(hBadness, hList) = trySplit splitHorizontallyBy
(vBadness, vList) = trySplit splitVerticallyBy
trySplit splitBy =
(aBadness + bBadness, aList ++ bList)
where
(aBadness, aList) = findSplits (depth - 1) aRect aTree params
(bBadness, bList) = findSplits (depth - 1) bRect bTree params
(aRect, bRect) = splitBy ratio rect
ratio = aArea / (aArea + bArea)
-- Decide how much we like this rectangle.
aspectBadness :: Rectangle -> Window -> Params -> Double
aspectBadness rect win params =
(if a < 1 then tall else wide) * sqrt(w * h)
where
tall = if w < 700 then ((1 / a) * (700 / w)) else 1 / a
wide = if w < 700 then a else (a * w / 700)
a = (w / h) / fromRational (maybe 1.5 aspect $ M.lookup win params)
w = fromIntegral $ rect_width rect
h = fromIntegral $ rect_height rect
-- vim: sw=4:et
|
