    {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE TypeOperators #-}
    {-# LANGUAGE UndecidableInstances #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Layout.DecorationEx.TextEngine
    -- Description :  Text-based window decoration engine
    -- Copyright   :  (c) 2007 Andrea Rossato, 2009 Jan Vornberger, 2023 Ilya Portnov
    -- License     :  BSD-style (see xmonad/LICENSE)
    --
    -- Maintainer  :  portnov84@rambler.ru
    -- Stability   :  unstable
    -- Portability :  unportable
    --
    -- Window decoration engine, that uses text fragments (like @"[X]"@) to indicate
    -- widgets (window buttons).
    -----------------------------------------------------------------------------

    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

    -- | Decoration engine data type
    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

    -- | Implementation of @paintWidget@ for decoration engines based on @TextDecoration@.
    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
        String
    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
        String
    str' <- if widget -> Bool
    forall widget. DecorationWidget widget => widget -> Bool
    isShrinkable widget
    widget
                  then engine widget Window
    -> shrinker
    -> DecorationEngineState engine
    -> String
    -> Dimension
    -> Dimension
    -> X String
    forall shrinker.
    Shrinker shrinker =>
    engine widget Window
    -> shrinker
    -> DecorationEngineState engine
    -> String
    -> Dimension
    -> Dimension
    -> X String
    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 (DrawData engine widget -> DecorationEngineState engine
    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 String -> X String
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    str
        Display
    -> Window
    -> XMonadFont
    -> GC
    -> String
    -> String
    -> Position
    -> Position
    -> String
    -> X ()
    forall (m :: * -> *).
    (Functor m, MonadIO m) =>
    Display
    -> Window
    -> XMonadFont
    -> GC
    -> String
    -> String
    -> Position
    -> Position
    -> String
    -> m ()
    printStringXMF Display
    dpy Window
    pixmap (DrawData engine widget -> DecorationEngineState engine
    forall (engine :: * -> * -> *) widget.
    DrawData engine widget -> DecorationEngineState engine
    ddEngineState DrawData engine widget
    dd) GC
    gc (SimpleStyle -> String
    sTextColor Style (Theme engine widget)
    SimpleStyle
    style) (SimpleStyle -> String
    sTextBgColor Style (Theme engine widget)
    SimpleStyle
    style) Position
    x Position
    y String
    str'

    -- | Implementation of @calcWidgetPlace@ for decoration engines based on @TextDecoration@.
    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 <- 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 :: Dimension
    h = Rectangle -> Dimension
    rect_height (DrawData engine widget -> Rectangle
    forall (engine :: * -> * -> *) widget.
    DrawData engine widget -> Rectangle
    ddDecoRect DrawData engine widget
    dd)
            font :: DecorationEngineState engine
    font = DrawData engine widget -> DecorationEngineState engine
    forall (engine :: * -> * -> *) widget.
    DrawData engine widget -> DecorationEngineState engine
    ddEngineState DrawData engine widget
    dd
        (Display -> X WidgetPlace) -> X WidgetPlace
    forall a. (Display -> X a) -> X a
    withDisplay ((Display -> X WidgetPlace) -> X WidgetPlace)
    -> (Display -> X WidgetPlace) -> X WidgetPlace
    forall a b. (a -> b) -> a -> b
    $ \Display
    dpy -> do
          Dimension
    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
          (Position
    a, Position
    d) <- XMonadFont -> String -> X (Position, Position)
    forall (m :: * -> *).
    MonadIO m =>
    XMonadFont -> String -> m (Position, Position)
    textExtentsXMF XMonadFont
    DecorationEngineState engine
    font String
    str
          let height :: Position
    height = Position
    a Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Position
    d
              y :: Position
    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
    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 :: Rectangle
    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)
          WidgetPlace -> X WidgetPlace
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (WidgetPlace -> X WidgetPlace) -> WidgetPlace -> X WidgetPlace
    forall a b. (a -> b) -> a -> b
    $ Position -> Rectangle -> WidgetPlace
    WidgetPlace Position
    y0 Rectangle
    rect

    -- | Add decoration to existing layout. Widgets are indicated by text fragments, like @"[+]"@.
    -- Geometry is simple: a horizontal panel at the top of each window, going for the full width
    -- of the window.
    textDecoration :: (Shrinker shrinker)
                   => shrinker                -- ^ String shrinker, for example @shrinkText@
                   -> Theme TextDecoration StandardWidget  -- ^ Decoration theme (font, colors, widgets, etc)
                   -> l Window                -- ^ Layout to be decorated
                 -> 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