X11-xft 0.1 → 0.2

raw patch · 4 files changed

+242/−136 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Graphics/X11/Xft.hsc +191/−121
• Graphics/X11/Xrender.hsc +48/−13
• Hello.hs +2/−1
• X11-xft.cabal +1/−1

@@ -6,10 +6,46 @@ -- ----------------------------------------------------------------------------- -module Graphics.X11.Xft+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.Xlib.Region import Graphics.X11.Xrender  import Foreign@@ -25,35 +61,37 @@  #include <X11/Xft/Xft.h> -newtype XftFont = XftFont (Ptr XftFont)--newtype XftDraw = XftDraw (Ptr XftDraw)+-----------------------+-- Color Handling    --+-----------------------  newtype XftColor = XftColor (Ptr XftColor) --- xftcolor.c+xftcolor_pixel (XftColor p) = peekCUShort p #{offset XftColor, pixel}+-- missing xftcolor_color to get XRenderColor+ foreign import ccall "XftColorAllocName"-  cXftColorAllocName :: Display -> Visual -> Colormap -> CString -> XftColor -> IO (#type Bool)+    cXftColorAllocName :: Display -> Visual -> Colormap -> CString -> XftColor -> IO (#type Bool)  allocaXftColor :: (Ptr XftColor -> IO a) -> IO a allocaXftColor = allocaBytes (#size XftColor)  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+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 (#type Bool)  withXftColorValue :: Display -> Visual -> Colormap -> XRenderColor -> (XftColor -> IO a) -> IO a-withXftColorValue d v cm rc f = -    allocaXftColor $ (\color -> do  -	  	        with rc (\rc_ptr -> do +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@@ -62,8 +100,20 @@ foreign import ccall "XftColorFree"   cXftColorFree :: Display -> Visual -> Colormap -> XftColor -> IO () --- xftdraw.c +-----------------------+-- Draw Handling    --+----------------------- +newtype XftDraw = XftDraw (Ptr XftDraw)++withXftDraw :: Display -> Drawable -> Visual -> Colormap -> (XftDraw -> IO a) -> IO a+withXftDraw d p v c act =+    do+      draw <- xftDrawCreate d p v c+      a <- act draw+      xftDrawDestroy draw+      return a+ foreign import ccall "XftDrawCreate"   xftDrawCreate :: Display -> Drawable -> Visual -> Colormap -> IO XftDraw @@ -73,55 +123,135 @@ foreign import ccall "XftDrawCreateAlpha"   cXftDrawCreateAlpha :: Display -> Pixmap -> CInt -> IO XftDraw -xftDrawCreateAlpha d p i = cXftDrawCreateAlpha d p (fromIntegral i)+xftDrawCreateAlpha d p i = cXftDrawCreateAlpha d p (fi i)  foreign import ccall "XftDrawChange"-  cXftDrawChange :: XftDraw -> Drawable -> IO ()+  xftDrawChange :: XftDraw -> Drawable -> IO () -foreign import ccall "XftDrawDisplay" -  xftDrawDisplay :: XftDraw -> IO Display+foreign import ccall "XftDrawDisplay"+  xftDrawDisplay :: XftDraw -> IO Display -- FIXME correct? Is X11 giving us the underlying Display? -foreign import ccall "XftDrawDrawable" +foreign import ccall "XftDrawDrawable"   xftDrawDrawable :: XftDraw -> IO Drawable -foreign import ccall "XftDrawColormap" +foreign import ccall "XftDrawColormap"   xftDrawColormap :: XftDraw -> IO Colormap -foreign import ccall "XftDrawVisual" +foreign import ccall "XftDrawVisual"   xftDrawVisual :: XftDraw -> IO Visual -foreign import ccall "XftDrawDestroy" +foreign import ccall "XftDrawDestroy"   xftDrawDestroy :: XftDraw -> IO () --- no Render bindings yet---foreign import ccall "XftDrawPicture"---  cXftDrawPicture :: XftDraw -> IO Picture---foreign import ccall "XftDrawPicture"---  cXftDrawSrcPicture :: XftDraw -> XftColor -> IO Picture+--------------------+-- Font handling  --+-------------------- +newtype XftFont = XftFont (Ptr XftFont)++xftfont_ascent (XftFont p)            = peekCUShort p #{offset XftFont, ascent}+xftfont_descent (XftFont p)           = peekCUShort p #{offset XftFont, descent}+xftfont_height (XftFont p)            = peekCUShort p #{offset XftFont, height}+xftfont_max_advance_width (XftFont p) = peekCUShort p #{offset XftFont, max_advance_width}+-- missing xftfont_charset+-- missing xftfont_pattern++foreign import ccall "XftFontOpenName"+  cXftFontOpen :: Display -> CInt -> CString -> IO XftFont++xftFontOpen dpy screen fontname =+    withCAString fontname $+      \cfontname -> cXftFontOpen dpy (fi (screenNumberOfScreen screen)) cfontname++foreign import ccall "XftFontOpenXlfd"+  cXftFontOpenXlfd :: Display -> CInt -> CString -> IO XftFont++xftFontOpenXlfd dpy screen fontname =+    withCAString fontname $ \cfontname -> cXftFontOpenXlfd dpy (fi (screenNumberOfScreen screen)) 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 ()++---------------------+-- Painting+---------------------++-- Drawing strings or glyphs --+ foreign import ccall "XftDrawGlyphs"- cXftDrawGlyphs :: XftDraw -> XftColor -> XftFont -> CInt -> CInt -> Ptr (#type FT_UInt) -> CInt -> IO ()+  cXftDrawGlyphs :: XftDraw -> XftColor -> XftFont -> CInt -> CInt -> Ptr (#type FT_UInt) -> 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 "XftDrawString8"---  cXftDrawString8 :: XftDraw -> XftColor -> XftFont -> CInt -> CInt -> CString -> CInt -> IO ()------xftDrawString8 :: XftDraw -> XftColor -> XftFont -> Int -> Int -> String -> IO ()---xftDrawString8 draw color font x y string = ---    withCAString string $ \cs1 -> cXftDrawString8 draw color font (fromIntegral x) (fromIntegral y) cs1 (fromIntegral (length string))------ We ignore xftDrawString8,xftDrawString16,xftDrawString32,xftDrawStringUtf16---+    withArrayLen (map fi glyphs)+      (\len ptr -> cXftDrawGlyphs d c f (fi x) (fi y) ptr (fi len))  foreign import ccall "XftDrawStringUtf8"   cXftDrawStringUtf8 :: XftDraw -> XftColor -> XftFont -> CInt -> CInt -> Ptr (#type FcChar8) -> 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))+    withArrayLen (map fi (UTF8.encode string))+      (\len ptr -> cXftDrawStringUtf8 d c f (fi x) (fi y) ptr (fi 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 d f string =+    withArrayLen (map fi (UTF8.encode string)) $+    \len str_ptr -> alloca $+    \cglyph -> do+      cXftTextExtentsUtf8 d f str_ptr (fi len) cglyph+      peek cglyph++-- Drawing auxilary --++foreign import ccall "XftDrawRect"+  cXftDrawRect :: XftDraw -> XftColor -> CInt -> CInt -> CUInt -> CUInt -> IO ()++xftDrawRect draw color x y width height =+    cXftDrawRect draw color (fi x) (fi y) (fi width) (fi height)++foreign import ccall "XftDrawSetClip"+    cXftDrawSetClip :: XftDraw -> Ptr Region -> IO (#type Bool)++--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 draw x y rects =+    withArrayLen rects+      (\len rects -> do+	 r <- cXftDrawSetClipRectangles draw (fi x) (fi y) rects (fi len)+         return (toInteger r /= 0)) -- verify whether this is really the convention++foreign import ccall "XftDrawSetSubwindowMode"+  cXftDrawSetSubwindowMode :: XftDraw -> CInt -> IO ()++xftDrawSetSubwindowMode d i = cXftDrawSetSubwindowMode d (fi 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@@ -151,86 +281,27 @@ 		      _Xconst XftColor		*color, 		      _Xconst XftGlyphFontSpec	*glyphs, 		      int			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"--- cXftDrawSetClip :: XftDraw -> Ptr (??) Region -> IO (#type Bool) --{---Bool-XftDrawSetClipRectangles (XftDraw		*draw,-			  int			xOrigin,-			  int			yOrigin,-			  _Xconst XRectangle	*rects,-			  int			n);--}--foreign import ccall "XftDrawSetClip"- xftDrawSetSubwindowMode :: XftDraw -> CInt -> IO ()-{--Missing XRender Bindings-EXTEND START+------+Missing void XftGlyphExtents (Display	    *dpy, 		 XftFont	    *pub, 		 _Xconst FT_UInt    *glyphs, 		 int		    nglyphs, 		 XGlyphInfo	    *extents);--}-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-{--Misunderstood the interface definition:-xftTextExtents :: Display -> XftFont -> String -> IO [XGlyphInfo]-xftTextExtents d f string =-    withArrayLen (map fromIntegral (UTF8.encode string)) $-    \len str_ptr -> allocaArray len $ -    \cglyphs -> do-      cXftTextExtentsUtf8 d f str_ptr (fromIntegral len) cglyphs-      peekArray len cglyphs+Intentionally Missing Bindings+xftDrawString8,xftDrawString16,xftDrawString32,xftDrawStringUtf16 --}--- xftfont.c --- We can't support this one:--- XftFont *--- XftFontOpen (Display *dpy, int screen, ...) _X_SENTINEL(0);+--foreign import ccall "XftDrawSetClip"+-- cXftDrawSetClip :: XftDraw -> Ptr (??) Region -> IO (#type Bool) -foreign import ccall "XftFontOpenName"-  cXftFontOpen :: Display -> CInt -> CString -> IO XftFont -xftFontOpen dpy screen fontname =-  withCAString fontname $ \cfontname -> cXftFontOpen dpy (fromIntegral (screenNumberOfScreen screen)) cfontname---- XftFont *--- XftFontOpenXlfd (Display *dpy, int screen, _Xconst char *xlfd);+Missing Bindings because of missing Freetype bindings -{-  /* xftfreetype.c */ -FT_Face-XftLockFace (XftFont *pub);--void-XftUnlockFace (XftFont *pub);- XftFontInfo * XftFontInfoCreate (Display *dpy, _Xconst FcPattern *pattern); @@ -244,21 +315,20 @@ XftFontInfoEqual (_Xconst XftFontInfo *a, _Xconst XftFontInfo *b);  XftFont *-XftFontOpenInfo (Display	*dpy, -		 FcPattern	*pattern, +XftFontOpenInfo (Display	*dpy,+		 FcPattern	*pattern, 		 XftFontInfo	*fi);  XftFont * XftFontOpenPattern (Display *dpy, FcPattern *pattern); -XftFont *-XftFontCopy (Display *dpy, XftFont *pub);--FcBool-XftInitFtLibrary(void);+-- no Render bindings yet+--foreign import ccall "XftDrawPicture"+--  cXftDrawPicture :: XftDraw -> IO Picture+--foreign import ccall "XftDrawPicture"+--  cXftDrawSrcPicture :: XftDraw -> XftColor -> IO Picture -} -foreign import ccall "XftFontClose"-  xftFontClose :: Display -> XftFont -> IO ()--+-- | Short-hand for 'fromIntegral'+fi :: (Integral a, Num b) => a -> b+fi = fromIntegral

