    {-# LINE 1 "Graphics/X11/Xft.hsc" #-}
    {-# LANGUAGE ForeignFunctionInterface #-}

    -----------------------------------------------------------------------------
    -- Module      :  Graphics.X11.Xft
    -- Copyright   :  Clemens Fruhwirth <clemens@endorphin.org> 2007
    --
    -- Haskell bindings for the Xft library.
    --
    -----------------------------------------------------------------------------

    module Graphics.X11.Xft ( XftColor
                            , xftcolor_pixel
                            , allocaXftColor
                            , withXftColorName
                            , withXftColorValue
                            , XftDraw
                            , withXftDraw
                            , xftDrawCreate
                            , xftDrawCreateBitmap
                            , xftDrawCreateAlpha
                            , xftDrawChange
                            , xftDrawDisplay
                            , xftDrawDrawable
                            , xftDrawColormap
                            , xftDrawVisual
                            , xftDrawDestroy
                            , XftFont
                            , xftfont_ascent
                            , xftfont_max_ascent
                            , xftfont_descent
                            , xftfont_max_descent
                            , xftfont_height
                            , xftfont_max_height
                            , xftfont_max_advance_width
                            , xftFontOpen
                            , xftFontOpenXlfd
                            , xftLockFace
                            , xftUnlockFace
                            , xftFontCopy
                            , xftFontClose
                            , xftDrawGlyphs
                            , xftDrawString
                            , xftDrawStringFallback
                            , xftTextExtents
                            , xftTextAccumExtents
                            , xftDrawRect
                            , xftDrawSetClipRectangles
                            , xftDrawSetSubwindowMode
                            , xftInitFtLibrary
                            )
     where

    import Graphics.X11
    import Graphics.X11.Xlib.Types
    import Graphics.X11.Xrender

    import Codec.Binary.UTF8.String as UTF8
    import Control.Arrow ((&&&))
    import Control.Monad (void)
    import Data.Char (ord)
    import Data.Function (on)
    import Data.List (groupBy, foldl')
    import Data.List.NonEmpty (NonEmpty)
    import Foreign hiding (void)
    import Foreign.C.String
    import Foreign.C.Types

    -----------------------
    -- Color Handling    --
    -----------------------

    newtype XftColor = XftColor (Ptr XftColor)

    xftcolor_pixel :: XftColor -> IO Int
    xftcolor_pixel :: XftColor -> IO Int
    xftcolor_pixel (XftColor Ptr XftColor
    p) = Ptr XftColor -> CInt -> IO Int
    forall a. Ptr a -> CInt -> IO Int
    peekCUShort Ptr XftColor
    p (CInt
    0)
    {-# LINE 78 "Graphics/X11/Xft.hsc" #-}
    -- missing xftcolor_color to get XRenderColor

    foreign import ccall "XftColorAllocName"
        cXftColorAllocName :: Display -> Visual -> Colormap -> CString -> XftColor -> IO (Int32)
    {-# LINE 82 "Graphics/X11/Xft.hsc" #-}

    allocaXftColor :: (Ptr XftColor -> IO a) -> IO a
    allocaXftColor :: forall a. (Ptr XftColor -> IO a) -> IO a
    allocaXftColor = Int -> (Ptr XftColor -> IO a) -> IO a
    forall a b. Int -> (Ptr a -> IO b) -> IO b
    allocaBytes ((Int
    16))
    {-# LINE 85 "Graphics/X11/Xft.hsc" #-}

    withXftColorName :: Display -> Visual -> Colormap -> String -> (XftColor -> IO a) -> IO a
    withXftColorName :: forall a.
    Display
    -> Visual -> Colormap -> String -> (XftColor -> IO a) -> IO a
    withXftColorName Display
    d Visual
    v Colormap
    cm String
    name XftColor -> IO a
    f =
        (Ptr XftColor -> IO a) -> IO a
    forall a. (Ptr XftColor -> IO a) -> IO a
    allocaXftColor ((Ptr XftColor -> IO a) -> IO a) -> (Ptr XftColor -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ (\XftColor
    color -> do
                            String -> (CString -> IO a) -> IO a
    forall a. String -> (CString -> IO a) -> IO a
    withCAString String
    name (\CString
    cstring -> do
                                                 IO Int32 -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO Int32 -> IO ()) -> IO Int32 -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Display -> Visual -> Colormap -> CString -> XftColor -> IO Int32
    cXftColorAllocName Display
    d Visual
    v Colormap
    cm CString
    cstring XftColor
    color
                                                 a
    r <- XftColor -> IO a
    f XftColor
    color
                                                 Display -> Visual -> Colormap -> XftColor -> IO ()
    cXftColorFree Display
    d Visual
    v Colormap
    cm XftColor
    color
                                                 a -> IO a
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    r)) (XftColor -> IO a)
    -> (Ptr XftColor -> XftColor) -> Ptr XftColor -> IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ptr XftColor -> XftColor
    XftColor

    foreign import ccall "XftColorAllocValue"
      cXftColorAllocValue :: Display -> Visual -> Colormap -> (Ptr XRenderColor) -> XftColor -> IO (Int32)
    {-# LINE 97 "Graphics/X11/Xft.hsc" #-}

    withXftColorValue :: Display -> Visual -> Colormap -> XRenderColor -> (XftColor -> IO a) -> IO a
    withXftColorValue :: forall a.
    Display
    -> Visual -> Colormap -> XRenderColor -> (XftColor -> IO a) -> IO a
    withXftColorValue Display
    d Visual
    v Colormap
    cm XRenderColor
    rc XftColor -> IO a
    f =
        (Ptr XftColor -> IO a) -> IO a
    forall a. (Ptr XftColor -> IO a) -> IO a
    allocaXftColor ((Ptr XftColor -> IO a) -> IO a) -> (Ptr XftColor -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ (\XftColor
    color -> do
                            XRenderColor -> (Ptr XRenderColor -> IO a) -> IO a
    forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
    with XRenderColor
    rc (\Ptr XRenderColor
    rc_ptr -> do
                                       IO Int32 -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO Int32 -> IO ()) -> IO Int32 -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Display
    -> Visual -> Colormap -> Ptr XRenderColor -> XftColor -> IO Int32
    cXftColorAllocValue Display
    d Visual
    v Colormap
    cm Ptr XRenderColor
    rc_ptr XftColor
    color
                                       a
    r <- XftColor -> IO a
    f XftColor
    color
                                       Display -> Visual -> Colormap -> XftColor -> IO ()
    cXftColorFree Display
    d Visual
    v Colormap
    cm XftColor
    color
                                       a -> IO a
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    r)) (XftColor -> IO a)
    -> (Ptr XftColor -> XftColor) -> Ptr XftColor -> IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ptr XftColor -> XftColor
    XftColor

    foreign import ccall "XftColorFree"
      cXftColorFree :: Display -> Visual -> Colormap -> XftColor -> IO ()

    -----------------------
    -- Draw Handling    --
    -----------------------

    newtype XftDraw = XftDraw (Ptr XftDraw)

    withXftDraw :: Display -> Drawable -> Visual -> Colormap -> (XftDraw -> IO a) -> IO a
    withXftDraw :: forall a.
    Display
    -> Colormap -> Visual -> Colormap -> (XftDraw -> IO a) -> IO a
    withXftDraw Display
    d Colormap
    p Visual
    v Colormap
    c XftDraw -> IO a
    act =
        do
          XftDraw
    draw <- Display -> Colormap -> Visual -> Colormap -> IO XftDraw
    xftDrawCreate Display
    d Colormap
    p Visual
    v Colormap
    c
          a
    a <- XftDraw -> IO a
    act XftDraw
    draw
          XftDraw -> IO ()
    xftDrawDestroy XftDraw
    draw
          a -> IO a
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    a

    foreign import ccall "XftDrawCreate"
      xftDrawCreate :: Display -> Drawable -> Visual -> Colormap -> IO XftDraw

    foreign import ccall "XftDrawCreateBitmap"
      xftDrawCreateBitmap :: Display -> Pixmap -> IO XftDraw

    foreign import ccall "XftDrawCreateAlpha"
      cXftDrawCreateAlpha :: Display -> Pixmap -> CInt -> IO XftDraw

    xftDrawCreateAlpha :: Integral a => Display -> Pixmap -> a -> IO XftDraw
    xftDrawCreateAlpha :: forall a. Integral a => Display -> Colormap -> a -> IO XftDraw
    xftDrawCreateAlpha Display
    d Colormap
    p a
    i = Display -> Colormap -> CInt -> IO XftDraw
    cXftDrawCreateAlpha Display
    d Colormap
    p (a -> CInt
    forall a b. (Integral a, Num b) => a -> b
    fi a
    i)

    foreign import ccall "XftDrawChange"
      xftDrawChange :: XftDraw -> Drawable -> IO ()

    foreign import ccall "XftDrawDisplay"
      xftDrawDisplay :: XftDraw -> IO Display -- FIXME correct? Is X11 giving us the underlying Display?

    foreign import ccall "XftDrawDrawable"
      xftDrawDrawable :: XftDraw -> IO Drawable

    foreign import ccall "XftDrawColormap"
      xftDrawColormap :: XftDraw -> IO Colormap

    foreign import ccall "XftDrawVisual"
      xftDrawVisual :: XftDraw -> IO Visual

    foreign import ccall "XftDrawDestroy"
      xftDrawDestroy :: XftDraw -> IO ()

    --------------------
    -- Font handling  --
    --------------------

    newtype XftFont = XftFont (Ptr XftFont)

    xftfont_ascent, xftfont_descent, xftfont_height, xftfont_max_advance_width :: XftFont -> IO Int
    xftfont_ascent :: XftFont -> IO Int
    xftfont_ascent (XftFont Ptr XftFont
    p)            = Ptr XftFont -> CInt -> IO Int
    forall a. Ptr a -> CInt -> IO Int
    peekCUShort Ptr XftFont
    p (CInt
    0)
    {-# LINE 162 "Graphics/X11/Xft.hsc" #-}
    xftfont_descent (XftFont p)           = peekCUShort p (4)
    {-# LINE 163 "Graphics/X11/Xft.hsc" #-}
    xftfont_height (XftFont p)            = peekCUShort p (8)
    {-# LINE 164 "Graphics/X11/Xft.hsc" #-}
    xftfont_max_advance_width (XftFont p) = peekCUShort p (12)
    {-# LINE 165 "Graphics/X11/Xft.hsc" #-}
    -- missing xftfont_charset
    -- missing xftfont_pattern

    foreign import ccall "XftFontOpenName"
      cXftFontOpen :: Display -> CInt -> CString -> IO XftFont

    xftFontOpen :: Display -> Screen -> String -> IO XftFont
    xftFontOpen :: Display -> Screen -> String -> IO XftFont
    xftFontOpen Display
    dpy Screen
    screen String
    fontname =
        String -> (CString -> IO XftFont) -> IO XftFont
    forall a. String -> (CString -> IO a) -> IO a
    withCAString String
    fontname ((CString -> IO XftFont) -> IO XftFont)
    -> (CString -> IO XftFont) -> IO XftFont
    forall a b. (a -> b) -> a -> b
    $
          \CString
    cfontname -> Display -> CInt -> CString -> IO XftFont
    cXftFontOpen Display
    dpy (Word32 -> CInt
    forall a b. (Integral a, Num b) => a -> b
    fi (Screen -> Word32
    screenNumberOfScreen Screen
    screen)) CString
    cfontname

    foreign import ccall "XftFontOpenXlfd"
      cXftFontOpenXlfd :: Display -> CInt -> CString -> IO XftFont

    xftFontOpenXlfd :: Display -> Screen -> String -> IO XftFont
    xftFontOpenXlfd :: Display -> Screen -> String -> IO XftFont
    xftFontOpenXlfd Display
    dpy Screen
    screen String
    fontname =
        String -> (CString -> IO XftFont) -> IO XftFont
    forall a. String -> (CString -> IO a) -> IO a
    withCAString String
    fontname ((CString -> IO XftFont) -> IO XftFont)
    -> (CString -> IO XftFont) -> IO XftFont
    forall a b. (a -> b) -> a -> b
    $ \CString
    cfontname -> Display -> CInt -> CString -> IO XftFont
    cXftFontOpenXlfd Display
    dpy (Word32 -> CInt
    forall a b. (Integral a, Num b) => a -> b
    fi (Screen -> Word32
    screenNumberOfScreen Screen
    screen)) CString
    cfontname

    foreign import ccall "XftLockFace"
      xftLockFace :: XftFont -> IO ()                  -- FIXME XftLockFace returns FT_face not void

    foreign import ccall "XftUnlockFace"
      xftUnlockFace :: XftFont -> IO ()

    foreign import ccall "XftFontCopy"
      xftFontCopy :: Display -> XftFont -> IO XftFont

    foreign import ccall "XftFontClose"
      xftFontClose :: Display -> XftFont -> IO ()

    -- Support for multiple fonts --

    xftfont_max_ascent :: NonEmpty XftFont -> IO Int
    xftfont_max_ascent :: NonEmpty XftFont -> IO Int
    xftfont_max_ascent = (NonEmpty Int -> Int) -> IO (NonEmpty Int) -> IO Int
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap NonEmpty Int -> Int
    forall a. Ord a => NonEmpty a -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum (IO (NonEmpty Int) -> IO Int)
    -> (NonEmpty XftFont -> IO (NonEmpty Int))
    -> NonEmpty XftFont
    -> IO Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (XftFont -> IO Int) -> NonEmpty XftFont -> IO (NonEmpty Int)
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> NonEmpty a -> m (NonEmpty b)
    mapM XftFont -> IO Int
    xftfont_ascent

    xftfont_max_descent :: NonEmpty XftFont -> IO Int
    xftfont_max_descent :: NonEmpty XftFont -> IO Int
    xftfont_max_descent = (NonEmpty Int -> Int) -> IO (NonEmpty Int) -> IO Int
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap NonEmpty Int -> Int
    forall a. Ord a => NonEmpty a -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum (IO (NonEmpty Int) -> IO Int)
    -> (NonEmpty XftFont -> IO (NonEmpty Int))
    -> NonEmpty XftFont
    -> IO Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (XftFont -> IO Int) -> NonEmpty XftFont -> IO (NonEmpty Int)
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> NonEmpty a -> m (NonEmpty b)
    mapM XftFont -> IO Int
    xftfont_descent

    xftfont_max_height :: NonEmpty XftFont -> IO Int
    xftfont_max_height :: NonEmpty XftFont -> IO Int
    xftfont_max_height = (NonEmpty Int -> Int) -> IO (NonEmpty Int) -> IO Int
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap NonEmpty Int -> Int
    forall a. Ord a => NonEmpty a -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum (IO (NonEmpty Int) -> IO Int)
    -> (NonEmpty XftFont -> IO (NonEmpty Int))
    -> NonEmpty XftFont
    -> IO Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (XftFont -> IO Int) -> NonEmpty XftFont -> IO (NonEmpty Int)
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> NonEmpty a -> m (NonEmpty b)
    mapM XftFont -> IO Int
    xftfont_height

    ---------------------
    -- Painting
    ---------------------

    -- Drawing strings or glyphs --

    foreign import ccall "XftCharExists"
      cXftCharExists :: Display -> XftFont -> (Word32) -> IO (Int32)
    {-# LINE 214 "Graphics/X11/Xft.hsc" #-}

    xftCharExists :: Display -> XftFont -> Char -> IO Bool
    xftCharExists :: Display -> XftFont -> Char -> IO Bool
    xftCharExists Display
    d XftFont
    f Char
    c = Int32 -> Bool
    forall {a}. (Eq a, Num a) => a -> Bool
    bool (Int32 -> Bool) -> IO Int32 -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Display -> XftFont -> Word32 -> IO Int32
    cXftCharExists Display
    d XftFont
    f (Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fi (Int -> Word32) -> Int -> Word32
    forall a b. (a -> b) -> a -> b
    $ Char -> Int
    ord Char
    c)
      where
        bool :: a -> Bool
    bool a
    0 = Bool
    False
        bool a
    _ = Bool
    True

    foreign import ccall "XftDrawGlyphs"
      cXftDrawGlyphs :: XftDraw -> XftColor -> XftFont -> CInt -> CInt -> Ptr (Word32) -> CInt -> IO ()
    {-# LINE 223 "Graphics/X11/Xft.hsc" #-}

    xftDrawGlyphs :: (Integral a, Integral b, Integral c)
                  => XftDraw -> XftColor -> XftFont -> b -> c -> [a] -> IO ()
    xftDrawGlyphs :: forall a b c.
    (Integral a, Integral b, Integral c) =>
    XftDraw -> XftColor -> XftFont -> b -> c -> [a] -> IO ()
    xftDrawGlyphs XftDraw
    d XftColor
    c XftFont
    f b
    x c
    y [a]
    glyphs =
        [Word32] -> (Int -> Ptr Word32 -> IO ()) -> IO ()
    forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
    withArrayLen ((a -> Word32) -> [a] -> [Word32]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fi [a]
    glyphs)
          (\Int
    len Ptr Word32
    ptr -> XftDraw
    -> XftColor
    -> XftFont
    -> CInt
    -> CInt
    -> Ptr Word32
    -> CInt
    -> IO ()
    cXftDrawGlyphs XftDraw
    d XftColor
    c XftFont
    f (b -> CInt
    forall a b. (Integral a, Num b) => a -> b
    fi b
    x) (c -> CInt
    forall a b. (Integral a, Num b) => a -> b
    fi c
    y) Ptr Word32
    ptr (Int -> CInt
    forall a b. (Integral a, Num b) => a -> b
    fi Int
    len))

    foreign import ccall "XftDrawStringUtf8"
      cXftDrawStringUtf8 :: XftDraw -> XftColor -> XftFont -> CInt -> CInt -> Ptr (Word8) -> CInt -> IO ()
    {-# LINE 232 "Graphics/X11/Xft.hsc" #-}

    xftDrawString :: (Integral a, Integral b)
                  => XftDraw -> XftColor -> XftFont -> a -> b -> String -> IO ()
    xftDrawString :: forall a b.
    (Integral a, Integral b) =>
    XftDraw -> XftColor -> XftFont -> a -> b -> String -> IO ()
    xftDrawString XftDraw
    d XftColor
    c XftFont
    f a
    x b
    y String
    string =
        [Word8] -> (Int -> Ptr Word8 -> IO ()) -> IO ()
    forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
    withArrayLen ((Word8 -> Word8) -> [Word8] -> [Word8]
    forall a b. (a -> b) -> [a] -> [b]
    map Word8 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fi (String -> [Word8]
    UTF8.encode String
    string))
          (\Int
    len Ptr Word8
    ptr -> XftDraw
    -> XftColor
    -> XftFont
    -> CInt
    -> CInt
    -> Ptr Word8
    -> CInt
    -> IO ()
    cXftDrawStringUtf8 XftDraw
    d XftColor
    c XftFont
    f (a -> CInt
    forall a b. (Integral a, Num b) => a -> b
    fi a
    x) (b -> CInt
    forall a b. (Integral a, Num b) => a -> b
    fi b
    y) Ptr Word8
    ptr (Int -> CInt
    forall a b. (Integral a, Num b) => a -> b
    fi Int
    len))

    -- Querying text extends for strings or glyphs --

    foreign import ccall "XftTextExtentsUtf8"
      cXftTextExtentsUtf8 :: Display -> XftFont -> CString -> CInt -> Ptr XGlyphInfo -> IO ()

    xftTextExtents :: Display -> XftFont -> String -> IO XGlyphInfo
    xftTextExtents :: Display -> XftFont -> String -> IO XGlyphInfo
    xftTextExtents Display
    d XftFont
    f String
    string =
        [CChar] -> (Int -> CString -> IO XGlyphInfo) -> IO XGlyphInfo
    forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
    withArrayLen ((Word8 -> CChar) -> [Word8] -> [CChar]
    forall a b. (a -> b) -> [a] -> [b]
    map Word8 -> CChar
    forall a b. (Integral a, Num b) => a -> b
    fi (String -> [Word8]
    UTF8.encode String
    string)) ((Int -> CString -> IO XGlyphInfo) -> IO XGlyphInfo)
    -> (Int -> CString -> IO XGlyphInfo) -> IO XGlyphInfo
    forall a b. (a -> b) -> a -> b
    $
        \Int
    len CString
    str_ptr -> (Ptr XGlyphInfo -> IO XGlyphInfo) -> IO XGlyphInfo
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
    alloca ((Ptr XGlyphInfo -> IO XGlyphInfo) -> IO XGlyphInfo)
    -> (Ptr XGlyphInfo -> IO XGlyphInfo) -> IO XGlyphInfo
    forall a b. (a -> b) -> a -> b
    $
        \Ptr XGlyphInfo
    cglyph -> do
          Display -> XftFont -> CString -> CInt -> Ptr XGlyphInfo -> IO ()
    cXftTextExtentsUtf8 Display
    d XftFont
    f CString
    str_ptr (Int -> CInt
    forall a b. (Integral a, Num b) => a -> b
    fi Int
    len) Ptr XGlyphInfo
    cglyph
          Ptr XGlyphInfo -> IO XGlyphInfo
    forall a. Storable a => Ptr a -> IO a
    peek Ptr XGlyphInfo
    cglyph

    -- Support for multiple fonts --

    -- | Like 'xftDrawString', but fall back to another font in the given
    -- list if necessary (i.e., should a character not be drawable with the
    -- currently selected font).
    xftDrawStringFallback :: XftDraw -> XftColor -> [XftFont] -> Int -> Int -> String -> IO ()
    xftDrawStringFallback :: XftDraw -> XftColor -> [XftFont] -> Int -> Int -> String -> IO ()
    xftDrawStringFallback XftDraw
    d XftColor
    c [XftFont]
    fs Int
    x Int
    y String
    string = do
        Display
    display <- XftDraw -> IO Display
    xftDrawDisplay XftDraw
    d
        [(XftFont, String, XGlyphInfo)]
    chunks <- Display
    -> [XftFont]
    -> Int
    -> Int
    -> String
    -> IO [(XftFont, String, XGlyphInfo)]
    getChunks Display
    display [XftFont]
    fs Int
    x Int
    y String
    string
        ((XftFont, String, XGlyphInfo) -> IO ())
    -> [(XftFont, String, XGlyphInfo)] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (\(XftFont
    f, String
    s, (XGlyphInfo Int
    _  Int
    _ Int
    x' Int
    y' Int
    _ Int
    _)) -> XftDraw -> XftColor -> XftFont -> Int -> Int -> String -> IO ()
    forall a b.
    (Integral a, Integral b) =>
    XftDraw -> XftColor -> XftFont -> a -> b -> String -> IO ()
    xftDrawString XftDraw
    d XftColor
    c XftFont
    f Int
    x' Int
    y' String
    s) [(XftFont, String, XGlyphInfo)]
    chunks

    -- | Like 'xftTextExtents' but for multiple fonts. Return
    -- accumulative extents using appropriate fonts for each part of
    -- string.
    xftTextAccumExtents :: Display -> [XftFont] -> String -> IO XGlyphInfo
    xftTextAccumExtents :: Display -> [XftFont] -> String -> IO XGlyphInfo
    xftTextAccumExtents Display
    disp [XftFont]
    fts String
    string = do
      [XGlyphInfo]
    chunks <- ((XftFont, String, XGlyphInfo) -> XGlyphInfo)
    -> [(XftFont, String, XGlyphInfo)] -> [XGlyphInfo]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ (XftFont
    _, String
    _, XGlyphInfo
    gi) -> XGlyphInfo
    gi) ([(XftFont, String, XGlyphInfo)] -> [XGlyphInfo])
    -> IO [(XftFont, String, XGlyphInfo)] -> IO [XGlyphInfo]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Display
    -> [XftFont]
    -> Int
    -> Int
    -> String
    -> IO [(XftFont, String, XGlyphInfo)]
    getChunks Display
    disp [XftFont]
    fts Int
    0 Int
    0 String
    string
      XGlyphInfo -> IO XGlyphInfo
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XGlyphInfo -> IO XGlyphInfo) -> XGlyphInfo -> IO XGlyphInfo
    forall a b. (a -> b) -> a -> b
    $ (XGlyphInfo -> XGlyphInfo -> XGlyphInfo)
    -> XGlyphInfo -> [XGlyphInfo] -> XGlyphInfo
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' XGlyphInfo -> XGlyphInfo -> XGlyphInfo
    calcExtents (Int -> Int -> Int -> Int -> Int -> Int -> XGlyphInfo
    XGlyphInfo Int
    0 Int
    0 Int
    0 Int
    0 Int
    0 Int
    0) [XGlyphInfo]
    chunks
      where
        calcExtents :: XGlyphInfo -> XGlyphInfo -> XGlyphInfo
        calcExtents :: XGlyphInfo -> XGlyphInfo -> XGlyphInfo
    calcExtents (XGlyphInfo Int
    _ Int
    _ Int
    x Int
    y Int
    xo Int
    yo) (XGlyphInfo Int
    w' Int
    h' Int
    _ Int
    _ Int
    xo' Int
    yo')
          = Int -> Int -> Int -> Int -> Int -> Int -> XGlyphInfo
    XGlyphInfo (Int
    xo Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    w') (Int
    yo Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    h') Int
    x Int
    y (Int
    xo Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    xo') (Int
    yo Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    yo')

    -- | Split string and determine fonts/offsets for individual parts
    getChunks :: Display
              -> [XftFont]
              -> Int
              -> Int
              -> String
              -> IO [(XftFont, String, XGlyphInfo)]
    getChunks :: Display
    -> [XftFont]
    -> Int
    -> Int
    -> String
    -> IO [(XftFont, String, XGlyphInfo)]
    getChunks Display
    disp [XftFont]
    fts Int
    xInit Int
    yInit String
    str = do
        [(XftFont, String)]
    chunks <- [XftFont] -> String -> IO [(XftFont, String)]
    getFonts [XftFont]
    fts String
    str
        Int
    -> Int -> [(XftFont, String)] -> IO [(XftFont, String, XGlyphInfo)]
    getChunksExtents Int
    xInit Int
    yInit [(XftFont, String)]
    chunks
      where
        -- Split string and determine fonts for individual parts
        getFonts :: [XftFont] -> String -> IO [(XftFont, String)]
        getFonts :: [XftFont] -> String -> IO [(XftFont, String)]
    getFonts [] String
    _ = [(XftFont, String)] -> IO [(XftFont, String)]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
        getFonts [XftFont
    ft] String
    s = [(XftFont, String)] -> IO [(XftFont, String)]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(XftFont
    ft, String
    s)]
        getFonts fonts :: [XftFont]
    fonts@(XftFont
    ft:[XftFont]
    _) String
    s = do
            -- Determine which glyph can be rendered by current font
            [Bool]
    glyphs <- (Char -> IO Bool) -> String -> IO [Bool]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Display -> XftFont -> Char -> IO Bool
    xftCharExists Display
    disp XftFont
    ft) String
    s
            -- Split string into parts that return "can/cannot be rendered"
            let splits :: [(Bool, String)]
    splits = ([(Bool, Char)] -> (Bool, String))
    -> [[(Bool, Char)]] -> [(Bool, String)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Bool, Char) -> Bool
    forall a b. (a, b) -> a
    fst ((Bool, Char) -> Bool)
    -> ([(Bool, Char)] -> (Bool, Char)) -> [(Bool, Char)] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(Bool, Char)] -> (Bool, Char)
    forall a. HasCallStack => [a] -> a
    head ([(Bool, Char)] -> Bool)
    -> ([(Bool, Char)] -> String) -> [(Bool, Char)] -> (Bool, String)
    forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& ((Bool, Char) -> Char) -> [(Bool, Char)] -> String
    forall a b. (a -> b) -> [a] -> [b]
    map (Bool, Char) -> Char
    forall a b. (a, b) -> b
    snd)
                       ([[(Bool, Char)]] -> [(Bool, String)])
    -> ([(Bool, Char)] -> [[(Bool, Char)]])
    -> [(Bool, Char)]
    -> [(Bool, String)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Bool, Char) -> (Bool, Char) -> Bool)
    -> [(Bool, Char)] -> [[(Bool, Char)]]
    forall a. (a -> a -> Bool) -> [a] -> [[a]]
    groupBy (Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) (Bool -> Bool -> Bool)
    -> ((Bool, Char) -> Bool) -> (Bool, Char) -> (Bool, Char) -> Bool
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` (Bool, Char) -> Bool
    forall a b. (a, b) -> a
    fst)
                       ([(Bool, Char)] -> [(Bool, String)])
    -> [(Bool, Char)] -> [(Bool, String)]
    forall a b. (a -> b) -> a -> b
    $ [Bool] -> String -> [(Bool, Char)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Bool]
    glyphs String
    s
            -- Determine which font to render each chunk with
            [[(XftFont, String)]] -> [(XftFont, String)]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[(XftFont, String)]] -> [(XftFont, String)])
    -> IO [[(XftFont, String)]] -> IO [(XftFont, String)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((Bool, String) -> IO [(XftFont, String)])
    -> [(Bool, String)] -> IO [[(XftFont, String)]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM ([XftFont] -> (Bool, String) -> IO [(XftFont, String)]
    getFont [XftFont]
    fonts) [(Bool, String)]
    splits

        -- Determine fonts for substrings
        getFont :: [XftFont] -> (Bool, String) -> IO [(XftFont, String)]
        getFont :: [XftFont] -> (Bool, String) -> IO [(XftFont, String)]
    getFont [] (Bool, String)
    _ = [(XftFont, String)] -> IO [(XftFont, String)]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
        getFont [XftFont
    ft] (Bool
    _, String
    s) = [(XftFont, String)] -> IO [(XftFont, String)]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(XftFont
    ft, String
    s)]      -- Last font, use it
        getFont (XftFont
    ft:[XftFont]
    _) (Bool
    True, String
    s) = [(XftFont, String)] -> IO [(XftFont, String)]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(XftFont
    ft, String
    s)] -- Current font can render this substring
        getFont (XftFont
    _:[XftFont]
    fs) (Bool
    False, String
    s) = [XftFont] -> String -> IO [(XftFont, String)]
    getFonts [XftFont]
    fs String
    s   -- Fallback to next font

        -- Determine coordinates for chunks using extents
        getChunksExtents :: Int -> Int -> [(XftFont, String)] -> IO [(XftFont, String, XGlyphInfo)]
        getChunksExtents :: Int
    -> Int -> [(XftFont, String)] -> IO [(XftFont, String, XGlyphInfo)]
    getChunksExtents Int
    _ Int
    _ [] = [(XftFont, String, XGlyphInfo)]
    -> IO [(XftFont, String, XGlyphInfo)]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
        getChunksExtents Int
    x Int
    y ((XftFont
    f, String
    s) : [(XftFont, String)]
    chunks) = do
          (XGlyphInfo Int
    w Int
    h Int
    _ Int
    _ Int
    xo Int
    yo) <- Display -> XftFont -> String -> IO XGlyphInfo
    xftTextExtents Display
    disp XftFont
    f String
    s
          [(XftFont, String, XGlyphInfo)]
    rest <- Int
    -> Int -> [(XftFont, String)] -> IO [(XftFont, String, XGlyphInfo)]
    getChunksExtents (Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    xo) (Int
    y Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    yo) [(XftFont, String)]
    chunks
          [(XftFont, String, XGlyphInfo)]
    -> IO [(XftFont, String, XGlyphInfo)]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(XftFont, String, XGlyphInfo)]
     -> IO [(XftFont, String, XGlyphInfo)])
    -> [(XftFont, String, XGlyphInfo)]
    -> IO [(XftFont, String, XGlyphInfo)]
    forall a b. (a -> b) -> a -> b
    $ (XftFont
    f, String
    s, Int -> Int -> Int -> Int -> Int -> Int -> XGlyphInfo
    XGlyphInfo Int
    w Int
    h Int
    x Int
    y Int
    xo Int
    yo) (XftFont, String, XGlyphInfo)
    -> [(XftFont, String, XGlyphInfo)]
    -> [(XftFont, String, XGlyphInfo)]
    forall a. a -> [a] -> [a]
    : [(XftFont, String, XGlyphInfo)]
    rest

    -- Drawing auxilary --

    foreign import ccall "XftDrawRect"
      cXftDrawRect :: XftDraw -> XftColor -> CInt -> CInt -> CUInt -> CUInt -> IO ()

    xftDrawRect :: (Integral a, Integral b, Integral c, Integral d)
                => XftDraw -> XftColor -> a -> b -> c -> d -> IO ()
    xftDrawRect :: forall a b c d.
    (Integral a, Integral b, Integral c, Integral d) =>
    XftDraw -> XftColor -> a -> b -> c -> d -> IO ()
    xftDrawRect XftDraw
    draw XftColor
    color a
    x b
    y c
    width d
    height =
        XftDraw -> XftColor -> CInt -> CInt -> CUInt -> CUInt -> IO ()
    cXftDrawRect XftDraw
    draw XftColor
    color (a -> CInt
    forall a b. (Integral a, Num b) => a -> b
    fi a
    x) (b -> CInt
    forall a b. (Integral a, Num b) => a -> b
    fi b
    y) (c -> CUInt
    forall a b. (Integral a, Num b) => a -> b
    fi c
    width) (d -> CUInt
    forall a b. (Integral a, Num b) => a -> b
    fi d
    height)

    foreign import ccall "XftDrawSetClip"
        cXftDrawSetClip :: XftDraw -> Ptr Region -> IO (Int32)
    {-# LINE 327 "Graphics/X11/Xft.hsc" #-}

    --xftDrawSetClip d (Region r) =
    --    do
    --      rv <- cXftDrawSetClip d r
    --      return $ (fi rv) /= 0

    foreign import ccall "XftDrawSetClipRectangles"
      cXftDrawSetClipRectangles :: XftDraw -> CInt -> CInt -> (Ptr Rectangle) -> CInt -> IO CInt

    xftDrawSetClipRectangles :: XftDraw -> Int -> Int -> [Rectangle] -> IO Bool
    xftDrawSetClipRectangles :: XftDraw -> Int -> Int -> [Rectangle] -> IO Bool
    xftDrawSetClipRectangles XftDraw
    draw Int
    x Int
    y [Rectangle]
    rectangles =
        [Rectangle] -> (Int -> Ptr Rectangle -> IO Bool) -> IO Bool
    forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
    withArrayLen [Rectangle]
    rectangles
          (\Int
    len Ptr Rectangle
    rects -> do
             CInt
    r <- XftDraw -> CInt -> CInt -> Ptr Rectangle -> CInt -> IO CInt
    cXftDrawSetClipRectangles XftDraw
    draw (Int -> CInt
    forall a b. (Integral a, Num b) => a -> b
    fi Int
    x) (Int -> CInt
    forall a b. (Integral a, Num b) => a -> b
    fi Int
    y) Ptr Rectangle
    rects (Int -> CInt
    forall a b. (Integral a, Num b) => a -> b
    fi Int
    len)
             Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CInt -> Integer
    forall a. Integral a => a -> Integer
    toInteger CInt
    r Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Integer
    0)) -- verify whether this is really the convention

    foreign import ccall "XftDrawSetSubwindowMode"
      cXftDrawSetSubwindowMode :: XftDraw -> CInt -> IO ()

    xftDrawSetSubwindowMode :: Integral a => XftDraw -> a -> IO ()
    xftDrawSetSubwindowMode :: forall a. Integral a => XftDraw -> a -> IO ()
    xftDrawSetSubwindowMode XftDraw
    d a
    i = XftDraw -> CInt -> IO ()
    cXftDrawSetSubwindowMode XftDraw
    d (a -> CInt
    forall a b. (Integral a, Num b) => a -> b
    fi a
    i)

    --------------
    -- Auxillary
    --------------

    foreign import ccall "XftInitFtLibrary"
      xftInitFtLibrary :: IO ()

    {-
    These functions minimize round-trip between the library and the using program (maybe also to the X server?)
    but otherwise all the functions can be achieved by DrawGlyphs

    void
    XftDrawCharSpec (XftDraw                *draw,
                     _Xconst XftColor       *color,
                     XftFont                *pub,
                     _Xconst XftCharSpec    *chars,
                     int                    len);

    void
    XftDrawCharFontSpec (XftDraw                    *draw,
                         _Xconst XftColor           *color,
                         _Xconst XftCharFontSpec    *chars,
                         int                        len);

    void
    XftDrawGlyphSpec (XftDraw               *draw,
                      _Xconst XftColor      *color,
                      XftFont               *pub,
                      _Xconst XftGlyphSpec  *glyphs,
                      int                   len);

    void
    XftDrawGlyphFontSpec (XftDraw                   *draw,
                          _Xconst XftColor          *color,
                          _Xconst XftGlyphFontSpec  *glyphs,
                          int                       len);
    ------
    Missing
    void
    XftGlyphExtents (Display            *dpy,
                     XftFont            *pub,
                     _Xconst FT_UInt    *glyphs,
                     int                nglyphs,
                     XGlyphInfo         *extents);

    Intentionally Missing Bindings
    xftDrawString8,xftDrawString16,xftDrawString32,xftDrawStringUtf16

    --foreign import ccall "XftDrawSetClip"
    -- cXftDrawSetClip :: XftDraw -> Ptr (??) Region -> IO (#type Bool)

    Missing Bindings because of missing Freetype bindings

    /* xftfreetype.c */

    XftFontInfo *
    XftFontInfoCreate (Display *dpy, _Xconst FcPattern *pattern);

    void
    XftFontInfoDestroy (Display *dpy, XftFontInfo *fi);

    FcChar32
    XftFontInfoHash (_Xconst XftFontInfo *fi);

    FcBool
    XftFontInfoEqual (_Xconst XftFontInfo *a, _Xconst XftFontInfo *b);

    XftFont *
    XftFontOpenInfo (Display        *dpy,
                     FcPattern      *pattern,
                     XftFontInfo    *fi);

    XftFont *
    XftFontOpenPattern (Display *dpy, FcPattern *pattern);

    -- no Render bindings yet
    --foreign import ccall "XftDrawPicture"
    --  cXftDrawPicture :: XftDraw -> IO Picture
    --foreign import ccall "XftDrawPicture"
    --  cXftDrawSrcPicture :: XftDraw -> XftColor -> IO Picture
    -}

    -- | Short-hand for 'fromIntegral'
    fi :: (Integral a, Num b) => a -> b
    fi :: forall a b. (Integral a, Num b) => a -> b
    fi = a -> b
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral