{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
module XMonad.Layout.SideBorderDecoration (
sideBorder,
SideBorderConfig (..),
def,
Direction2D (..),
sideBorderLayout,
) where
import qualified XMonad.StackSet as W
import XMonad
import XMonad.Layout.Decoration
import XMonad.StackSet (Stack)
import XMonad.Util.Types
data SideBorderConfig = SideBorderConfig
{ SideBorderConfig -> Direction2D
sbSide :: !Direction2D
, SideBorderConfig -> String
sbActiveColor :: !String
, SideBorderConfig -> String
sbInactiveColor :: !String
, SideBorderConfig -> Dimension
sbSize :: !Dimension
}
instance Default SideBorderConfig where
def :: SideBorderConfig
def :: SideBorderConfig
def = SideBorderConfig
{ sbSide :: Direction2D
sbSide = Direction2D
D
, sbActiveColor :: String
sbActiveColor = String
"#ff0000"
, sbInactiveColor :: String
sbInactiveColor = String
"#ffaaaa"
, sbSize :: Dimension
sbSize = Dimension
5
}
sideBorder :: SideBorderConfig -> XConfig l -> XConfig (SideBorder l)
sideBorder :: forall (l :: * -> *).
SideBorderConfig -> XConfig l -> XConfig (SideBorder l)
sideBorder SideBorderConfig
sbc XConfig l
cfg =
XConfig l
cfg{ layoutHook :: ModifiedLayout
(Decoration SideBorderDecoration BorderShrinker) l Window
layoutHook = forall a (l :: * -> *).
Eq a =>
SideBorderConfig -> l a -> SideBorder l a
sideBorderLayout SideBorderConfig
sbc (forall (l :: * -> *). XConfig l -> l Window
layoutHook XConfig l
cfg)
, borderWidth :: Dimension
borderWidth = Dimension
0
}
sideBorderLayout :: Eq a => SideBorderConfig -> l a -> SideBorder l a
sideBorderLayout :: forall a (l :: * -> *).
Eq a =>
SideBorderConfig -> l a -> SideBorder l a
sideBorderLayout SideBorderConfig{ Direction2D
sbSide :: Direction2D
sbSide :: SideBorderConfig -> Direction2D
sbSide, String
sbActiveColor :: String
sbActiveColor :: SideBorderConfig -> String
sbActiveColor, String
sbInactiveColor :: String
sbInactiveColor :: SideBorderConfig -> String
sbInactiveColor, Dimension
sbSize :: Dimension
sbSize :: SideBorderConfig -> Dimension
sbSize } =
forall (ds :: * -> *) a s (l :: * -> *).
(DecorationStyle ds a, Shrinker s) =>
s -> Theme -> ds a -> l a -> ModifiedLayout (Decoration ds s) l a
decoration BorderShrinker
BorderShrinker Theme
theme (forall a. Direction2D -> SideBorderDecoration a
SideBorderDecoration Direction2D
sbSide)
where
theme :: Theme
theme :: Theme
theme = Theme
deco
{ activeColor :: String
activeColor = String
sbActiveColor
, inactiveColor :: String
inactiveColor = String
sbInactiveColor
}
where
deco :: Theme
deco | Direction2D
sbSide forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Direction2D
U, Direction2D
D] = forall a. Default a => a
def{ decoHeight :: Dimension
decoHeight = Dimension
sbSize }
| Bool
otherwise = forall a. Default a => a
def{ decoWidth :: Dimension
decoWidth = Dimension
sbSize }
newtype SideBorderDecoration a = SideBorderDecoration Direction2D
deriving (Int -> SideBorderDecoration a -> ShowS
forall a. Int -> SideBorderDecoration a -> ShowS
forall a. [SideBorderDecoration a] -> ShowS
forall a. SideBorderDecoration a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SideBorderDecoration a] -> ShowS
$cshowList :: forall a. [SideBorderDecoration a] -> ShowS
show :: SideBorderDecoration a -> String
$cshow :: forall a. SideBorderDecoration a -> String
showsPrec :: Int -> SideBorderDecoration a -> ShowS
$cshowsPrec :: forall a. Int -> SideBorderDecoration a -> ShowS
Show, ReadPrec [SideBorderDecoration a]
ReadPrec (SideBorderDecoration a)
ReadS [SideBorderDecoration a]
forall a. ReadPrec [SideBorderDecoration a]
forall a. ReadPrec (SideBorderDecoration a)
forall a. Int -> ReadS (SideBorderDecoration a)
forall a. ReadS [SideBorderDecoration a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SideBorderDecoration a]
$creadListPrec :: forall a. ReadPrec [SideBorderDecoration a]
readPrec :: ReadPrec (SideBorderDecoration a)
$creadPrec :: forall a. ReadPrec (SideBorderDecoration a)
readList :: ReadS [SideBorderDecoration a]
$creadList :: forall a. ReadS [SideBorderDecoration a]
readsPrec :: Int -> ReadS (SideBorderDecoration a)
$creadsPrec :: forall a. Int -> ReadS (SideBorderDecoration a)
Read)
type SideBorder = ModifiedLayout (Decoration SideBorderDecoration BorderShrinker)
instance Eq a => DecorationStyle SideBorderDecoration a where
shrink :: SideBorderDecoration a -> Rectangle -> Rectangle -> Rectangle
shrink :: SideBorderDecoration a -> Rectangle -> Rectangle -> Rectangle
shrink SideBorderDecoration a
dec (Rectangle Position
_ Position
_ Dimension
dw Dimension
dh) (Rectangle Position
x Position
y Dimension
w Dimension
h) = case SideBorderDecoration a
dec of
SideBorderDecoration Direction2D
U -> Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x (Position
y forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
dh) Dimension
w (Dimension
h forall a. Num a => a -> a -> a
- Dimension
dh)
SideBorderDecoration Direction2D
R -> Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y (Dimension
w forall a. Num a => a -> a -> a
- Dimension
dw) Dimension
h
SideBorderDecoration Direction2D
D -> Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y Dimension
w (Dimension
h forall a. Num a => a -> a -> a
- Dimension
dh)
SideBorderDecoration Direction2D
L -> Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
dw) Position
y (Dimension
w forall a. Num a => a -> a -> a
- Dimension
dw) Dimension
h
pureDecoration
:: SideBorderDecoration a
-> Dimension -> Dimension
-> Rectangle
-> Stack a
-> [(a, Rectangle)]
-> (a, Rectangle)
-> Maybe Rectangle
pureDecoration :: SideBorderDecoration a
-> Dimension
-> Dimension
-> Rectangle
-> Stack a
-> [(a, Rectangle)]
-> (a, Rectangle)
-> Maybe Rectangle
pureDecoration SideBorderDecoration a
dec Dimension
dw Dimension
dh Rectangle
_ Stack a
st [(a, Rectangle)]
_ (a
win, Rectangle Position
x Position
y Dimension
w Dimension
h)
| a
win forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a. Stack a -> [a]
W.integrate Stack a
st Bool -> Bool -> Bool
&& Dimension
dw forall a. Ord a => a -> a -> Bool
< Dimension
w Bool -> Bool -> Bool
&& Dimension
dh forall a. Ord a => a -> a -> Bool
< Dimension
h = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ case SideBorderDecoration a
dec of
SideBorderDecoration Direction2D
U -> Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y Dimension
w Dimension
dh
SideBorderDecoration Direction2D
R -> Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi (Dimension
w forall a. Num a => a -> a -> a
- Dimension
dw)) Position
y Dimension
dw Dimension
h
SideBorderDecoration Direction2D
D -> Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x (Position
y forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi (Dimension
h forall a. Num a => a -> a -> a
- Dimension
dh)) Dimension
w Dimension
dh
SideBorderDecoration Direction2D
L -> Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y Dimension
dw Dimension
h
| Bool
otherwise = forall a. Maybe a
Nothing
data BorderShrinker = BorderShrinker
instance Show BorderShrinker where
show :: BorderShrinker -> String
show :: BorderShrinker -> String
show BorderShrinker
_ = String
""
instance Read BorderShrinker where
readsPrec :: Int -> ReadS BorderShrinker
readsPrec :: Int -> ReadS BorderShrinker
readsPrec Int
_ String
s = [(BorderShrinker
BorderShrinker, String
s)]
instance Shrinker BorderShrinker where
shrinkIt :: BorderShrinker -> String -> [String]
shrinkIt :: BorderShrinker -> String -> [String]
shrinkIt BorderShrinker
_ String
_ = [String
""]