Merge pull request #25 from nandykins/master

Additional rendering functions, for Ptr Word8 and [[Colour a]]

diagrams-cairo.cabal

@@ -37,6 +37,8 @@ Library
   Exposed-modules:     Diagrams.Backend.Cairo
                        Diagrams.Backend.Cairo.CmdLine
                        Diagrams.Backend.Cairo.Internal
+                       Diagrams.Backend.Cairo.List
+                       Diagrams.Backend.Cairo.Ptr
                        Diagrams.Backend.Cairo.Text
   Hs-source-dirs:      src
   Build-depends:       base >= 4.2 && < 4.7,
@@ -50,6 +52,7 @@ Library
                        diagrams-lib >= 0.6 && < 0.7,
                        cairo >= 0.10.1 && < 0.13,
                        cmdargs >= 0.6 && < 0.11,
+                       colour,
                        split >= 0.1.2 && < 0.3
   default-language:    Haskell2010
 

src/Diagrams/Backend/Cairo/List.hs

@@ -0,0 +1,38 @@
+module Diagrams.Backend.Cairo.List where
+
+import Control.Applicative ((<$>))
+import Control.Exception (bracket)
+
+import Data.Colour.SRGB (Colour, sRGB)
+import Data.Word (Word8)
+
+import Diagrams.Prelude (Diagram, R2)
+import Diagrams.Backend.Cairo (Cairo)
+import Diagrams.Backend.Cairo.Ptr (renderPtr)
+
+import Foreign.Marshal.Alloc (free)
+import Foreign.Marshal.Array (peekArray)
+
+-- | Render to a regular list of Colour values.
+
+renderToList :: (Ord a, Floating a) =>
+                  Int -> Int -> Diagram Cairo R2 -> IO [[Colour a]]
+renderToList w h d = do
+  b <- renderPtr w h d
+  l <- peekArray (w*h*4) b
+  free b
+  return l
+  f 0 <$> bracket (renderPtr w h d) free (peekArray $ w*h*4)
+ where
+  f :: (Ord a, Floating a) => Int -> [Word8] -> [[Colour a]]
+  f _ [] = []
+  f n xs | n >= w = [] : f 0 xs
+  f n (_:r:g:b:xs) = let c = sRGB (l r) (l g) (l b) in
+    case f (n+1) xs of
+      []    -> [[c]]
+      cs:ys -> (c:cs) : ys
+
+  f _ _ = error "renderToList: Internal format error"
+
+  l :: (Ord a, Floating a) => Word8 -> a
+  l n = fromIntegral n / fromIntegral (maxBound :: Word8)

src/Diagrams/Backend/Cairo/Ptr.hs

@@ -0,0 +1,43 @@
+module Diagrams.Backend.Cairo.Ptr where
+
+import Data.Word (Word8)
+
+import Diagrams.Prelude (Diagram, R2, SizeSpec2D (..), renderDia)
+import Diagrams.Backend.Cairo
+import Diagrams.Backend.Cairo.Internal
+
+import Foreign.ForeignPtr.Safe (ForeignPtr, newForeignPtr)
+import Foreign.Marshal.Alloc   (finalizerFree)
+import Foreign.Marshal.Array   (mallocArray, pokeArray)
+import Foreign.Ptr             (Ptr, castPtr)
+
+import Graphics.Rendering.Cairo ( Format (..)
+                                , formatStrideForWidth
+                                , renderWith
+                                , withImageSurfaceForData
+                                )
+
+-- | Render a diagram to a new buffer in memory, with the format ARGB32.
+
+renderPtr :: Int -> Int -> Diagram Cairo R2 -> IO (Ptr Word8)
+renderPtr w h d = do
+  let stride = formatStrideForWidth FormatARGB32 w
+      size   = stride * h
+      opt    = CairoOptions
+        { cairoSizeSpec     = Dims (fromIntegral w) (fromIntegral h)
+        , cairoOutputType   = RenderOnly
+        , cairoBypassAdjust = False
+        , cairoFileName     = ""
+        }
+      (_, r) = renderDia Cairo opt d
+
+  b <- mallocArray size
+  pokeArray b (replicate size 0)
+  withImageSurfaceForData b FormatARGB32 w h stride (`renderWith` r)
+
+  return (castPtr b)
+
+-- | Like 'renderPtr' but automatically garbage collected by Haskell.
+
+renderForeignPtr :: Int -> Int -> Diagram Cairo R2 -> IO (ForeignPtr Word8)
+renderForeignPtr w h d = renderPtr w h d >>= newForeignPtr finalizerFree