{-# LANGUAGE CPP #-}
----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Util.Font
-- Description :  A module for abstracting a font facility over Core fonts and Xft.
-- Copyright   :  (c) 2007 Andrea Rossato and Spencer Janssen
-- License     :  BSD-style (see xmonad/LICENSE)
--
-- Maintainer  :  andrea.rossato@unibz.it
-- Stability   :  unstable
-- Portability :  unportable
--
-- A module for abstracting a font facility over Core fonts and Xft
--
-----------------------------------------------------------------------------

module XMonad.Util.Font
    ( -- * Usage:
      -- $usage
      XMonadFont(..)
    , initXMF
    , releaseXMF
    , initCoreFont
    , releaseCoreFont
    , initUtf8Font
    , releaseUtf8Font
    , Align (..)
    , stringPosition
    , textWidthXMF
    , textExtentsXMF
    , printStringXMF
    , stringToPixel
    , pixelToString
    , fi
    ) where

import XMonad
import XMonad.Prelude
import Foreign
import Control.Exception as E
import Text.Printf (printf)

#ifdef XFT
import qualified Data.List.NonEmpty as NE
import Graphics.X11.Xrender
import Graphics.X11.Xft
#endif

-- Hide the Core Font/Xft switching here
data XMonadFont = Core FontStruct
                | Utf8 FontSet
#ifdef XFT
                | Xft  (NE.NonEmpty XftFont)
#endif

-- $usage
-- See "XMonad.Layout.Tabbed" or "XMonad.Prompt" for usage examples

-- | Get the Pixel value for a named color: if an invalid name is
-- given the black pixel will be returned.
stringToPixel :: (Functor m, MonadIO m) => Display -> String -> m Pixel
stringToPixel :: forall (m :: * -> *).
(Functor m, MonadIO m) =>
Display -> String -> m Pixel
stringToPixel Display
d String
s = forall a. a -> Maybe a -> a
fromMaybe Pixel
fallBack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO (Maybe Pixel)
getIt
    where getIt :: IO (Maybe Pixel)
getIt    = Display -> String -> IO (Maybe Pixel)
initColor Display
d String
s
          fallBack :: Pixel
fallBack = Display -> ScreenNumber -> Pixel
blackPixel Display
d (Display -> ScreenNumber
defaultScreen Display
d)

-- | Convert a @Pixel@ into a @String@.
--
-- This function removes any alpha channel from the @Pixel@, because X11
-- mishandles alpha channels and produces black.
pixelToString :: (MonadIO m) => Display -> Pixel -> m String
pixelToString :: forall (m :: * -> *). MonadIO m => Display -> Pixel -> m String
pixelToString Display
d Pixel
p = do
    let cm :: Pixel
cm = Display -> ScreenNumber -> Pixel
defaultColormap Display
d (Display -> ScreenNumber
defaultScreen Display
d)
    (Color Pixel
_ Word16
r Word16
g Word16
b Word8
_) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (Display -> Pixel -> Color -> IO Color
queryColor Display
d Pixel
cm forall a b. (a -> b) -> a -> b
$ Pixel -> Word16 -> Word16 -> Word16 -> Word8 -> Color
Color (Pixel
p forall a. Bits a => a -> a -> a
.&. Pixel
0x00FFFFFF) Word16
0 Word16
0 Word16
0 Word8
0)
    forall (m :: * -> *) a. Monad m => a -> m a
return (String
"#" forall a. [a] -> [a] -> [a]
++ Word16 -> String
hex Word16
r forall a. [a] -> [a] -> [a]
++ Word16 -> String
hex Word16
g forall a. [a] -> [a] -> [a]
++ Word16 -> String
hex Word16
b)
  where
    -- NOTE: The @Color@ type has 16-bit values for red, green, and
    -- blue, even though the actual type in X is only 8 bits wide.  It
    -- seems that the upper and lower 8-bit sections of the @Word16@
    -- values are the same.  So, we just discard the lower 8 bits.
    --
    -- (Strictly, X11 supports 16-bit values but no visual supported
    -- by XOrg does. It is still correct to discard the lower bits, as
    -- they are not guaranteed to be meaningful in such visuals.)
    hex :: Word16 -> String
hex = forall r. PrintfType r => String -> r
printf String
"%02x" forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Bits a => a -> Int -> a
`shiftR` Int
8)

