module Graphics.X11.Xft
where
import Graphics.X11
import Graphics.X11.Xlib.Types
import Graphics.X11.Xrender
import Foreign
import Foreign.C.Types
import Foreign.C.String
import Foreign.Ptr
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Codec.Binary.UTF8.String as UTF8
import Data.Int
import Data.Word
import Monad
newtype XftFont = XftFont (Ptr XftFont)
newtype XftDraw = XftDraw (Ptr XftDraw)
newtype XftColor = XftColor (Ptr XftColor)
foreign import ccall "XftColorAllocName"
cXftColorAllocName :: Display -> Visual -> Colormap -> CString -> XftColor -> IO (Int32)
allocaXftColor :: (Ptr XftColor -> IO a) -> IO a
allocaXftColor = allocaBytes ((12))
withXftColorName :: Display -> Visual -> Colormap -> String -> (XftColor -> IO a) -> IO a
withXftColorName d v cm name f =
allocaXftColor $ (\color -> do
withCAString name (\cstring -> do
cXftColorAllocName d v cm cstring color
r <- f color
cXftColorFree d v cm color
return r)) . XftColor
foreign import ccall "XftColorAllocValue"
cXftColorAllocValue :: Display -> Visual -> Colormap -> (Ptr XRenderColor) -> XftColor -> IO (Int32)
withXftColorValue :: Display -> Visual -> Colormap -> XRenderColor -> (XftColor -> IO a) -> IO a
withXftColorValue d v cm rc f =
allocaXftColor $ (\color -> do
with rc (\rc_ptr -> do
cXftColorAllocValue d v cm rc_ptr color
r <- f color
cXftColorFree d v cm color
return r)) . XftColor
foreign import ccall "XftColorFree"
cXftColorFree :: Display -> Visual -> Colormap -> XftColor -> IO ()
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 d p i = cXftDrawCreateAlpha d p (fromIntegral i)
foreign import ccall "XftDrawChange"
cXftDrawChange :: 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 ()
foreign import ccall "XftDrawGlyphs"
cXftDrawGlyphs :: XftDraw -> XftColor -> XftFont -> CInt -> CInt -> Ptr (Word32) -> CInt -> IO ()
xftDrawGlyphs d c f x y glyphs =
withArrayLen ((map fromIntegral glyphs) :: [Word32]) (\len ptr -> cXftDrawGlyphs d c f (fromIntegral x) (fromIntegral y) ptr (fromIntegral len))
foreign import ccall "XftDrawStringUtf8"
cXftDrawStringUtf8 :: XftDraw -> XftColor -> XftFont -> CInt -> CInt -> Ptr (Word8) -> CInt -> IO ()
xftDrawString d c f x y string =
withArrayLen (map fromIntegral (UTF8.encode string))
(\len ptr -> cXftDrawStringUtf8 d c f (fromIntegral x) (fromIntegral y) ptr (fromIntegral len))
foreign import ccall "XftDrawRect"
cXftDrawRect :: XftDraw -> XftColor -> CInt -> CInt -> CUInt -> CUInt -> IO ()
xftDrawRect draw color x y width height =
cXftDrawRect draw color (fromInteger x) (fromInteger y) (fromInteger width) (fromInteger height)
foreign import ccall "XftDrawSetClip"
xftDrawSetSubwindowMode :: XftDraw -> CInt -> IO ()
foreign import ccall "XftTextExtentsUtf8"
cXftTextExtentsUtf8 :: Display -> XftFont -> CString -> CInt -> Ptr XGlyphInfo -> IO ()
xftTextExtents :: Display -> XftFont -> String -> IO XGlyphInfo
xftTextExtents d f string =
withArrayLen (map fromIntegral (UTF8.encode string)) $
\len str_ptr -> alloca $
\cglyph -> do
cXftTextExtentsUtf8 d f str_ptr (fromIntegral len) cglyph
peek cglyph
foreign import ccall "XftFontOpenName"
cXftFontOpen :: Display -> CInt -> CString -> IO XftFont
xftFontOpen dpy screen fontname =
withCAString fontname $ \cfontname -> cXftFontOpen dpy (fromIntegral (screenNumberOfScreen screen)) cfontname
foreign import ccall "XftFontClose"
xftFontClose :: Display -> XftFont -> IO ()