Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

Loading…

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

Merged
merged 3 commits into from

2 participants

@haasn
Owner

No description provided.

haasn added some commits
@byorgey byorgey merged commit 740f280 into from
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Commits on Nov 18, 2012
  1. @haasn

    Add module Diagrams.Backend.Cairo.Ptr

    haasn authored
    Used for rendering to buffers in memory.
  2. @haasn
  3. @haasn

    Add module Diagrams.Backend.Cairo.List

    haasn authored
    For rendering to (Ord a, Floating a) => [[Colour a]]
This page is out of date. Refresh to see the latest.
View
3  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
View
38 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)
View
43 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
Something went wrong with that request. Please try again.