econst :: a -> IOException -> a
econst :: forall a. a -> IOException -> a
econst = forall a b. a -> b -> a
const

-- | Given a fontname returns the font structure. If the font name is
--  not valid the default font will be loaded and returned.
initCoreFont :: String -> X FontStruct
initCoreFont :: String -> X FontStruct
initCoreFont String
s = do
  Display
d <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (Display -> IO FontStruct
getIt Display
d) (Display -> IOException -> IO FontStruct
fallBack Display
d)
      where getIt :: Display -> IO FontStruct
getIt    Display
d = Display -> String -> IO FontStruct
loadQueryFont Display
d String
s
            fallBack :: Display -> IOException -> IO FontStruct
fallBack Display
d = forall a. a -> IOException -> a
econst forall a b. (a -> b) -> a -> b
$ Display -> String -> IO FontStruct
loadQueryFont Display
d String
"-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"

releaseCoreFont :: FontStruct -> X ()
releaseCoreFont :: FontStruct -> X ()
releaseCoreFont FontStruct
fs = do
  Display
d <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> FontStruct -> IO ()
freeFont Display
d FontStruct
fs

initUtf8Font :: String -> X FontSet
initUtf8Font :: String -> X FontSet
initUtf8Font String
s = do
  Display
d <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
  ([String]
_,String
_,FontSet
fs) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (Display -> IO ([String], String, FontSet)
getIt Display
d) (Display -> IOException -> IO ([String], String, FontSet)
fallBack Display
d)
  forall (m :: * -> *) a. Monad m => a -> m a
return FontSet
fs
      where getIt :: Display -> IO ([String], String, FontSet)
getIt    Display
d = Display -> String -> IO ([String], String, FontSet)
createFontSet Display
d String
s
            fallBack :: Display -> IOException -> IO ([String], String, FontSet)
fallBack Display
d = forall a. a -> IOException -> a
econst forall a b. (a -> b) -> a -> b
$ Display -> String -> IO ([String], String, FontSet)
createFontSet Display
d String
"-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"

releaseUtf8Font :: FontSet -> X ()
releaseUtf8Font :: FontSet -> X ()
releaseUtf8Font FontSet
fs = do
  Display
d <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> FontSet -> IO ()
freeFontSet Display
d FontSet
fs

-- | When initXMF gets a font name that starts with 'xft:' it switches to the Xft backend
-- Example: 'xft: Sans-10'
initXMF :: String -> X XMonadFont
initXMF :: String -> X XMonadFont
initXMF String
s =
#ifndef XFT
  Utf8 <$> initUtf8Font s
#else
  if String
xftPrefix forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s then
     do Display
dpy <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
        let fonts :: NonEmpty String
fonts = case (Char -> Bool) -> String -> [String]
wordsBy (forall a. Eq a => a -> a -> Bool
== Char
',') (forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
xftPrefix) String
s) of
              []       -> String
fallback forall a. a -> [a] -> NonEmpty a
:| []  -- NE.singleton only in base 4.15
              (String
x : [String]
xs) -> String
x forall a. a -> [a] -> NonEmpty a
:| [String]
xs
        XftFont
fb <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> String -> IO XftFont
openFont Display
dpy String
fallback
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty XftFont -> XMonadFont
Xft forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\String
f -> forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (Display -> String -> IO XftFont
openFont Display
dpy String
f) (forall a. a -> IOException -> a
econst forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure XftFont
fb))
                                 NonEmpty String
fonts
  else FontSet -> XMonadFont
Utf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> X FontSet
initUtf8Font String
s
 where
  xftPrefix :: String
xftPrefix = String
"xft:"
  fallback :: String
fallback  = String
"xft:monospace"
  openFont :: Display -> String -> IO XftFont
openFont Display
dpy String
str = Display -> Screen -> String -> IO XftFont
xftFontOpen Display
dpy (Display -> Screen
defaultScreenOfDisplay Display
dpy) String
str
  wordsBy :: (Char -> Bool) -> String -> [String]
