{-# LINE 1 "Graphics/X11/Xft.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
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 (foldl')
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NonEmpty
import Foreign hiding (void)
import Foreign.C.String
import Foreign.C.Types
newtype XftColor = XftColor (Ptr XftColor)
xftcolor_pixel :: XftColor -> IO Int
xftcolor_pixel :: XftColor -> IO Int
xftcolor_pixel (XftColor Ptr XftColor
p) = forall a. Ptr a -> CInt -> IO Int
peekCUShort Ptr XftColor
p (CInt
0)
{-# LINE 79 "Graphics/X11/Xft.hsc" #-}
foreign import ccall "XftColorAllocName"
cXftColorAllocName :: Display -> Visual -> Colormap -> CString -> XftColor -> IO (Int32)
{-# LINE 83 "Graphics/X11/Xft.hsc" #-}
allocaXftColor :: (Ptr XftColor -> IO a) -> IO a
allocaXftColor :: forall a. (Ptr XftColor -> IO a) -> IO a
allocaXftColor = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes ((Int
16))
{-# LINE 86 "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 =
forall a. (Ptr XftColor -> IO a) -> IO a
allocaXftColor forall a b. (a -> b) -> a -> b
$ (\XftColor
color -> do
forall a. String -> (CString -> IO a) -> IO a
withCAString String
name (\CString
cstring -> do
forall (f :: * -> *) a. Functor f => f a -> f ()
void 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
forall (m :: * -> *) a. Monad m => a -> m a
return a
r)) 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 98 "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 =
forall a. (Ptr XftColor -> IO a) -> IO a
allocaXftColor forall a b. (a -> b) -> a -> b
$ (\XftColor
color -> do
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with XRenderColor
rc (\Ptr XRenderColor
rc_ptr -> do
forall (f :: * -> *) a. Functor f => f a -> f ()
void 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
forall (m :: * -> *) a. Monad m => a -> m a
return a
r)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr XftColor -> XftColor
XftColor
foreign import ccall "XftColorFree"
cXftColorFree :: Display -> Visual -> Colormap -> XftColor -> IO ()
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
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 (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
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 ()
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) = forall a. Ptr a -> CInt -> IO Int
peekCUShort Ptr XftFont
p (CInt
0)
{-# LINE 163 "Graphics/X11/Xft.hsc" #-}
xftfont_descent (XftFont p) = peekCUShort p (4)
{-# LINE 164 "Graphics/X11/Xft.hsc" #-}
xftfont_height (XftFont p) = peekCUShort p (8)
{-# LINE 165 "Graphics/X11/Xft.hsc" #-}
xftfont_max_advance_width (XftFont p) = peekCUShort p (12)
{-# LINE 166 "Graphics/X11/Xft.hsc" #-}
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 =
forall a. String -> (CString -> IO a) -> IO a
withCAString String
fontname forall a b. (a -> b) -> a -> b
$
\CString
cfontname -> Display -> CInt -> CString -> IO XftFont
cXftFontOpen Display
dpy (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 =
forall a. String -> (CString -> IO a) -> IO a
withCAString String
fontname forall a b. (a -> b) -> a -> b
$ \CString
cfontname -> Display -> CInt -> CString -> IO XftFont
cXftFontOpenXlfd Display
dpy (forall a b. (Integral a, Num b) => a -> b
fi (Screen -> Word32
screenNumberOfScreen Screen
screen)) CString
cfontname
foreign import ccall "XftLockFace"
xftLockFace :: XftFont -> IO ()
foreign import ccall "XftUnlockFace"
xftUnlockFace :: XftFont -> IO ()
foreign import ccall "XftFontCopy"
xftFontCopy :: Display -> XftFont -> IO XftFont
foreign import ccall "XftFontClose"
xftFontClose :: Display -> XftFont -> IO ()
xftfont_max_ascent :: NonEmpty XftFont -> IO Int
xftfont_max_ascent :: NonEmpty XftFont -> IO Int
xftfont_max_ascent = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM XftFont -> IO Int
xftfont_ascent
xftfont_max_descent :: NonEmpty XftFont -> IO Int
xftfont_max_descent :: NonEmpty XftFont -> IO Int
xftfont_max_descent = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM XftFont -> IO Int
xftfont_descent
xftfont_max_height :: NonEmpty XftFont -> IO Int
xftfont_max_height :: NonEmpty XftFont -> IO Int
xftfont_max_height = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM XftFont -> IO Int
xftfont_height
foreign import ccall "XftCharExists"
cXftCharExists :: Display -> XftFont -> (Word32) -> IO (Int32)
{-# LINE 215 "Graphics/X11/Xft.hsc" #-}
xftCharExists :: Display -> XftFont -> Char -> IO Bool
xftCharExists :: Display -> XftFont -> Char -> IO Bool
xftCharExists Display
d XftFont
f Char
c = forall {a}. (Eq a, Num a) => a -> Bool
bool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Display -> XftFont -> Word32 -> IO Int32
cXftCharExists Display
d XftFont
f (forall a b. (Integral a, Num b) => a -> b
fi 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 224 "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 =
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen (forall a b. (a -> b) -> [a] -> [b]
map 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 (forall a b. (Integral a, Num b) => a -> b
fi b
x) (forall a b. (Integral a, Num b) => a -> b
fi c
y) Ptr Word32
ptr (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 233 "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 =
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen (forall a b. (a -> b) -> [a] -> [b]
map 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 (forall a b. (Integral a, Num b) => a -> b
fi a
x) (forall a b. (Integral a, Num b) => a -> b
fi b
y) Ptr Word8
ptr (forall a b. (Integral a, Num b) => a -> b
fi Int
len))
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 =
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fi (String -> [Word8]
UTF8.encode String
string)) forall a b. (a -> b) -> a -> b
$
\Int
len CString
str_ptr -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca 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 (forall a b. (Integral a, Num b) => a -> b
fi Int
len) Ptr XGlyphInfo
cglyph
forall a. Storable a => Ptr a -> IO a
peek Ptr XGlyphInfo
cglyph
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
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
_)) -> 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
xftTextAccumExtents :: Display -> [XftFont] -> String -> IO XGlyphInfo
xftTextAccumExtents :: Display -> [XftFont] -> String -> IO XGlyphInfo
xftTextAccumExtents Display
disp [XftFont]
fts String
string = do
[XGlyphInfo]
chunks <- forall a b. (a -> b) -> [a] -> [b]
map (\ (XftFont
_, String
_, XGlyphInfo
gi) -> XGlyphInfo
gi) 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
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> 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 forall a. Num a => a -> a -> a
+ Int
w') (Int
yo forall a. Num a => a -> a -> a
+ Int
h') Int
x Int
y (Int
xo forall a. Num a => a -> a -> a
+ Int
xo') (Int
yo forall a. Num a => a -> a -> a
+ Int
yo')
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
getFonts :: [XftFont] -> String -> IO [(XftFont, String)]
getFonts :: [XftFont] -> String -> IO [(XftFont, String)]
getFonts [] String
_ = forall (m :: * -> *) a. Monad m => a -> m a
return []
getFonts [XftFont
ft] String
s = forall (m :: * -> *) a. Monad m => a -> m a
return [(XftFont
ft, String
s)]
getFonts fonts :: [XftFont]
fonts@(XftFont
ft:[XftFont]
_) String
s = do
[Bool]
glyphs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Display -> XftFont -> Char -> IO Bool
xftCharExists Display
disp XftFont
ft) String
s
let splits :: [(Bool, String)]
splits = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> a
NonEmpty.head forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NonEmpty.toList)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
NonEmpty.groupBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst))
forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Bool]
glyphs String
s
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([XftFont] -> (Bool, String) -> IO [(XftFont, String)]
getFont [XftFont]
fonts) [(Bool, String)]
splits
getFont :: [XftFont] -> (Bool, String) -> IO [(XftFont, String)]
getFont :: [XftFont] -> (Bool, String) -> IO [(XftFont, String)]
getFont [] (Bool, String)
_ = forall (m :: * -> *) a. Monad m => a -> m a
return []
getFont [XftFont
ft] (Bool
_, String
s) = forall (m :: * -> *) a. Monad m => a -> m a
return [(XftFont
ft, String
s)]
getFont (XftFont
ft:[XftFont]
_) (Bool
True, String
s) = forall (m :: * -> *) a. Monad m => a -> m a
return [(XftFont
ft, String
s)]
getFont (XftFont
_:[XftFont]
fs) (Bool
False, String
s) = [XftFont] -> String -> IO [(XftFont, String)]
getFonts [XftFont]
fs String
s
getChunksExtents :: Int -> Int -> [(XftFont, String)] -> IO [(XftFont, String, XGlyphInfo)]
getChunksExtents :: Int
-> Int -> [(XftFont, String)] -> IO [(XftFont, String, XGlyphInfo)]
getChunksExtents Int
_ Int
_ [] = 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 forall a. Num a => a -> a -> a
+ Int
xo) (Int
y forall a. Num a => a -> a -> a
+ Int
yo) [(XftFont, String)]
chunks
forall (m :: * -> *) a. Monad m => a -> m a
return 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) forall a. a -> [a] -> [a]
: [(XftFont, String, XGlyphInfo)]
rest
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 (forall a b. (Integral a, Num b) => a -> b
fi a
x) (forall a b. (Integral a, Num b) => a -> b
fi b
y) (forall a b. (Integral a, Num b) => a -> b
fi c
width) (forall a b. (Integral a, Num b) => a -> b
fi d
height)
foreign import ccall "XftDrawSetClip"
cXftDrawSetClip :: XftDraw -> Ptr Region -> IO (Int32)
{-# LINE 328 "Graphics/X11/Xft.hsc" #-}
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 =
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 (forall a b. (Integral a, Num b) => a -> b
fi Int
x) (forall a b. (Integral a, Num b) => a -> b
fi Int
y) Ptr Rectangle
rects (forall a b. (Integral a, Num b) => a -> b
fi Int
len)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Integral a => a -> Integer
toInteger CInt
r forall a. Eq a => a -> a -> Bool
/= Integer
0))
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 (forall a b. (Integral a, Num b) => a -> b
fi a
i)
foreign import ccall "XftInitFtLibrary"
xftInitFtLibrary :: IO ()
fi :: (Integral a, Num b) => a -> b
fi :: forall a b. (Integral a, Num b) => a -> b
fi = forall a b. (Integral a, Num b) => a -> b
fromIntegral