mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 03:20:21 -07:00
171 lines
6.6 KiB
Haskell
171 lines
6.6 KiB
Haskell
{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeSynonymInstances #-}
|
|
|
|
-----------------------------------------------------------------------------
|
|
-- |
|
|
-- Module : XMonad.Layout.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 XMonad.Layout.MosaicAlt (
|
|
-- * Usage:
|
|
-- $usage
|
|
MosaicAlt(..)
|
|
, shrinkWindowAlt
|
|
, expandWindowAlt
|
|
, tallWindowAlt
|
|
, wideWindowAlt
|
|
, resetAlt
|
|
|
|
, Params, Param
|
|
, HandleWindowAlt
|
|
) where
|
|
|
|
import XMonad
|
|
import qualified XMonad.StackSet as W
|
|
import qualified Data.Map as M
|
|
import Data.List ( sortBy )
|
|
import Data.Ratio
|
|
|
|
-- $usage
|
|
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
|
--
|
|
-- > import XMonad.Layout.MosaicAlt
|
|
-- > import qualified Data.Map as M
|
|
--
|
|
-- Then edit your @layoutHook@ by adding the MosaicAlt layout:
|
|
--
|
|
-- > myLayout = MosaicAlt M.empty ||| Full ||| etc..
|
|
-- > main = xmonad def { layoutHook = myLayout }
|
|
--
|
|
-- For more detailed instructions on editing the layoutHook see:
|
|
--
|
|
-- "XMonad.Doc.Extending#Editing_the_layout_hook"
|
|
--
|
|
-- In the key-bindings, do something like:
|
|
--
|
|
-- > , ((modm .|. shiftMask , xK_a ), withFocused (sendMessage . expandWindowAlt))
|
|
-- > , ((modm .|. shiftMask , xK_z ), withFocused (sendMessage . shrinkWindowAlt))
|
|
-- > , ((modm .|. shiftMask , xK_s ), withFocused (sendMessage . tallWindowAlt))
|
|
-- > , ((modm .|. shiftMask , xK_d ), withFocused (sendMessage . wideWindowAlt))
|
|
-- > , ((modm .|. controlMask, xK_space), sendMessage resetAlt)
|
|
-- > ...
|
|
--
|
|
-- For detailed instruction on editing the key binding see:
|
|
--
|
|
-- "XMonad.Doc.Extending#Editing_key_bindings".
|
|
|
|
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
|