{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.Backend.Cairo.List
-- Copyright   :  (c) 2012 Diagrams-cairo team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- Render a diagram directly to a list of lists of Colour values
-- (/i.e./ pixels).
--
-----------------------------------------------------------------------------

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)

-- | Render to a regular list of Colour values.

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"