Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Add module Diagrams.Backend.Cairo.List

For rendering to (Ord a, Floating a) => [[Colour a]]
  • Loading branch information...
commit 7086e506127ce2a81fa4f8ca14a18802af2a089c 1 parent d4caa93
Niklas Haas haasn authored
Showing with 40 additions and 0 deletions.
  1. +2 −0  diagrams-cairo.cabal
  2. +38 −0 src/Diagrams/Backend/Cairo/List.hs
2  diagrams-cairo.cabal
View
@@ -37,6 +37,7 @@ 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
@@ -51,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
38 src/Diagrams/Backend/Cairo/List.hs
View
@@ -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)
Please sign in to comment.
Something went wrong with that request. Please try again.