diff --git a/Graphics/Rendering/Cairo.hs b/Graphics/Rendering/Cairo.hs --- a/Graphics/Rendering/Cairo.hs +++ b/Graphics/Rendering/Cairo.hs @@ -197,9 +197,11 @@ -- ** Image surfaces , withImageSurface + , withImageSurfaceForData #if CAIRO_CHECK_VERSION(1,6,0) , formatStrideForWidth #endif + , createImageSurfaceForData , createImageSurface , imageSurfaceGetWidth , imageSurfaceGetHeight @@ -1680,6 +1682,41 @@ -> IO Surface createImageSurface format width height = do surface <- Internal.imageSurfaceCreate format width height + Internal.manageSurface surface + return surface + +-- | Like 'withImageSurface' but creating a surface to target external +-- data pointed to by 'PixelData'. +-- +withImageSurfaceForData :: + PixelData -- ^ pointer to pixel data + -> Format -- ^ format of pixels in the surface to create + -> Int -- ^ width of the surface, in pixels + -> Int -- ^ height of the surface, in pixels + -> Int -- ^ size of stride between rows in the surface to create + -> (Surface -> IO a) -- ^ an action that may use the surface. The surface is + -- only valid within this action + -> IO a +withImageSurfaceForData pixels format width height stride f = + bracket (Internal.imageSurfaceCreateForData pixels format width height stride) + (\surface -> do status <- Internal.surfaceStatus surface + Internal.surfaceDestroy surface + unless (status == StatusSuccess) $ + Internal.statusToString status >>= fail) + (\surface -> f surface) + +-- | Like 'createImageSurface' but creating a surface to target external +-- data pointed to by 'PixelData'. +-- +createImageSurfaceForData :: + PixelData -- ^ pointer to pixel data + -> Format -- ^ format of pixels in the surface to create + -> Int -- ^ width of the surface, in pixels + -> Int -- ^ height of the surface, in pixels + -> Int -- ^ size of stride between rows in the surface to create + -> IO Surface +createImageSurfaceForData pixels format width height stride = do + surface <- Internal.imageSurfaceCreateForData pixels format width height stride Internal.manageSurface surface return surface diff --git a/Graphics/Rendering/Cairo/Internal/Surfaces/Image.chs b/Graphics/Rendering/Cairo/Internal/Surfaces/Image.chs --- a/Graphics/Rendering/Cairo/Internal/Surfaces/Image.chs +++ b/Graphics/Rendering/Cairo/Internal/Surfaces/Image.chs @@ -21,6 +21,14 @@ {#context lib="cairo" prefix="cairo"#} +{#fun image_surface_create_for_data as imageSurfaceCreateForData + { id `Ptr CUChar' + , cFromEnum `Format' + , `Int' + , `Int' + , `Int' + } -> `Surface' mkSurface*#} + {#fun image_surface_create as imageSurfaceCreate { cFromEnum `Format', `Int', `Int' } -> `Surface' mkSurface*#} {#fun image_surface_get_width as imageSurfaceGetWidth { withSurface* `Surface' } -> `Int'#} {#fun image_surface_get_height as imageSurfaceGetHeight { withSurface* `Surface' } -> `Int'#} diff --git a/Graphics/Rendering/Cairo/Types.chs b/Graphics/Rendering/Cairo/Types.chs --- a/Graphics/Rendering/Cairo/Types.chs +++ b/Graphics/Rendering/Cairo/Types.chs @@ -14,7 +14,8 @@ -- #hide module Graphics.Rendering.Cairo.Types ( - Matrix(Matrix), MatrixPtr + PixelData + , Matrix(Matrix), MatrixPtr , Cairo(Cairo), unCairo , Surface(Surface), withSurface, mkSurface, manageSurface , Pattern(Pattern), unPattern @@ -62,6 +63,8 @@ import Control.Monad (liftM) {#context lib="cairo" prefix="cairo"#} + +type PixelData = Ptr CUChar -- not visible {#pointer *cairo_t as Cairo newtype#} diff --git a/Gtk2HsSetup.hs b/Gtk2HsSetup.hs --- a/Gtk2HsSetup.hs +++ b/Gtk2HsSetup.hs @@ -56,7 +56,8 @@ import Distribution.Verbosity import Control.Monad (when, unless, filterM, liftM, forM, forM_) import Data.Maybe ( isJust, isNothing, fromMaybe, maybeToList ) -import Data.List (isPrefixOf, isSuffixOf, nub) +import Data.List (isPrefixOf, isSuffixOf, nub, minimumBy) +import Data.Ord as Ord (comparing) import Data.Char (isAlpha) import qualified Data.Map as M import qualified Data.Set as S @@ -100,8 +101,16 @@ fixLibs :: [FilePath] -> [String] -> [String] fixLibs dlls = concatMap $ \ lib -> case filter (("lib" ++ lib) `isPrefixOf`) dlls of - dll:_ -> [dropExtension dll] - _ -> if lib == "z" then [] else [lib] + dlls@(_:_) -> [dropExtension (pickDll dlls)] + _ -> if lib == "z" then [] else [lib] + where + -- If there are several .dll files matching the one we're after then we + -- just have to guess. For example for recent Windows cairo builds we get + -- libcairo-2.dll libcairo-gobject-2.dll libcairo-script-interpreter-2.dll + -- Our heuristic is to pick the one with the shortest name. + -- Yes this is a hack but the proper solution is hard: we would need to + -- parse the .a file and see which .dll file(s) it needed to link to. + pickDll = minimumBy (Ord.comparing length) -- The following code is a big copy-and-paste job from the sources of -- Cabal 1.8 just to be able to fix a field in the package file. Yuck. diff --git a/cairo.cabal b/cairo.cabal --- a/cairo.cabal +++ b/cairo.cabal @@ -1,5 +1,5 @@ Name: cairo -Version: 0.12.3.1 +Version: 0.12.4 License: BSD3 License-file: COPYRIGHT Copyright: (c) 2001-2010 The Gtk2Hs Team, (c) Paolo Martini 2005, (c) Abraham Egnor 2003, 2004, (c) Aetion Technologies LLC 2004 diff --git a/demo/Makefile b/demo/Makefile --- a/demo/Makefile +++ b/demo/Makefile @@ -1,6 +1,6 @@ -PROGS = drawing drawing2 starandring text clock graph -SOURCES = Drawing.hs Drawing2.hs StarAndRing.hs Text.hs Clock.hs Graph.hs +PROGS = drawing drawing2 starandring text clock graph sdldrawing +SOURCES = Drawing.hs Drawing2.hs StarAndRing.hs Text.hs Clock.hs Graph.hs CairoSDL.hs all : $(PROGS) @@ -20,6 +20,9 @@ $(HC_RULE) graph : Graph.hs + $(HC_RULE) + +sdldrawing : CairoSDL.hs $(HC_RULE) HC_RULE = $(HC) --make $< -o $@ $(HCFLAGS)