From 4866f2e367dfcf22a9591231ba40948826a1b438 Mon Sep 17 00:00:00 2001 From: Spencer Janssen Date: Thu, 1 Nov 2007 21:10:59 +0100 Subject: Hierarchify darcs-hash:20071101201059-a5988-fc1f1262bec1b69e13ba18ae7cefeafc8c4471d4.gz --- XMonad/Layout/MosaicAlt.hs | 163 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 163 insertions(+) create mode 100644 XMonad/Layout/MosaicAlt.hs (limited to 'XMonad/Layout/MosaicAlt.hs') diff --git a/XMonad/Layout/MosaicAlt.hs b/XMonad/Layout/MosaicAlt.hs new file mode 100644 index 0000000..a2b9e6a --- /dev/null +++ b/XMonad/Layout/MosaicAlt.hs @@ -0,0 +1,163 @@ +{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable +{-# LANGUAGE 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 + ) where + +import XMonad +import XMonad.Layouts +import Graphics.X11.Xlib +import qualified XMonad.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 XMonad.Layout.MosaicAlt +-- +-- > layouts = ... +-- > , 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 XMonad.Layout.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 -- cgit v1.2.3