{-# LINE 1 "src/Graphics/Cairo/Surfaces/PngSupport.hsc" #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Graphics.Cairo.Surfaces.PngSupport (
	cairoSurfaceCreateFromPng, cairoSurfaceCreateFromPngByteString,
	cairoSurfaceWriteToPng
	) where

import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.Marshal.Utils
import Foreign.C
import Control.Monad.Primitive
import Control.Concurrent.STM
import Data.Word
import Data.ByteString qualified as BS
import Data.ByteString.Internal qualified as BS

import Graphics.Cairo.Surfaces.CairoSurfaceT.Internal
import Graphics.Cairo.Exception

import Graphics.Cairo.Surfaces.ImageSurfaces



foreign import ccall "cairo_surface_write_to_png" c_cairo_surface_write_to_png ::
	Ptr (CairoSurfaceT s ps) -> CString -> IO Word32
{-# LINE 30 "src/Graphics/Cairo/Surfaces/PngSupport.hsc" #-}

cairoSurfaceWriteToPng :: IsCairoSurfaceT sfc => sfc s ps -> FilePath -> IO CairoStatusT
cairoSurfaceWriteToPng :: forall (sfc :: * -> * -> *) s ps.
IsCairoSurfaceT sfc =>
sfc s ps -> FilePath -> IO CairoStatusT
cairoSurfaceWriteToPng (sfc s ps -> CairoSurfaceT s ps
forall s ps. sfc s ps -> CairoSurfaceT s ps
forall (sr :: * -> * -> *) s ps.
IsCairoSurfaceT sr =>
sr s ps -> CairoSurfaceT s ps
toCairoSurfaceT -> CairoSurfaceT ForeignPtr (CairoSurfaceT s ps)
s) FilePath
fp = FilePath -> (CString -> IO CairoStatusT) -> IO CairoStatusT
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
fp \CString
cs -> Word32 -> CairoStatusT
CairoStatusT
	(Word32 -> CairoStatusT) -> IO Word32 -> IO CairoStatusT
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ForeignPtr (CairoSurfaceT s ps)
-> (Ptr (CairoSurfaceT s ps) -> IO Word32) -> IO Word32
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr (CairoSurfaceT s ps)
s \Ptr (CairoSurfaceT s ps)
p -> Ptr (CairoSurfaceT s ps) -> CString -> IO Word32
forall s ps. Ptr (CairoSurfaceT s ps) -> CString -> IO Word32
c_cairo_surface_write_to_png Ptr (CairoSurfaceT s ps)
p CString
cs)

foreign import ccall "cairo_image_surface_create_from_png" c_cairo_surface_create_from_png ::
	CString -> IO (Ptr (CairoSurfaceT s ps))

cairoSurfaceCreateFromPng :: FilePath -> IO (CairoSurfaceImageT s ps)
cairoSurfaceCreateFromPng :: forall s ps. FilePath -> IO (CairoSurfaceImageT s ps)
cairoSurfaceCreateFromPng FilePath
fp = FilePath
-> (CString -> IO (CairoSurfaceImageT s ps))
-> IO (CairoSurfaceImageT s ps)
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
fp \CString
cs ->
	Ptr (CairoSurfaceT s ps) -> IO (CairoSurfaceImageT s ps)
forall s ps.
Ptr (CairoSurfaceT s ps) -> IO (CairoSurfaceImageT s ps)
mkCairoSurfaceImageT (Ptr (CairoSurfaceT s ps) -> IO (CairoSurfaceImageT s ps))
-> IO (Ptr (CairoSurfaceT s ps)) -> IO (CairoSurfaceImageT s ps)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CString -> IO (Ptr (CairoSurfaceT s ps))
forall s ps. CString -> IO (Ptr (CairoSurfaceT s ps))
c_cairo_surface_create_from_png CString
cs

cairoSurfaceCreateFromPngByteString :: PrimMonad m =>
	BS.ByteString -> m (CairoSurfaceImageT s (PrimState m))
cairoSurfaceCreateFromPngByteString :: forall (m :: * -> *) s.
PrimMonad m =>
ByteString -> m (CairoSurfaceImageT s (PrimState m))
cairoSurfaceCreateFromPngByteString ByteString
bs = IO (CairoSurfaceImageT s (PrimState m))
-> m (CairoSurfaceImageT s (PrimState m))
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim do
	tbs <- STM (TVar ByteString) -> IO (TVar ByteString)
forall a. STM a -> IO a
atomically (STM (TVar ByteString) -> IO (TVar ByteString))
-> STM (TVar ByteString) -> IO (TVar ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> STM (TVar ByteString)
forall a. a -> STM (TVar a)
newTVar ByteString
bs
	fn <- c_cairo_read_func_t $ byteStringToCCairoReadFunc tbs
	mkCairoSurfaceImageT
		=<< c_cairo_image_surface_create_from_png_stream fn nullPtr

foreign import ccall "cairo_image_surface_create_from_png_stream"
	c_cairo_image_surface_create_from_png_stream ::
	FunPtr (CCairoReadFunc a) -> Ptr a -> IO (Ptr (CairoSurfaceT s ps))

type CCairoReadFunc a = Ptr a -> CString -> Word32 -> IO Word32
{-# LINE 55 "src/Graphics/Cairo/Surfaces/PngSupport.hsc" #-}

foreign import ccall "wrapper" c_cairo_read_func_t ::
	CCairoReadFunc a -> IO (FunPtr (CCairoReadFunc a))

byteStringToCCairoReadFunc :: TVar BS.ByteString -> CCairoReadFunc a
byteStringToCCairoReadFunc :: forall a. TVar ByteString -> CCairoReadFunc a
byteStringToCCairoReadFunc TVar ByteString
tbs Ptr a
_cls CString
dt Word32
ln = do
	bs <- STM ByteString -> IO ByteString
forall a. STM a -> IO a
atomically (STM ByteString -> IO ByteString)
-> STM ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ TVar ByteString -> STM ByteString
forall a. TVar a -> STM a
readTVar TVar ByteString
tbs
	if BS.length bs < (fromIntegral ln) then
		pure 10 else do
{-# LINE 64 "src/Graphics/Cairo/Surfaces/PngSupport.hsc" #-}
		tx' <- atomically do
			let	(tx, bs') = BS.splitAt (fromIntegral ln) bs
			writeTVar tbs bs'
			pure tx
		let	(fptr, ln') = BS.toForeignPtr0 tx'
		withForeignPtr fptr \Ptr Word8
ptr -> do
			CString -> CString -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes CString
dt (Ptr Word8 -> CString
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr) Int
ln'
			Word32 -> IO Word32
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
0
{-# LINE 72 "src/Graphics/Cairo/Surfaces/PngSupport.hsc" #-}