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

Merged
merged 3 commits into from Nov 19, 2012
View
@@ -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
@@ -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)
@@ -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