wordsBy Char -> Bool
p String
str = case forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
p String
str of
    String
""   -> []
    String
str' -> String
w forall a. a -> [a] -> [a]
: (Char -> Bool) -> String -> [String]
wordsBy Char -> Bool
p String
str''
     where (String
w, String
str'') = forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
p String
str'
#endif

releaseXMF :: XMonadFont -> X ()
#ifdef XFT
releaseXMF :: XMonadFont -> X ()
releaseXMF (Xft NonEmpty XftFont
xftfonts) = do
  Display
dpy <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Display -> XftFont -> IO ()
xftFontClose Display
dpy) NonEmpty XftFont
xftfonts
#endif
releaseXMF (Utf8 FontSet
fs) = FontSet -> X ()
releaseUtf8Font FontSet
fs
releaseXMF (Core FontStruct
fs) = FontStruct -> X ()
releaseCoreFont FontStruct
fs

textWidthXMF :: MonadIO m => Display -> XMonadFont -> String -> m Int
textWidthXMF :: forall (m :: * -> *).
MonadIO m =>
Display -> XMonadFont -> String -> m Int
textWidthXMF Display
_   (Utf8 FontSet
fs) String
s = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ FontSet -> String -> Int32
wcTextEscapement FontSet
fs String
s
textWidthXMF Display
_   (Core FontStruct
fs) String
s = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ FontStruct -> String -> Int32
textWidth FontStruct
fs String
s
#ifdef XFT
textWidthXMF Display
dpy (Xft NonEmpty XftFont
xftdraw) String
s = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
#if MIN_VERSION_X11_xft(0, 3, 4)
    XGlyphInfo
gi <- Display -> [XftFont] -> String -> IO XGlyphInfo
xftTextAccumExtents Display
dpy (forall l. IsList l => l -> [Item l]
toList NonEmpty XftFont
xftdraw) String
s
#else
    gi <- xftTextExtents dpy (NE.head xftdraw) s
#endif
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ XGlyphInfo -> Int
xglyphinfo_xOff XGlyphInfo
gi
#endif

textExtentsXMF :: MonadIO m => XMonadFont -> String -> m (Int32,Int32)
textExtentsXMF :: forall (m :: * -> *).
MonadIO m =>
XMonadFont -> String -> m (Int32, Int32)
textExtentsXMF (Utf8 FontSet
fs) String
s = do
  let (Rectangle
_,Rectangle
rl)  = FontSet -> String -> (Rectangle, Rectangle)
wcTextExtents FontSet
fs String
s
      ascent :: Int32
ascent  = forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ - (Rectangle -> Int32
rect_y Rectangle
rl)
      descent :: Int32
descent = forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ Rectangle -> ScreenNumber
rect_height Rectangle
rl forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Int32
rect_y Rectangle
rl)
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
ascent, Int32
descent)
textExtentsXMF (Core FontStruct
fs) String
s = do
  let (FontDirection
_,Int32
a,Int32
d,CharStruct
_) = FontStruct -> String -> (FontDirection, Int32, Int32, CharStruct)
textExtents FontStruct
fs String
s
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
a,Int32
d)
#ifdef XFT
#if MIN_VERSION_X11_xft(0, 3, 4)
textExtentsXMF (Xft NonEmpty XftFont
xftfonts) String
_ = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ do
  Int32
ascent  <- forall a b. (Integral a, Num b) => a -> b
fi forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty XftFont -> IO Int
xftfont_max_ascent  NonEmpty XftFont
xftfonts
  Int32
descent <- forall a b. (Integral a, Num b) => a -> b
fi forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty XftFont -> IO Int
xftfont_max_descent NonEmpty XftFont
xftfonts
#else
textExtentsXMF (Xft xftfonts) _ = io $ do
  ascent  <- fi <$> xftfont_ascent  (NE.head xftfonts)
  descent <- fi <$> xftfont_descent (NE.head xftfonts)
#endif
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
ascent, Int32
descent)
#endif

