cairo: a couple of as yet unused imported foreign functions

1 files changed, 15 insertions, 5 deletions

diff --git a/src/Xmobar/X11/CairoSurface.hsc b/src/Xmobar/X11/CairoSurface.hsc
index 2037abe..6dad490 100644
--- a/src/Xmobar/X11/CairoSurface.hsc
+++ b/src/Xmobar/X11/CairoSurface.hsc
@@ -16,10 +16,13 @@
 --
 ------------------------------------------------------------------------------
 
-module Xmobar.X11.CairoSurface (withXlibSurface, withBitmapSurface) where
+module Xmobar.X11.CairoSurface (withXlibSurface
+                               , withBitmapSurface
+                               , setSurfaceDrawable) where
 
 import Graphics.X11.Xlib.Types
 import Graphics.X11.Types
+import Graphics.X11.Xlib (defaultScreenOfDisplay)
 import Graphics.Rendering.Cairo.Types
 import qualified Graphics.Rendering.Cairo.Internal as Internal
 
@@ -34,6 +37,9 @@ foreign import ccall "cairo_xlib_surface_create"
 foreign import ccall "cairo_xlib_surface_create_for_bitmap"
    cBitmapCreate :: Display -> Pixmap -> Screen -> CInt -> CInt -> Ptr Surface
 
+foreign import ccall "cairo_xlib_surface_set_drawable"
+   cSetDrawable :: Ptr Surface -> Drawable -> CInt -> CInt -> ()
+
 createXlibSurface :: Display -> Drawable -> Visual -> Int -> Int -> IO Surface
 createXlibSurface d dr v w h =
   mkSurface $ cSurfaceCreate d dr v (fromIntegral w) (fromIntegral h)
@@ -50,10 +56,14 @@ createBitmapSurface :: Display -> Pixmap -> Screen -> Int -> Int -> IO Surface
 createBitmapSurface d p s w h =
   mkSurface $ cBitmapCreate d p s (fromIntegral w) (fromIntegral h)
 
-withBitmapSurface ::
-  Display -> Pixmap -> Screen -> Int -> Int -> (Surface -> IO a) -> IO a
-withBitmapSurface d p s w h f = do
-  surface <- createBitmapSurface d p s w h
+withBitmapSurface :: Display -> Pixmap -> Int -> Int -> (Surface -> IO a) -> IO a
+withBitmapSurface d p w h f = do
+  surface <- createBitmapSurface d p (defaultScreenOfDisplay d) w h
   ret <- f surface
   Internal.surfaceDestroy surface
   return ret
+
+setSurfaceDrawable :: Surface -> Drawable -> Int -> Int -> IO ()
+setSurfaceDrawable surface dr w h =
+  withSurface surface $
+    \s -> return $ cSetDrawable s dr (fromIntegral w) (fromIntegral h)