{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
module XMonad.Layout.Cross(
simpleCross
, Cross(..) ) where
import XMonad( Dimension, Rectangle(..), LayoutClass(..), Resize(..), fromMessage )
import XMonad.StackSet( focus, up, down )
import Control.Monad( msum )
(<%>) :: Dimension -> Rational -> Dimension
d <%> f = floor $ f * (fromIntegral d)
data Cross a = Cross {
crossProp :: !Rational,
crossInc :: !Rational
}
deriving( Show, Read )
simpleCross :: Cross a
simpleCross = Cross (4/5) (1/100)
instance LayoutClass Cross a where
pureLayout (Cross f _) r s = [(focus s, mainRect r f)] ++
(zip winCycle (upRects r f)) ++
(zip (reverse winCycle) (downRects r f))
where winCycle = (up s) ++ (reverse (down s))
pureMessage (Cross f d) m = msum [fmap resize (fromMessage m)]
where resize Shrink = Cross (max (1/100) $ f - d) d
resize Expand = Cross (min 1 $ f + d) d
description _ = "Cross"
mainRect :: Rectangle -> Rational -> Rectangle
mainRect (Rectangle rx ry rw rh) f = Rectangle
(rx + (fromIntegral (rw <%> invf)))
(ry + (fromIntegral (rh <%> invf)))
(rw <%> f) (rh <%> f)
where invf = (1/2) * (1-f)
upRects :: Rectangle -> Rational -> [Rectangle]
upRects r f = [topRectangle r nf, rightRectangle r nf]
where nf = f * (8/10)
downRects :: Rectangle -> Rational -> [Rectangle]
downRects r f = [bottomRectangle r nf, leftRectangle r nf]
where nf = f * (8/10)
topRectangle :: Rectangle -> Rational -> Rectangle
topRectangle (Rectangle rx ry rw rh) f = Rectangle
(rx + (fromIntegral (rw <%> ((1-f)*(1/2)))))
ry
(rw <%> f) (rh <%> ((1-f)*(1/2)))
rightRectangle :: Rectangle -> Rational -> Rectangle
rightRectangle (Rectangle rx ry rw rh) f = Rectangle
(rx + (fromIntegral (rw - (rw <%> (1/2)))))
(ry + (fromIntegral (rh <%> ((1-f)*(1/2)))))
(rw <%> (1/2)) (rh <%> f)
bottomRectangle :: Rectangle -> Rational -> Rectangle
bottomRectangle (Rectangle rx ry rw rh) f = Rectangle
(rx + (fromIntegral (rw <%> ((1-f)*(1/2)))))
(ry + (fromIntegral (rh - (rh <%> ((1-f)*(1/2))))))
(rw <%> f) (rh <%> ((1-f)*(1/2)))
leftRectangle :: Rectangle -> Rational -> Rectangle
leftRectangle (Rectangle rx ry rw rh) f = Rectangle
rx
(ry + (fromIntegral (rh <%> ((1-f)*(1/2)))))
(rw <%> (1/2)) (rh <%> f)