{-# 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_descent
, xftfont_height
, xftfont_max_advance_width
, xftFontOpen
, xftFontOpenXlfd
, xftLockFace
, xftUnlockFace
, xftFontCopy
, xftFontClose
, xftDrawGlyphs
, xftDrawString
, xftTextExtents
, 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.Monad (void)
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) = Ptr XftColor -> CInt -> IO Int
forall a. Ptr a -> CInt -> IO Int
peekCUShort Ptr XftColor
p (CInt
0)
{-# LINE 68 "Graphics/X11/Xft.hsc" #-}
foreign import ccall "XftColorAllocName"
cXftColorAllocName :: Display -> Visual -> Colormap -> CString -> XftColor -> IO (Int32)
{-# LINE 72 "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 75 "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 (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 87 "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 (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 ()
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 (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
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) = Ptr XftFont -> CInt -> IO Int
forall a. Ptr a -> CInt -> IO Int
peekCUShort Ptr XftFont
p (CInt
0)
{-# LINE 152 "Graphics/X11/Xft.hsc" #-}
xftfont_descent (XftFont p) = peekCUShort p (4)
{-# LINE 153 "Graphics/X11/Xft.hsc" #-}
xftfont_height (XftFont p) = peekCUShort p (8)
{-# LINE 154 "Graphics/X11/Xft.hsc" #-}
xftfont_max_advance_width (XftFont p) = peekCUShort p (12)
{-# LINE 155 "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 =
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 (ScreenNumber -> CInt
forall a b. (Integral a, Num b) => a -> b
fi (Screen -> ScreenNumber
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 (ScreenNumber -> CInt
forall a b. (Integral a, Num b) => a -> b
fi (Screen -> ScreenNumber
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 ()
foreign import ccall "XftDrawGlyphs"
cXftDrawGlyphs :: XftDraw -> XftColor -> XftFont -> CInt -> CInt -> Ptr (Word32) -> CInt -> IO ()
{-# LINE 193 "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 =
[ScreenNumber] -> (Int -> Ptr ScreenNumber -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen ((a -> ScreenNumber) -> [a] -> [ScreenNumber]
forall a b. (a -> b) -> [a] -> [b]
map a -> ScreenNumber
forall a b. (Integral a, Num b) => a -> b
fi [a]
glyphs)
(\Int
len Ptr ScreenNumber
ptr -> XftDraw
-> XftColor
-> XftFont
-> CInt
-> CInt
-> Ptr ScreenNumber
-> 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 ScreenNumber
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 202 "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))
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
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 234 "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 =
[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 (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))
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)
foreign import ccall "XftInitFtLibrary"
xftInitFtLibrary :: IO ()
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