From 7e72fe0bc695b1d69ea58d2f28c014aaae6ee613 Mon Sep 17 00:00:00 2001 From: jao Date: Sun, 11 Sep 2022 22:34:27 +0100 Subject: cairo: a couple of as yet unused imported foreign functions --- src/Xmobar/X11/CairoSurface.hsc | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) (limited to 'src/Xmobar') 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) -- cgit v1.2.3