{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}
module XMonad.Layout.Drawer
(
simpleDrawer
, drawer
, onLeft, onTop, onRight, onBottom
, module XMonad.Util.WindowProperties
, Drawer, Reflected
) where
import XMonad
import XMonad.Layout.LayoutModifier
import XMonad.Util.WindowProperties
import XMonad.StackSet as S
import XMonad.Layout.Reflect
data Drawer l a = Drawer Rational Rational Property (l a)
deriving (ReadPrec [Drawer l a]
ReadPrec (Drawer l a)
Int -> ReadS (Drawer l a)
ReadS [Drawer l a]
(Int -> ReadS (Drawer l a))
-> ReadS [Drawer l a]
-> ReadPrec (Drawer l a)
-> ReadPrec [Drawer l a]
-> Read (Drawer l a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (l :: * -> *) a. Read (l a) => ReadPrec [Drawer l a]
forall (l :: * -> *) a. Read (l a) => ReadPrec (Drawer l a)
forall (l :: * -> *) a. Read (l a) => Int -> ReadS (Drawer l a)
forall (l :: * -> *) a. Read (l a) => ReadS [Drawer l a]
$creadsPrec :: forall (l :: * -> *) a. Read (l a) => Int -> ReadS (Drawer l a)
readsPrec :: Int -> ReadS (Drawer l a)
$creadList :: forall (l :: * -> *) a. Read (l a) => ReadS [Drawer l a]
readList :: ReadS [Drawer l a]
$creadPrec :: forall (l :: * -> *) a. Read (l a) => ReadPrec (Drawer l a)
readPrec :: ReadPrec (Drawer l a)
$creadListPrec :: forall (l :: * -> *) a. Read (l a) => ReadPrec [Drawer l a]
readListPrec :: ReadPrec [Drawer l a]
Read, Int -> Drawer l a -> ShowS
[Drawer l a] -> ShowS
Drawer l a -> String
(Int -> Drawer l a -> ShowS)
-> (Drawer l a -> String)
-> ([Drawer l a] -> ShowS)
-> Show (Drawer l a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (l :: * -> *) a. Show (l a) => Int -> Drawer l a -> ShowS
forall (l :: * -> *) a. Show (l a) => [Drawer l a] -> ShowS
forall (l :: * -> *) a. Show (l a) => Drawer l a -> String
$cshowsPrec :: forall (l :: * -> *) a. Show (l a) => Int -> Drawer l a -> ShowS
showsPrec :: Int -> Drawer l a -> ShowS
$cshow :: forall (l :: * -> *) a. Show (l a) => Drawer l a -> String
show :: Drawer l a -> String
$cshowList :: forall (l :: * -> *) a. Show (l a) => [Drawer l a] -> ShowS
showList :: [Drawer l a] -> ShowS
Show)
partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a])
partitionM :: forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m ([a], [a])
partitionM a -> m Bool
_ [] = ([a], [a]) -> m ([a], [a])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [])
partitionM a -> m Bool
f (a
x:[a]
xs) = do
b <- a -> m Bool
f a
x
(ys, zs) <- partitionM f xs
return $ if b
then (x:ys, zs)
else (ys, x:zs)
instance (LayoutClass l Window, Read (l Window)) => LayoutModifier (Drawer l) Window where
modifyLayout :: forall (l :: * -> *).
LayoutClass l Window =>
Drawer l Window
-> Workspace String (l Window) Window
-> Rectangle
-> X ([(Window, Rectangle)], Maybe (l Window))
modifyLayout (Drawer Rational
rs Rational
rb Property
p l Window
l) Workspace String (l Window) Window
ws Rectangle
rect =
case Workspace String (l Window) Window -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
stack Workspace String (l Window) Window
ws of
Maybe (Stack Window)
Nothing -> Workspace String (l Window) Window
-> Rectangle -> X ([(Window, Rectangle)], Maybe (l Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout Workspace String (l Window) Window
ws Rectangle
rect
Just stk :: Stack Window
stk@Stack{ up :: forall a. Stack a -> [a]
up=[Window]
up_, down :: forall a. Stack a -> [a]
down=[Window]
down_, focus :: forall a. Stack a -> a
S.focus=Window
w } -> do
(upD, upM) <- (Window -> X Bool) -> [Window] -> X ([Window], [Window])
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m ([a], [a])
partitionM (Property -> Window -> X Bool
hasProperty Property
p) [Window]
up_
(downD, downM) <- partitionM (hasProperty p) down_
b <- hasProperty p w
focusedWindow <- gets (fmap S.focus . stack . workspace . current . windowset)
let rectD = if Bool
b Bool -> Bool -> Bool
&& Window -> Maybe Window
forall a. a -> Maybe a
Just Window
w Maybe Window -> Maybe Window -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Window
focusedWindow then Rectangle
rectB else Rectangle
rectS
let (stackD, stackM) = if b
then ( Just $ stk { up=upD, down=downD }
, mkStack upM downM )
else ( mkStack upD downD
, Just $ stk { up=upM, down=downM } )
(winsD, _) <- runLayout (ws { layout=l, stack=stackD }) rectD
(winsM, u') <- runLayout (ws { stack=stackM }) rectM
return (winsD ++ winsM, u')
where
mkStack :: [a] -> [a] -> Maybe (Stack a)
mkStack [] [] = Maybe (Stack a)
forall a. Maybe a
Nothing
mkStack [a]
xs (a
y:[a]
ys) = Stack a -> Maybe (Stack a)
forall a. a -> Maybe a
Just (Stack { up :: [a]
up=[a]
xs, focus :: a
S.focus=a
y, down :: [a]
down=[a]
ys })
mkStack (a
x:[a]
xs) [a]
ys = Stack a -> Maybe (Stack a)
forall a. a -> Maybe a
Just (Stack { up :: [a]
up=[a]
xs, focus :: a
S.focus=a
x, down :: [a]
down=[a]
ys })
rectB :: Rectangle
rectB = Rectangle
rect { rect_width=round $ fromIntegral (rect_width rect) * rb }
rectS :: Rectangle
rectS = Rectangle
rectB { rect_x=rect_x rectB - round ((rb - rs) * fromIntegral (rect_width rect)) }
rectM :: Rectangle
rectM = Rectangle
rect { rect_x=rect_x rect + round (fromIntegral (rect_width rect) * rs)
, rect_width=rect_width rect - round (fromIntegral (rect_width rect) * rs) }
type Reflected l = ModifiedLayout Reflect l
simpleDrawer :: Rational
-> Rational
-> Property
-> Drawer Tall a
simpleDrawer :: forall a. Rational -> Rational -> Property -> Drawer Tall a
simpleDrawer Rational
rs Rational
rb Property
p = Rational -> Rational -> Property -> Tall a -> Drawer Tall a
forall (l :: * -> *) a.
Rational -> Rational -> Property -> l a -> Drawer l a
Drawer Rational
rs Rational
rb Property
p Tall a
forall {a}. Tall a
vertical
where
vertical :: Tall a
vertical = Int -> Rational -> Rational -> Tall a
forall a. Int -> Rational -> Rational -> Tall a
Tall Int
0 Rational
0 Rational
0
drawer :: Rational
-> Rational
-> Property
-> l a
-> Drawer l a
drawer :: forall (l :: * -> *) a.
Rational -> Rational -> Property -> l a -> Drawer l a
drawer = Rational -> Rational -> Property -> l a -> Drawer l a
forall (l :: * -> *) a.
Rational -> Rational -> Property -> l a -> Drawer l a
Drawer
onLeft :: Drawer l a -> l' a -> ModifiedLayout (Drawer l) l' a
onLeft :: forall (l :: * -> *) a (l' :: * -> *).
Drawer l a -> l' a -> ModifiedLayout (Drawer l) l' a
onLeft = Drawer l a -> l' a -> ModifiedLayout (Drawer l) l' a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout
onRight :: Drawer l a -> l' a -> Reflected (ModifiedLayout (Drawer l) (Reflected l')) a
onRight :: forall (l :: * -> *) a (l' :: * -> *).
Drawer l a
-> l' a -> Reflected (ModifiedLayout (Drawer l) (Reflected l')) a
onRight Drawer l a
d = ModifiedLayout (Drawer l) (Reflected l') a
-> ModifiedLayout
Reflect (ModifiedLayout (Drawer l) (Reflected l')) a
forall (l :: * -> *) a. l a -> ModifiedLayout Reflect l a
reflectHoriz (ModifiedLayout (Drawer l) (Reflected l') a
-> ModifiedLayout
Reflect (ModifiedLayout (Drawer l) (Reflected l')) a)
-> (l' a -> ModifiedLayout (Drawer l) (Reflected l') a)
-> l' a
-> ModifiedLayout
Reflect (ModifiedLayout (Drawer l) (Reflected l')) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Drawer l a
-> Reflected l' a -> ModifiedLayout (Drawer l) (Reflected l') a
forall (l :: * -> *) a (l' :: * -> *).
Drawer l a -> l' a -> ModifiedLayout (Drawer l) l' a
onLeft Drawer l a
d (Reflected l' a -> ModifiedLayout (Drawer l) (Reflected l') a)
-> (l' a -> Reflected l' a)
-> l' a
-> ModifiedLayout (Drawer l) (Reflected l') a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. l' a -> Reflected l' a
forall (l :: * -> *) a. l a -> ModifiedLayout Reflect l a
reflectHoriz
onTop :: Drawer l a -> l' a -> Mirror (ModifiedLayout (Drawer l) (Mirror l')) a
onTop :: forall (l :: * -> *) a (l' :: * -> *).
Drawer l a
-> l' a -> Mirror (ModifiedLayout (Drawer l) (Mirror l')) a
onTop Drawer l a
d = ModifiedLayout (Drawer l) (Mirror l') a
-> Mirror (ModifiedLayout (Drawer l) (Mirror l')) a
forall (l :: * -> *) a. l a -> Mirror l a
Mirror (ModifiedLayout (Drawer l) (Mirror l') a
-> Mirror (ModifiedLayout (Drawer l) (Mirror l')) a)
-> (l' a -> ModifiedLayout (Drawer l) (Mirror l') a)
-> l' a
-> Mirror (ModifiedLayout (Drawer l) (Mirror l')) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Drawer l a
-> Mirror l' a -> ModifiedLayout (Drawer l) (Mirror l') a
forall (l :: * -> *) a (l' :: * -> *).
Drawer l a -> l' a -> ModifiedLayout (Drawer l) l' a
onLeft Drawer l a
d (Mirror l' a -> ModifiedLayout (Drawer l) (Mirror l') a)
-> (l' a -> Mirror l' a)
-> l' a
-> ModifiedLayout (Drawer l) (Mirror l') a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. l' a -> Mirror l' a
forall (l :: * -> *) a. l a -> Mirror l a
Mirror
onBottom :: Drawer l a -> l' a -> Reflected (Mirror (ModifiedLayout (Drawer l) (Mirror (Reflected l')))) a
onBottom :: forall (l :: * -> *) a (l' :: * -> *).
Drawer l a
-> l' a
-> Reflected
(Mirror (ModifiedLayout (Drawer l) (Mirror (Reflected l')))) a
onBottom Drawer l a
d = Mirror (ModifiedLayout (Drawer l) (Mirror (Reflected l'))) a
-> ModifiedLayout
Reflect
(Mirror (ModifiedLayout (Drawer l) (Mirror (Reflected l'))))
a
forall (l :: * -> *) a. l a -> ModifiedLayout Reflect l a
reflectVert (Mirror (ModifiedLayout (Drawer l) (Mirror (Reflected l'))) a
-> ModifiedLayout
Reflect
(Mirror (ModifiedLayout (Drawer l) (Mirror (Reflected l'))))
a)
-> (l' a
-> Mirror (ModifiedLayout (Drawer l) (Mirror (Reflected l'))) a)
-> l' a
-> ModifiedLayout
Reflect
(Mirror (ModifiedLayout (Drawer l) (Mirror (Reflected l'))))
a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Drawer l a
-> Reflected l' a
-> Mirror (ModifiedLayout (Drawer l) (Mirror (Reflected l'))) a
forall (l :: * -> *) a (l' :: * -> *).
Drawer l a
-> l' a -> Mirror (ModifiedLayout (Drawer l) (Mirror l')) a
onTop Drawer l a
d (Reflected l' a
-> Mirror (ModifiedLayout (Drawer l) (Mirror (Reflected l'))) a)
-> (l' a -> Reflected l' a)
-> l' a
-> Mirror (ModifiedLayout (Drawer l) (Mirror (Reflected l'))) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. l' a -> Reflected l' a
forall (l :: * -> *) a. l a -> ModifiedLayout Reflect l a
reflectVert