aboutsummaryrefslogtreecommitdiffstats
path: root/MosaicAlt.hs
blob: 322c9e868eb48bd4098f4569898a06e20214b2f9 (plain) (blame)
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 = ...
-- >                  , Layout $ 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 , Layout $ 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