{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.Backend.Cairo.Ptr
-- Copyright   :  (c) 2012 Diagrams-cairo team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- Render diagrams to buffers in memory.
--
-----------------------------------------------------------------------------

module Diagrams.Backend.Cairo.Ptr where

import           Data.Word                       (Word8)

import           Diagrams.Backend.Cairo
import           Diagrams.Backend.Cairo.Internal
import           Diagrams.Prelude                (Any, QDiagram, V2, dims2D,
                                                  renderDia)

import           Foreign.Marshal.Alloc           (finalizerFree)
import           Foreign.Marshal.Array           (mallocArray, pokeArray)
import           Foreign.Ptr                     (Ptr, castPtr)

import           Graphics.Rendering.Cairo        (Format (..),
                                                  formatStrideForWidth,
                                                  renderWith,
                                                  withImageSurfaceForData)

#if __GLASGOW_HASKELL__ < 710
import           Control.Applicative             ((<$>))
import           Foreign.ForeignPtr.Safe         (ForeignPtr, newForeignPtr)
#else
import           Foreign.ForeignPtr              (ForeignPtr, newForeignPtr)
#endif

-- | Render a diagram to a new buffer in memory, with the format ARGB32.

renderPtr :: Int -> Int -> Format -> QDiagram Cairo V2 Double Any -> IO (Ptr Word8)
renderPtr :: Int
-> Int -> Format -> QDiagram Cairo V2 Double Any -> IO (Ptr Word8)
renderPtr Int
w Int
h Format
fmt QDiagram Cairo V2 Double Any
d = do
  let stride :: Int
stride = Format -> Int -> Int
formatStrideForWidth Format
fmt Int
w
      size :: Int
size   = Int
stride Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h
      opt :: Options Cairo V2 Double
opt    = CairoOptions
        { _cairoSizeSpec :: SizeSpec V2 Double
_cairoSizeSpec     = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> SizeSpec V2 Int -> SizeSpec V2 Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> SizeSpec V2 Int
forall n. n -> n -> SizeSpec V2 n
dims2D Int
w Int
h
        , _cairoOutputType :: OutputType
_cairoOutputType   = OutputType
RenderOnly
        , _cairoBypassAdjust :: Bool
_cairoBypassAdjust = Bool
False
        , _cairoFileName :: String
_cairoFileName     = String
""
        }
      (IO ()
_, Render ()
r) = Cairo
-> Options Cairo V2 Double
-> QDiagram Cairo V2 Double Any
-> Result Cairo V2 Double
forall b (v :: * -> *) n m.
(Backend b v n, HasLinearMap v, Metric v, Typeable n,
 OrderedField n, Monoid' m) =>
b -> Options b v n -> QDiagram b v n m -> Result b v n
renderDia Cairo
Cairo Options Cairo V2 Double
opt QDiagram Cairo V2 Double Any
d

  Ptr CUChar
b <- Int -> IO (Ptr CUChar)
forall a. Storable a => Int -> IO (Ptr a)
mallocArray Int
size
  Ptr CUChar -> [CUChar] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr CUChar
b (Int -> CUChar -> [CUChar]
forall a. Int -> a -> [a]
replicate Int
size CUChar
0)
  Ptr CUChar
-> Format -> Int -> Int -> Int -> (Surface -> IO ()) -> IO ()
forall a.
Ptr CUChar
-> Format -> Int -> Int -> Int -> (Surface -> IO a) -> IO a
withImageSurfaceForData Ptr CUChar
b Format
fmt Int
w Int
h Int
stride (Surface -> Render () -> IO ()
forall (m :: * -> *) a. MonadIO m => Surface -> Render a -> m a
`renderWith` Render ()
r)

  Ptr Word8 -> IO (Ptr Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr CUChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CUChar
b)

-- | Like 'renderPtr' but automatically garbage collected by Haskell.

renderForeignPtr :: Int -> Int -> QDiagram Cairo V2 Double Any -> IO (ForeignPtr Word8)
renderForeignPtr :: Int -> Int -> QDiagram Cairo V2 Double Any -> IO (ForeignPtr Word8)
renderForeignPtr Int
w Int
h QDiagram Cairo V2 Double Any
d = Int
-> Int -> Format -> QDiagram Cairo V2 Double Any -> IO (Ptr Word8)
renderPtr Int
w Int
h Format
FormatARGB32 QDiagram Cairo V2 Double Any
d IO (Ptr Word8)
-> (Ptr Word8 -> IO (ForeignPtr Word8)) -> IO (ForeignPtr Word8)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FinalizerPtr Word8 -> Ptr Word8 -> IO (ForeignPtr Word8)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Word8
forall a. FinalizerPtr a
finalizerFree

renderForeignPtrOpaque :: Int -> Int -> QDiagram Cairo V2 Double Any -> IO (ForeignPtr Word8)
renderForeignPtrOpaque :: Int -> Int -> QDiagram Cairo V2 Double Any -> IO (ForeignPtr Word8)
renderForeignPtrOpaque Int
w Int
h QDiagram Cairo V2 Double Any
d = Int
-> Int -> Format -> QDiagram Cairo V2 Double Any -> IO (Ptr Word8)
renderPtr Int
w Int
h Format
FormatRGB24 QDiagram Cairo V2 Double Any
d IO (Ptr Word8)
-> (Ptr Word8 -> IO (ForeignPtr Word8)) -> IO (ForeignPtr Word8)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FinalizerPtr Word8 -> Ptr Word8 -> IO (ForeignPtr Word8)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Word8
forall a. FinalizerPtr a
finalizerFree