-- | String position
data Align = AlignCenter | AlignRight | AlignLeft | AlignRightOffset Int
                deriving (Int -> Align -> ShowS
[Align] -> ShowS
Align -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Align] -> ShowS
$cshowList :: [Align] -> ShowS
show :: Align -> String
$cshow :: Align -> String
showsPrec :: Int -> Align -> ShowS
$cshowsPrec :: Int -> Align -> ShowS
Show, ReadPrec [Align]
ReadPrec Align
Int -> ReadS Align
ReadS [Align]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Align]
$creadListPrec :: ReadPrec [Align]
readPrec :: ReadPrec Align
$creadPrec :: ReadPrec Align
readList :: ReadS [Align]
$creadList :: ReadS [Align]
readsPrec :: Int -> ReadS Align
$creadsPrec :: Int -> ReadS Align
Read)

-- | Return the string x and y 'Position' in a 'Rectangle', given a
-- 'FontStruct' and the 'Align'ment
stringPosition :: (Functor m, MonadIO m) => Display -> XMonadFont -> Rectangle -> Align -> String -> m (Position,Position)
stringPosition :: forall (m :: * -> *).
(Functor m, MonadIO m) =>
Display
-> XMonadFont -> Rectangle -> Align -> String -> m (Int32, Int32)
stringPosition Display
dpy XMonadFont
fs (Rectangle Int32
_ Int32
_ ScreenNumber
w ScreenNumber
h) Align
al String
s = do
  Int
width <- forall (m :: * -> *).
MonadIO m =>
Display -> XMonadFont -> String -> m Int
textWidthXMF Display
dpy XMonadFont
fs String
s
  (Int32
a,Int32
d) <- forall (m :: * -> *).
MonadIO m =>
XMonadFont -> String -> m (Int32, Int32)
textExtentsXMF XMonadFont
fs String
s
  let y :: Int32
y = forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ ((ScreenNumber
h forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi (Int32
a forall a. Num a => a -> a -> a
+ Int32
d)) forall a. Integral a => a -> a -> a
`div` ScreenNumber
2) forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Int32
a;
      x :: Int32
x = case Align
al of
            Align
AlignCenter -> forall a b. (Integral a, Num b) => a -> b
fi (ScreenNumber
w forall a. Integral a => a -> a -> a
`div` ScreenNumber
2) forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi (Int
width forall a. Integral a => a -> a -> a
`div` Int
2)
            Align
AlignLeft   -> Int32
1
            Align
AlignRight  -> forall a b. (Integral a, Num b) => a -> b
fi (ScreenNumber
w forall a. Num a => a -> a -> a
- (forall a b. (Integral a, Num b) => a -> b
fi Int
width forall a. Num a => a -> a -> a
+ ScreenNumber
1));
            AlignRightOffset Int
offset -> forall a b. (Integral a, Num b) => a -> b
fi (ScreenNumber
w forall a. Num a => a -> a -> a
- (forall a b. (Integral a, Num b) => a -> b
fi Int
width forall a. Num a => a -> a -> a
+ ScreenNumber
1)) forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Int
offset;
  forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
x,Int32
y)

printStringXMF :: (Functor m, MonadIO m) => Display -> Drawable -> XMonadFont -> GC -> String -> String
            -> Position -> Position -> String  -> m ()
printStringXMF :: forall (m :: * -> *).
(Functor m, MonadIO m) =>
Display
-> Pixel
-> XMonadFont
-> GC
-> String
-> String
-> Int32
-> Int32
-> String
-> m ()
printStringXMF Display
d Pixel
p (Core FontStruct
fs) GC
gc String
fc String
bc Int32
x Int32
y String
s = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ do
    Display -> GC -> Pixel -> IO ()
setFont Display
d GC
gc forall a b. (a -> b) -> a -> b
$ FontStruct -> Pixel
fontFromFontStruct FontStruct
fs
    [Pixel
fc',Pixel
bc'] <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
(Functor m, MonadIO m) =>
Display -> String -> m Pixel
stringToPixel Display
d) [String
fc,String
bc]
    Display -> GC -> Pixel -> IO ()
