{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-}
module XMonad.Layout.HintedTile (
HintedTile(..), Orientation(..), Alignment(..)
) where
import XMonad hiding (Tall(..))
import qualified XMonad.StackSet as W
import Control.Monad
data HintedTile a = HintedTile
{ nmaster :: !Int
, delta :: !Rational
, frac :: !Rational
, alignment :: !Alignment
, orientation :: !Orientation
} deriving ( Show, Read )
data Orientation
= Wide
| Tall
deriving ( Show, Read, Eq, Ord )
data Alignment = TopLeft | Center | BottomRight
deriving ( Show, Read, Eq, Ord )
instance LayoutClass HintedTile Window where
doLayout (HintedTile { orientation = o, nmaster = nm, frac = f, alignment = al }) r w' = do
bhs <- mapM mkAdjust w
let (masters, slaves) = splitAt nm bhs
return (zip w (tiler masters slaves), Nothing)
where
w = W.integrate w'
tiler masters slaves
| null masters || null slaves = divide al o (masters ++ slaves) r
| otherwise = split o f r (divide al o masters) (divide al o slaves)
pureMessage c m = fmap resize (fromMessage m) `mplus`
fmap incmastern (fromMessage m)
where
resize Shrink = c { frac = max 0 $ frac c - delta c }
resize Expand = c { frac = min 1 $ frac c + delta c }
incmastern (IncMasterN d) = c { nmaster = max 0 $ nmaster c + d }
description l = show (orientation l)
align :: Alignment -> Position -> Dimension -> Dimension -> Position
align TopLeft p _ _ = p
align Center p a b = p + fromIntegral (a - b) `div` 2
align BottomRight p a b = p + fromIntegral (a - b)
divide :: Alignment -> Orientation -> [D -> D] -> Rectangle -> [Rectangle]
divide _ _ [] _ = []
divide al _ [bh] (Rectangle sx sy sw sh) = [Rectangle (align al sx sw w) (align al sy sh h) w h]
where
(w, h) = bh (sw, sh)
divide al Tall (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle (align al sx sw w) sy w h) :
(divide al Tall bhs (Rectangle sx (sy + fromIntegral h) sw (sh - h)))
where
(w, h) = bh (sw, sh `div` fromIntegral (1 + (length bhs)))
divide al Wide (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle sx (align al sy sh h) w h) :
(divide al Wide bhs (Rectangle (sx + fromIntegral w) sy (sw - w) sh))
where
(w, h) = bh (sw `div` fromIntegral (1 + (length bhs)), sh)
split :: Orientation -> Rational -> Rectangle -> (Rectangle -> [Rectangle])
-> (Rectangle -> [Rectangle]) -> [Rectangle]
split Tall f (Rectangle sx sy sw sh) left right = leftRects ++ rightRects
where
leftw = floor $ fromIntegral sw * f
leftRects = left $ Rectangle sx sy leftw sh
rightx = (maximum . map rect_width) leftRects
rightRects = right $ Rectangle (sx + fromIntegral rightx) sy (sw - rightx) sh
split Wide f (Rectangle sx sy sw sh) top bottom = topRects ++ bottomRects
where
toph = floor $ fromIntegral sh * f
topRects = top $ Rectangle sx sy sw toph
bottomy = (maximum . map rect_height) topRects
bottomRects = bottom $ Rectangle sx (sy + fromIntegral bottomy) sw (sh - bottomy)