@@ -18,7 +18,6 @@  #include <X11/extensions/Xrender.h> - peekCUShort :: Ptr a -> CInt -> IO Int peekCUShort ptr off = do 	v <- peekByteOff ptr (fromIntegral off)@@ -39,11 +38,11 @@ 	pokeByteOff ptr (fromIntegral off) (fromIntegral v::CShort)  data XRenderColor = XRenderColor { -      xrc_red :: Int, -      xrc_green :: Int, -      xrc_blue :: Int, -      xrc_alpha :: Int -    }+      xrendercolor_red   :: Int, +      xrendercolor_green :: Int, +      xrendercolor_blue  :: Int, +      xrendercolor_alpha :: Int +}  instance Storable XRenderColor where 	sizeOf _ = #{size XRenderColor}@@ -61,13 +60,13 @@ 		pokeCUShort p #{offset XRenderColor,alpha} alpha  data XGlyphInfo = XGlyphInfo { -      gi_width :: Int, -      gi_height :: Int, -      gi_x :: Int, -      gi_y :: Int, -      gi_xOff :: Int, -      gi_yOff :: Int-    }+      xglyphinfo_width  :: Int, +      xglyphinfo_height :: Int, +      xglyphinfo_x      :: Int, +      xglyphinfo_y      :: Int, +      xglyphinfo_xOff   :: Int, +      xglyphinfo_yOff   :: Int+}  instance Storable XGlyphInfo where 	sizeOf _ = #{size XGlyphInfo}@@ -87,3 +86,39 @@ 		pokeCShort p #{offset XGlyphInfo,y} y 		pokeCShort p #{offset XGlyphInfo,xOff} xOff 		pokeCShort p #{offset XGlyphInfo,yOff} yOff+++data XRenderDirectFormat = XRenderDirectFormat { +     xrenderdirectformat_red       :: Int,+     xrenderdirectformat_redMask   :: Int,+     xrenderdirectformat_green     :: Int,+     xrenderdirectformat_greenMask :: Int,+     xrenderdirectformat_blue      :: Int,+     xrenderdirectformat_blueMask  :: Int,+     xrenderdirectformat_alpha     :: Int,+     xrenderdirectformat_alphaMask :: Int+}++instance Storable XRenderDirectFormat where+	sizeOf _ = #{size XRenderDirectFormat}+	alignment _ = alignment (undefined::CInt)+	peek p = do+		red  <- peekCShort p #{offset XRenderDirectFormat, red}+		redMask  <- peekCShort p #{offset XRenderDirectFormat, redMask}+		green  <- peekCShort p #{offset XRenderDirectFormat, green}+		greenMask  <- peekCShort p #{offset XRenderDirectFormat, greenMask}+		blue  <- peekCShort p #{offset XRenderDirectFormat, blue}+		blueMask  <- peekCShort p #{offset XRenderDirectFormat, blueMask}+		alpha  <- peekCShort p #{offset XRenderDirectFormat, alpha}+		alphaMask  <- peekCShort p #{offset XRenderDirectFormat, alphaMask}+		return (XRenderDirectFormat red redMask green greenMask blue blueMask alpha alphaMask)+	poke p (XRenderDirectFormat red redMask green greenMask blue blueMask alpha alphaMask) = do+		pokeCShort p #{offset XRenderDirectFormat,red} red+		pokeCShort p #{offset XRenderDirectFormat,redMask} redMask+		pokeCShort p #{offset XRenderDirectFormat,blue} blue+		pokeCShort p #{offset XRenderDirectFormat,blueMask} blueMask+		pokeCShort p #{offset XRenderDirectFormat,green} green+		pokeCShort p #{offset XRenderDirectFormat,greenMask} greenMask+		pokeCShort p #{offset XRenderDirectFormat,alpha} alpha+		pokeCShort p #{offset XRenderDirectFormat,alphaMask} alphaMask+

@@ -19,7 +19,8 @@ 	visual = defaultVisualOfScreen screen;     draw <- xftDrawCreate dpy win visual colormap     font <- xftFontOpen dpy screen "Sans-10"-    withXftColorName dpy visual colormap "red" (\color -> xftDrawString draw color font 20 20 "ARGARGHÄLLLO")+    putStrLn "ARGARGHÄLLL所x有y网z"+    withXftColorName dpy visual colormap "red" (\color -> xftDrawString draw color font 20 20 "ARGARGHÄLLLzѼÅาป")     sync dpy False     threadDelay (10 * 1000000)     xftDrawDestroy draw

@@ -1,5 +1,5 @@ name:           X11-xft-version:        0.1+version:        0.2 license:        LGPL license-file:   LICENSE author:         Clemens Fruhwirth