{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module XMonad.Layout.DecorationEx.TextEngine (
textDecoration,
TextDecoration (..)
) where
import XMonad
import XMonad.Prelude
import XMonad.Layout.LayoutModifier
import XMonad.Util.Font
import XMonad.Layout.DecorationEx.LayoutModifier
import XMonad.Layout.DecorationEx.Common
import XMonad.Layout.DecorationEx.Engine
import XMonad.Layout.DecorationEx.Geometry
import XMonad.Layout.DecorationEx.Widgets
data TextDecoration widget a = TextDecoration
deriving (Int -> TextDecoration widget a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall widget a. Int -> TextDecoration widget a -> ShowS
forall widget a. [TextDecoration widget a] -> ShowS
forall widget a. TextDecoration widget a -> String
showList :: [TextDecoration widget a] -> ShowS
$cshowList :: forall widget a. [TextDecoration widget a] -> ShowS
show :: TextDecoration widget a -> String
$cshow :: forall widget a. TextDecoration widget a -> String
showsPrec :: Int -> TextDecoration widget a -> ShowS
$cshowsPrec :: forall widget a. Int -> TextDecoration widget a -> ShowS
Show, ReadPrec [TextDecoration widget a]
ReadPrec (TextDecoration widget a)
ReadS [TextDecoration widget a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall widget a. ReadPrec [TextDecoration widget a]
forall widget a. ReadPrec (TextDecoration widget a)
forall widget a. Int -> ReadS (TextDecoration widget a)
forall widget a. ReadS [TextDecoration widget a]
readListPrec :: ReadPrec [TextDecoration widget a]
$creadListPrec :: forall widget a. ReadPrec [TextDecoration widget a]
readPrec :: ReadPrec (TextDecoration widget a)
$creadPrec :: forall widget a. ReadPrec (TextDecoration widget a)
readList :: ReadS [TextDecoration widget a]
$creadList :: forall widget a. ReadS [TextDecoration widget a]
readsPrec :: Int -> ReadS (TextDecoration widget a)
$creadsPrec :: forall widget a. Int -> ReadS (TextDecoration widget a)
Read)
instance (TextWidget widget, ClickHandler (GenericTheme SimpleStyle) widget)
=> DecorationEngine TextDecoration widget Window where
type Theme TextDecoration = GenericTheme SimpleStyle
type DecorationPaintingContext TextDecoration = XPaintingContext
type DecorationEngineState TextDecoration = XMonadFont
describeEngine :: TextDecoration widget Window -> String
describeEngine TextDecoration widget Window
_ = String
"TextDecoration"
calcWidgetPlace :: TextDecoration widget Window
-> DrawData TextDecoration widget -> widget -> X WidgetPlace
calcWidgetPlace = forall widget (engine :: * -> * -> *).
(TextWidget widget, DecorationEngineState engine ~ XMonadFont,
DecorationEngine engine widget Window) =>
engine widget Window
-> DrawData engine widget -> widget -> X WidgetPlace
calcTextWidgetPlace
paintWidget :: forall shrinker.
Shrinker shrinker =>
TextDecoration widget Window
-> DecorationPaintingContext TextDecoration
-> WidgetPlace
-> shrinker
-> DrawData TextDecoration widget
-> widget
-> Bool
-> X ()
paintWidget = forall widget (engine :: * -> * -> *) shrinker.
(TextWidget widget, Style (Theme engine widget) ~ SimpleStyle,
DecorationPaintingContext engine ~ XPaintingContext,
DecorationEngineState engine ~ XMonadFont, Shrinker shrinker,
DecorationEngine engine widget Window) =>
engine widget Window
-> DecorationPaintingContext engine
-> WidgetPlace
-> shrinker
-> DrawData engine widget
-> widget
-> Bool
-> X ()
paintTextWidget
paintDecoration :: forall shrinker.
Shrinker shrinker =>
TextDecoration widget Window
-> Window
-> Dimension
-> Dimension
-> shrinker
-> DrawData TextDecoration widget
-> Bool
-> X ()
paintDecoration = forall (engine :: * -> * -> *) shrinker widget.
(DecorationEngine engine widget Window,
DecorationPaintingContext engine ~ XPaintingContext,
Shrinker shrinker, Style (Theme engine widget) ~ SimpleStyle) =>
engine widget Window
-> Window
-> Dimension
-> Dimension
-> shrinker
-> DrawData engine widget
-> Bool
-> X ()
paintDecorationSimple
initializeState :: forall (geom :: * -> *).
TextDecoration widget Window
-> geom Window
-> Theme TextDecoration widget
-> X (DecorationEngineState TextDecoration)
initializeState TextDecoration widget Window
_ geom Window
_ Theme TextDecoration widget
theme = String -> X XMonadFont
initXMF (forall theme. ThemeAttributes theme => theme -> String
themeFontName Theme TextDecoration widget
theme)
releaseStateResources :: TextDecoration widget Window
-> DecorationEngineState TextDecoration -> X ()
releaseStateResources TextDecoration widget Window
_ = XMonadFont -> X ()
releaseXMF
paintTextWidget :: (TextWidget widget,
Style (Theme engine widget) ~ SimpleStyle,
DecorationPaintingContext engine ~ XPaintingContext,
DecorationEngineState engine ~ XMonadFont,
Shrinker shrinker,
DecorationEngine engine widget Window)
=> engine widget Window
-> DecorationPaintingContext engine
-> WidgetPlace
-> shrinker
-> DrawData engine widget
-> widget
-> Bool
-> X ()
paintTextWidget :: forall widget (engine :: * -> * -> *) shrinker.
(TextWidget widget, Style (Theme engine widget) ~ SimpleStyle,
DecorationPaintingContext engine ~ XPaintingContext,
DecorationEngineState engine ~ XMonadFont, Shrinker shrinker,
DecorationEngine engine widget Window) =>
engine widget Window
-> DecorationPaintingContext engine
-> WidgetPlace
-> shrinker
-> DrawData engine widget
-> widget
-> Bool
-> X ()
paintTextWidget engine widget Window
engine (Display
dpy, Window
pixmap, GC
gc) WidgetPlace
place shrinker
shrinker DrawData engine widget
dd widget
widget Bool
_ = do
let style :: Style (Theme engine widget)
style = forall (engine :: * -> * -> *) widget.
DrawData engine widget -> Style (Theme engine widget)
ddStyle DrawData engine widget
dd
rect :: Rectangle
rect = WidgetPlace -> Rectangle
wpRectangle WidgetPlace
place
x :: Position
x = Rectangle -> Position
rect_x Rectangle
rect
y :: Position
y = WidgetPlace -> Position
wpTextYPosition WidgetPlace
place
String
str <- forall widget (engine :: * -> * -> *).
TextWidget widget =>
DrawData engine widget -> widget -> X String
widgetString DrawData engine widget
dd widget
widget
String
str' <- if forall widget. DecorationWidget widget => widget -> Bool
isShrinkable widget
widget
then forall (engine :: * -> * -> *) widget a shrinker.
(DecorationEngine engine widget a, Shrinker shrinker) =>
engine widget a
-> shrinker
-> DecorationEngineState engine
-> String
-> Dimension
-> Dimension
-> X String
getShrinkedWindowName engine widget Window
engine shrinker
shrinker (forall (engine :: * -> * -> *) widget.
DrawData engine widget -> DecorationEngineState engine
ddEngineState DrawData engine widget
dd) String
str (Rectangle -> Dimension
rect_width Rectangle
rect) (Rectangle -> Dimension
rect_height Rectangle
rect)
else forall (m :: * -> *) a. Monad m => a -> m a
return String
str
forall (m :: * -> *).
(Functor m, MonadIO m) =>
Display
-> Window
-> XMonadFont
-> GC
-> String
-> String
-> Position
-> Position
-> String
-> m ()
printStringXMF Display
dpy Window
pixmap (forall (engine :: * -> * -> *) widget.
DrawData engine widget -> DecorationEngineState engine
ddEngineState DrawData engine widget
dd) GC
gc (SimpleStyle -> String
sTextColor Style (Theme engine widget)
style) (SimpleStyle -> String
sTextBgColor Style (Theme engine widget)
style) Position
x Position
y String
str'
calcTextWidgetPlace :: (TextWidget widget,
DecorationEngineState engine ~ XMonadFont,
DecorationEngine engine widget Window)
=> engine widget Window
-> DrawData engine widget
-> widget
-> X WidgetPlace
calcTextWidgetPlace :: forall widget (engine :: * -> * -> *).
(TextWidget widget, DecorationEngineState engine ~ XMonadFont,
DecorationEngine engine widget Window) =>
engine widget Window
-> DrawData engine widget -> widget -> X WidgetPlace
calcTextWidgetPlace engine widget Window
_ DrawData engine widget
dd widget
widget = do
String
str <- forall widget (engine :: * -> * -> *).
TextWidget widget =>
DrawData engine widget -> widget -> X String
widgetString DrawData engine widget
dd widget
widget
let h :: Dimension
h = Rectangle -> Dimension
rect_height (forall (engine :: * -> * -> *) widget.
DrawData engine widget -> Rectangle
ddDecoRect DrawData engine widget
dd)
font :: DecorationEngineState engine
font = forall (engine :: * -> * -> *) widget.
DrawData engine widget -> DecorationEngineState engine
ddEngineState DrawData engine widget
dd
forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
Dimension
width <- forall a b. (Integral a, Num b) => a -> b
fi forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadIO m =>
Display -> XMonadFont -> String -> m Int
textWidthXMF Display
dpy (forall (engine :: * -> * -> *) widget.
DrawData engine widget -> DecorationEngineState engine
ddEngineState DrawData engine widget
dd) String
str
(Position
a, Position
d) <- forall (m :: * -> *).
MonadIO m =>
XMonadFont -> String -> m (Position, Position)
textExtentsXMF DecorationEngineState engine
font String
str
let height :: Position
height = Position
a forall a. Num a => a -> a -> a
+ Position
d
y :: Position
y = forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ (Dimension
h forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Position
height) forall a. Integral a => a -> a -> a
`div` Dimension
2
y0 :: Position
y0 = Position
y forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Position
a
rect :: Rectangle
rect = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
0 Position
y Dimension
width (forall a b. (Integral a, Num b) => a -> b
fi Position
height)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Position -> Rectangle -> WidgetPlace
WidgetPlace Position
y0 Rectangle
rect
textDecoration :: (Shrinker shrinker)
=> shrinker
-> Theme TextDecoration StandardWidget
-> l Window
-> ModifiedLayout (DecorationEx TextDecoration StandardWidget DefaultGeometry shrinker) l Window
textDecoration :: forall shrinker (l :: * -> *).
Shrinker shrinker =>
shrinker
-> Theme TextDecoration StandardWidget
-> l Window
-> ModifiedLayout
(DecorationEx
TextDecoration StandardWidget DefaultGeometry shrinker)
l
Window
textDecoration shrinker
shrinker Theme TextDecoration 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 Theme TextDecoration StandardWidget
theme forall widget a. TextDecoration widget a
TextDecoration forall a. Default a => a
def