{-# LANGUAGE CPP #-}
module Diagrams.Backend.Cairo.List where
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>))
#endif
import Control.Exception (bracket)
import Data.Colour
import Data.Colour.SRGB (sRGB)
import Data.Word (Word8)
import Diagrams.Backend.Cairo (Cairo)
import Diagrams.Backend.Cairo.Ptr (renderPtr)
import Diagrams.Prelude (Any, QDiagram, V2)
import Graphics.Rendering.Cairo (Format (..))
import Foreign.Marshal.Alloc (free)
import Foreign.Marshal.Array (peekArray)
renderToList :: (Ord a, Floating a) =>
Int -> Int -> QDiagram Cairo V2 Double Any -> IO [[AlphaColour a]]
renderToList :: Int -> Int -> QDiagram Cairo V2 Double Any -> IO [[AlphaColour a]]
renderToList w :: Int
w h :: Int
h d :: QDiagram Cairo V2 Double Any
d =
Int -> [Word8] -> [[AlphaColour a]]
forall a.
(Ord a, Floating a) =>
Int -> [Word8] -> [[AlphaColour a]]
f 0 ([Word8] -> [[AlphaColour a]])
-> IO [Word8] -> IO [[AlphaColour a]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Ptr Word8)
-> (Ptr Word8 -> IO ()) -> (Ptr Word8 -> IO [Word8]) -> IO [Word8]
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int
-> Int -> Format -> QDiagram Cairo V2 Double Any -> IO (Ptr Word8)
renderPtr Int
w Int
h Format
FormatARGB32 QDiagram Cairo V2 Double Any
d) Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
free (Int -> Ptr Word8 -> IO [Word8]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (Int -> Ptr Word8 -> IO [Word8]) -> Int -> Ptr Word8 -> IO [Word8]
forall a b. (a -> b) -> a -> b
$ Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
*4)
where
f :: (Ord a, Floating a) => Int -> [Word8] -> [[AlphaColour a]]
f :: Int -> [Word8] -> [[AlphaColour a]]
f _ [] = []
f n :: Int
n xs :: [Word8]
xs | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
w = [] [AlphaColour a] -> [[AlphaColour a]] -> [[AlphaColour a]]
forall a. a -> [a] -> [a]
: Int -> [Word8] -> [[AlphaColour a]]
forall a.
(Ord a, Floating a) =>
Int -> [Word8] -> [[AlphaColour a]]
f 0 [Word8]
xs
f n :: Int
n (g :: Word8
g:b :: Word8
b:r :: Word8
r:a :: Word8
a:xs :: [Word8]
xs) =
let l :: a -> a
l x :: a
x = a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x a -> a -> a
forall a. Fractional a => a -> a -> a
/ Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
a
c :: AlphaColour a
c = a -> a -> a -> Colour a
forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
sRGB (Word8 -> a
forall a a. (Fractional a, Integral a) => a -> a
l Word8
r) (Word8 -> a
forall a a. (Fractional a, Integral a) => a -> a
l Word8
g) (Word8 -> a
forall a a. (Fractional a, Integral a) => a -> a
l Word8
b) Colour a -> a -> AlphaColour a
forall a. Num a => Colour a -> a -> AlphaColour a
`withOpacity` (Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
a a -> a -> a
forall a. Fractional a => a -> a -> a
/ 255)
in case Int -> [Word8] -> [[AlphaColour a]]
forall a.
(Ord a, Floating a) =>
Int -> [Word8] -> [[AlphaColour a]]
f (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) [Word8]
xs of
[] -> [[AlphaColour a
c]]
cs :: [AlphaColour a]
cs:ys :: [[AlphaColour a]]
ys -> (AlphaColour a
cAlphaColour a -> [AlphaColour a] -> [AlphaColour a]
forall a. a -> [a] -> [a]
:[AlphaColour a]
cs) [AlphaColour a] -> [[AlphaColour a]] -> [[AlphaColour a]]
forall a. a -> [a] -> [a]
: [[AlphaColour a]]
ys
f _ _ = [Char] -> [[AlphaColour a]]
forall a. HasCallStack => [Char] -> a
error "renderToList: Internal format error"