{-# 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
[TextDecoration widget a] -> ShowS
TextDecoration widget a -> String
(Int -> TextDecoration widget a -> ShowS)
-> (TextDecoration widget a -> String)
-> ([TextDecoration widget a] -> ShowS)
-> Show (TextDecoration widget a)
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
$cshowsPrec :: forall widget a. Int -> TextDecoration widget a -> ShowS
showsPrec :: Int -> TextDecoration widget a -> ShowS
$cshow :: forall widget a. TextDecoration widget a -> String
show :: TextDecoration widget a -> String
$cshowList :: forall widget a. [TextDecoration widget a] -> ShowS
showList :: [TextDecoration widget a] -> ShowS
Show, ReadPrec [TextDecoration widget a]
ReadPrec (TextDecoration widget a)
Int -> ReadS (TextDecoration widget a)
ReadS [TextDecoration widget a]
(Int -> ReadS (TextDecoration widget a))
-> ReadS [TextDecoration widget a]
-> ReadPrec (TextDecoration widget a)
-> ReadPrec [TextDecoration widget a]
-> Read (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]
$creadsPrec :: forall widget a. Int -> ReadS (TextDecoration widget a)
readsPrec :: Int -> ReadS (TextDecoration widget a)
$creadList :: forall widget a. ReadS [TextDecoration widget a]
readList :: ReadS [TextDecoration widget a]
$creadPrec :: forall widget a. ReadPrec (TextDecoration widget a)
readPrec :: ReadPrec (TextDecoration widget a)
$creadListPrec :: forall widget a. ReadPrec [TextDecoration widget a]
readListPrec :: ReadPrec [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 = TextDecoration widget Window
-> DrawData TextDecoration widget -> widget -> X WidgetPlace
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 = TextDecoration widget Window
-> DecorationPaintingContext TextDecoration
-> WidgetPlace
-> shrinker
-> DrawData TextDecoration widget
-> widget
-> Bool
-> X ()
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 = TextDecoration widget Window
-> Window
-> Dimension
-> Dimension
-> shrinker
-> DrawData TextDecoration widget
-> Bool
-> X ()
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 (GenericTheme SimpleStyle widget -> String
forall theme. ThemeAttributes theme => theme -> String
themeFontName GenericTheme SimpleStyle widget
Theme TextDecoration widget
theme)
releaseStateResources :: TextDecoration widget Window
-> DecorationEngineState TextDecoration -> X ()
releaseStateResources TextDecoration widget Window
_ = XMonadFont -> X ()
DecorationEngineState TextDecoration -> 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 = DrawData engine widget -> Style (Theme engine widget)
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
str <- DrawData engine widget -> widget -> X String
forall widget (engine :: * -> * -> *).
TextWidget widget =>
DrawData engine widget -> widget -> X String
forall (engine :: * -> * -> *).
DrawData engine widget -> widget -> X String
widgetString DrawData engine widget
dd widget
widget
str' <- if isShrinkable widget
then getShrinkedWindowName engine shrinker (ddEngineState dd) str (rect_width rect) (rect_height rect)
else return str
printStringXMF dpy pixmap (ddEngineState dd) gc (sTextColor style) (sTextBgColor style) x y 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
str <- DrawData engine widget -> widget -> X String
forall widget (engine :: * -> * -> *).
TextWidget widget =>
DrawData engine widget -> widget -> X String
forall (engine :: * -> * -> *).
DrawData engine widget -> widget -> X String
widgetString DrawData engine widget
dd widget
widget
let h = Rectangle -> Dimension
rect_height (DrawData engine widget -> Rectangle
forall (engine :: * -> * -> *) widget.
DrawData engine widget -> Rectangle
ddDecoRect DrawData engine widget
dd)
font = DrawData engine widget -> DecorationEngineState engine
forall (engine :: * -> * -> *) widget.
DrawData engine widget -> DecorationEngineState engine
ddEngineState DrawData engine widget
dd
withDisplay $ \Display
dpy -> do
width <- Int -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi (Int -> Dimension) -> X Int -> X Dimension
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Display -> XMonadFont -> String -> X Int
forall (m :: * -> *).
MonadIO m =>
Display -> XMonadFont -> String -> m Int
textWidthXMF Display
dpy (DrawData engine widget -> DecorationEngineState engine
forall (engine :: * -> * -> *) widget.
DrawData engine widget -> DecorationEngineState engine
ddEngineState DrawData engine widget
dd) String
str
(a, d) <- textExtentsXMF font str
let height = Position
a Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
d
y = Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi (Dimension -> Position) -> Dimension -> Position
forall a b. (a -> b) -> a -> b
$ (Dimension
h Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Position -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Position
height) Dimension -> Dimension -> Dimension
forall a. Integral a => a -> a -> a
`div` Dimension
2
y0 = Position
y Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position -> Position
forall a b. (Integral a, Num b) => a -> b
fi Position
a
rect = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
0 Position
y Dimension
width (Position -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Position
height)
return $ WidgetPlace y0 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 = shrinker
-> Theme TextDecoration StandardWidget
-> TextDecoration StandardWidget Window
-> DefaultGeometry Window
-> l Window
-> ModifiedLayout
(DecorationEx
TextDecoration StandardWidget DefaultGeometry shrinker)
l
Window
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 TextDecoration StandardWidget Window
forall widget a. TextDecoration widget a
TextDecoration DefaultGeometry Window
forall a. Default a => a
def