{-# LANGUAGE CPP #-}
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
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 w :: Int
w h :: Int
h fmt :: Format
fmt d :: 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 = $WCairoOptions :: String
-> SizeSpec V2 Double
-> OutputType
-> Bool
-> Options Cairo V2 Double
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 = ""
}
(_, r :: 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 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 (m :: * -> *) a. Monad m => a -> m a
return (Ptr CUChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CUChar
b)
renderForeignPtr :: Int -> Int -> QDiagram Cairo V2 Double Any -> IO (ForeignPtr Word8)
renderForeignPtr :: Int -> Int -> QDiagram Cairo V2 Double Any -> IO (ForeignPtr Word8)
renderForeignPtr w :: Int
w h :: Int
h d :: 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 (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 w :: Int
w h :: Int
h d :: 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 (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