setForeground Display
d GC
gc Pixel
fc'
    Display -> GC -> Pixel -> IO ()
setBackground Display
d GC
gc Pixel
bc'
    Display -> Pixel -> GC -> Int32 -> Int32 -> String -> IO ()
drawImageString Display
d Pixel
p GC
gc Int32
x Int32
y String
s
printStringXMF Display
d Pixel
p (Utf8 FontSet
fs) GC
gc String
fc String
bc Int32
x Int32
y String
s = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ do
    [Pixel
fc',Pixel
bc'] <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
(Functor m, MonadIO m) =>
Display -> String -> m Pixel
stringToPixel Display
d) [String
fc,String
bc]
    Display -> GC -> Pixel -> IO ()
setForeground Display
d GC
gc Pixel
fc'
    Display -> GC -> Pixel -> IO ()
setBackground Display
d GC
gc Pixel
bc'
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> Pixel -> FontSet -> GC -> Int32 -> Int32 -> String -> IO ()
wcDrawImageString Display
d Pixel
p FontSet
fs GC
gc Int32
x Int32
y String
s
#ifdef XFT
printStringXMF Display
dpy Pixel
drw fs :: XMonadFont
fs@(Xft NonEmpty XftFont
fonts) GC
gc String
fc String
bc Int32
x Int32
y String
s = do
  let screen :: Screen
screen   = Display -> Screen
defaultScreenOfDisplay Display
dpy
      colormap :: Pixel
colormap = Screen -> Pixel
defaultColormapOfScreen Screen
screen
      visual :: Visual
visual   = Screen -> Visual
defaultVisualOfScreen Screen
screen
  Pixel
bcolor <- forall (m :: * -> *).
(Functor m, MonadIO m) =>
Display -> String -> m Pixel
stringToPixel Display
dpy String
bc
  (Int32
a,Int32
d)  <- forall (m :: * -> *).
MonadIO m =>
XMonadFont -> String -> m (Int32, Int32)
textExtentsXMF XMonadFont
fs String
s
#if MIN_VERSION_X11_xft(0, 3, 4)
  XGlyphInfo
gi <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> [XftFont] -> String -> IO XGlyphInfo
xftTextAccumExtents Display
dpy (forall l. IsList l => l -> [Item l]
toList NonEmpty XftFont
fonts) String
s
#else
  gi <- io $ xftTextExtents dpy (NE.head fonts) s
#endif
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> GC -> Pixel -> IO ()
setForeground Display
dpy GC
gc Pixel
bcolor
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> Pixel
-> GC
-> Int32
-> Int32
-> ScreenNumber
-> ScreenNumber
-> IO ()
fillRectangle Display
dpy Pixel
drw GC
gc (Int32
x forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi (XGlyphInfo -> Int
xglyphinfo_x XGlyphInfo
gi))
                                (Int32
y forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Int32
a)
                                (forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ XGlyphInfo -> Int
xglyphinfo_xOff XGlyphInfo
gi)
                                (forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ Int32
a forall a. Num a => a -> a -> a
+ Int32
d)
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall a.
Display -> Pixel -> Visual -> Pixel -> (XftDraw -> IO a) -> IO a
withXftDraw Display
dpy Pixel
drw Visual
visual Pixel
colormap forall a b. (a -> b) -> a -> b
$
         \XftDraw
draw -> forall a.
Display -> Visual -> Pixel -> String -> (XftColor -> IO a) -> IO a
withXftColorName Display
dpy Visual
visual Pixel
colormap String
fc forall a b. (a -> b) -> a -> b
$
#if MIN_VERSION_X11_xft(0, 3, 4)
                   \XftColor
color -> XftDraw -> XftColor -> [XftFont] -> Int -> Int -> String -> IO ()
xftDrawStringFallback XftDraw
draw XftColor
color (forall l. IsList l => l -> [Item l]
toList NonEmpty XftFont
fonts) (forall a b. (Integral a, Num b) => a -> b
fi Int32
x) (forall a b. (Integral a, Num b) => a -> b
fi Int32
y) String
s
#else
                   \color -> xftDrawString draw color (NE.head fonts) x y s
#endif
#endif