{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}
module XMonad.Layout.DecorationEx.DwmGeometry (
DwmGeometry (..),
dwmStyleDeco, dwmStyleDecoEx
) where
import XMonad
import XMonad.Prelude
import qualified XMonad.StackSet as W
import XMonad.Layout.LayoutModifier
import qualified XMonad.Layout.Decoration as D
import XMonad.Layout.DecorationEx.LayoutModifier
import XMonad.Layout.DecorationEx.Common
import XMonad.Layout.DecorationEx.Geometry
import XMonad.Layout.DecorationEx.Widgets
import XMonad.Layout.DecorationEx.TextEngine
data DwmGeometry a = DwmGeometry {
forall a. DwmGeometry a -> Bool
dwmShowForFocused :: !Bool
, forall a. DwmGeometry a -> Rational
dwmHorizontalPosition :: !Rational
, forall a. DwmGeometry a -> Dimension
dwmDecoHeight :: !Dimension
, forall a. DwmGeometry a -> Dimension
dwmDecoWidth :: !Dimension
}
deriving (Int -> DwmGeometry a -> ShowS
forall a. Int -> DwmGeometry a -> ShowS
forall a. [DwmGeometry a] -> ShowS
forall a. DwmGeometry a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DwmGeometry a] -> ShowS
$cshowList :: forall a. [DwmGeometry a] -> ShowS
show :: DwmGeometry a -> String
$cshow :: forall a. DwmGeometry a -> String
showsPrec :: Int -> DwmGeometry a -> ShowS
$cshowsPrec :: forall a. Int -> DwmGeometry a -> ShowS
Show, ReadPrec [DwmGeometry a]
ReadPrec (DwmGeometry a)
ReadS [DwmGeometry a]
forall a. ReadPrec [DwmGeometry a]
forall a. ReadPrec (DwmGeometry a)
forall a. Int -> ReadS (DwmGeometry a)
forall a. ReadS [DwmGeometry a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DwmGeometry a]
$creadListPrec :: forall a. ReadPrec [DwmGeometry a]
readPrec :: ReadPrec (DwmGeometry a)
$creadPrec :: forall a. ReadPrec (DwmGeometry a)
readList :: ReadS [DwmGeometry a]
$creadList :: forall a. ReadS [DwmGeometry a]
readsPrec :: Int -> ReadS (DwmGeometry a)
$creadsPrec :: forall a. Int -> ReadS (DwmGeometry a)
Read)
instance Default (DwmGeometry a) where
def :: DwmGeometry a
def = forall a.
Bool -> Rational -> Dimension -> Dimension -> DwmGeometry a
DwmGeometry Bool
False Rational
1 Dimension
20 Dimension
200
instance DecorationGeometry DwmGeometry Window where
describeGeometry :: DwmGeometry Window -> String
describeGeometry DwmGeometry Window
_ = String
"DwmStyle"
pureDecoration :: DwmGeometry Window
-> Rectangle
-> Stack Window
-> [(Window, Rectangle)]
-> (Window, Rectangle)
-> Maybe Rectangle
pureDecoration (DwmGeometry {Bool
Rational
Dimension
dwmDecoWidth :: Dimension
dwmDecoHeight :: Dimension
dwmHorizontalPosition :: Rational
dwmShowForFocused :: Bool
dwmDecoWidth :: forall a. DwmGeometry a -> Dimension
dwmDecoHeight :: forall a. DwmGeometry a -> Dimension
dwmHorizontalPosition :: forall a. DwmGeometry a -> Rational
dwmShowForFocused :: forall a. DwmGeometry a -> Bool
..}) Rectangle
_ Stack Window
stack [(Window, Rectangle)]
_ (Window
w, Rectangle Position
x Position
y Dimension
windowWidth Dimension
_) =
let width :: Dimension
width = forall a. Ord a => a -> a -> a
min Dimension
windowWidth Dimension
dwmDecoWidth
halfWidth :: Dimension
halfWidth = Dimension
width forall a. Integral a => a -> a -> a
`div` Dimension
2
minCenterX :: Position
minCenterX = Position
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
halfWidth
maxCenterX :: Position
maxCenterX = Position
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
windowWidth forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
halfWidth
centerX :: Position
centerX = forall a b. (RealFrac a, Integral b) => a -> b
round ((Rational
1 forall a. Num a => a -> a -> a
- Rational
dwmHorizontalPosition)forall a. Num a => a -> a -> a
*forall a b. (Integral a, Num b) => a -> b
fi Position
minCenterX forall a. Num a => a -> a -> a
+ Rational
dwmHorizontalPositionforall a. Num a => a -> a -> a
*forall a b. (Integral a, Num b) => a -> b
fi Position
maxCenterX) :: Position
decoX :: Position
decoX = Position
centerX forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Dimension
halfWidth
focusedWindow :: Window
focusedWindow = forall a. Stack a -> a
W.focus Stack Window
stack
isFocused :: Bool
isFocused = Window
focusedWindow forall a. Eq a => a -> a -> Bool
== Window
w
in if (Bool -> Bool
not Bool
dwmShowForFocused Bool -> Bool -> Bool
&& Bool
isFocused) Bool -> Bool -> Bool
|| Bool -> Bool
not (forall a. Eq a => Stack a -> a -> Bool
D.isInStack Stack Window
stack Window
w)
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
decoX Position
y Dimension
width Dimension
dwmDecoHeight
shrinkWindow :: DwmGeometry Window -> Rectangle -> Rectangle -> Rectangle
shrinkWindow DwmGeometry Window
_ Rectangle
_ Rectangle
windowRect = Rectangle
windowRect
dwmStyleDecoEx :: D.Shrinker shrinker
=> shrinker
-> DwmGeometry Window
-> ThemeEx StandardWidget
-> l Window
-> ModifiedLayout (DecorationEx TextDecoration StandardWidget DwmGeometry shrinker) l Window
dwmStyleDecoEx :: forall shrinker (l :: * -> *).
Shrinker shrinker =>
shrinker
-> DwmGeometry Window
-> ThemeEx StandardWidget
-> l Window
-> ModifiedLayout
(DecorationEx TextDecoration StandardWidget DwmGeometry shrinker)
l
Window
dwmStyleDecoEx shrinker
shrinker DwmGeometry Window
geom ThemeEx StandardWidget
theme = forall (engine :: * -> * -> *) widget a (geom :: * -> *) shrinker
(l :: * -> *).
(DecorationEngine engine widget a, DecorationGeometry geom a,
Shrinker shrinker) =>
shrinker
-> Theme engine widget
-> engine widget a
-> geom a
-> l a
-> ModifiedLayout (DecorationEx engine widget geom shrinker) l a
decorationEx shrinker
shrinker ThemeEx StandardWidget
theme forall widget a. TextDecoration widget a
TextDecoration DwmGeometry Window
geom
dwmStyleDeco :: D.Shrinker shrinker
=> shrinker
-> ThemeEx StandardWidget
-> l Window
-> ModifiedLayout (DecorationEx TextDecoration StandardWidget DwmGeometry shrinker) l Window
dwmStyleDeco :: forall shrinker (l :: * -> *).
Shrinker shrinker =>
shrinker
-> ThemeEx StandardWidget
-> l Window
-> ModifiedLayout
(DecorationEx TextDecoration StandardWidget DwmGeometry shrinker)
l
Window
dwmStyleDeco shrinker
shrinker = forall shrinker (l :: * -> *).
Shrinker shrinker =>
shrinker
-> DwmGeometry Window
-> ThemeEx StandardWidget
-> l Window
-> ModifiedLayout
(DecorationEx TextDecoration StandardWidget DwmGeometry shrinker)
l
Window
dwmStyleDecoEx shrinker
shrinker forall a. Default a => a
def