{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts #-}
module XMonad.Layout.AutoMaster (
autoMaster, AutoMaster
) where
import Control.Monad
import XMonad
import qualified XMonad.StackSet as W
import XMonad.Layout.LayoutModifier
data AutoMaster a = AutoMaster Int Float Float
deriving (Read,Show)
instance (Eq w) => LayoutModifier AutoMaster w where
modifyLayout (AutoMaster k bias _) = autoLayout k bias
pureMess = autoMess
autoMess :: AutoMaster a -> SomeMessage -> Maybe (AutoMaster a)
autoMess (AutoMaster k bias delta) m = msum [fmap resize (fromMessage m),
fmap incmastern (fromMessage m)]
where incmastern (IncMasterN d) = AutoMaster (max 1 (k+d)) bias delta
resize Expand = AutoMaster k (min ( 0.4) $ bias+delta) delta
resize Shrink = AutoMaster k (max (-0.4) $ bias-delta) delta
autoLayout :: (Eq w, LayoutClass l w) =>
Int ->
Float ->
W.Workspace WorkspaceId (l w) w
-> Rectangle
-> X ([(w, Rectangle)], Maybe (l w))
autoLayout k bias wksp rect = do
let stack = W.stack wksp
let ws = W.integrate' stack
let n = length ws
if null ws then
runLayout wksp rect
else do
if (n<=k) then
return ((divideRow rect ws),Nothing)
else do
let master = take k ws
let filtStack = stack >>= W.filter (\w -> not (w `elem` master))
wrs <- runLayout (wksp {W.stack = filtStack}) (slaveRect rect n bias)
return ((divideRow (masterRect rect n bias) master) ++ (fst wrs),
snd wrs)
masterHeight :: Int -> Float -> Float
masterHeight n bias = (calcHeight n) + bias
where calcHeight :: Int -> Float
calcHeight 1 = 1.0
calcHeight m = if (m<9) then (43/45) - (fromIntegral m)*(7/90) else (1/3)
masterRect :: Rectangle -> Int -> Float -> Rectangle
masterRect (Rectangle sx sy sw sh) n bias = Rectangle sx sy sw h
where h = round $ (fromIntegral sh)*(masterHeight n bias)
slaveRect :: Rectangle -> Int -> Float -> Rectangle
slaveRect (Rectangle sx sy sw sh) n bias = Rectangle sx (sy+mh) sw h
where mh = round $ (fromIntegral sh)*(masterHeight n bias)
h = round $ (fromIntegral sh)*(1-masterHeight n bias)
divideRow :: Rectangle -> [a] -> [(a, Rectangle)]
divideRow (Rectangle x y w h) ws = zip ws rects
where n = length ws
oneW = fromIntegral w `div` n
oneRect = Rectangle x y (fromIntegral oneW) h
rects = take n $ iterate (shiftR (fromIntegral oneW)) oneRect
shiftR :: Position -> Rectangle -> Rectangle
shiftR s (Rectangle x y w h) = Rectangle (x+s) y w h
autoMaster :: LayoutClass l a =>
Int ->
Float ->
l a ->
ModifiedLayout AutoMaster l a
autoMaster nmaster delta = ModifiedLayout (AutoMaster nmaster 0 delta)