{-# LINE 1 "src/Graphics/Cairo/Surfaces/ImageSurfaces.hsc" #-}
{-# LANGUAGE BlockArguments, LambdaCase, TupleSections #-}
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Graphics.Cairo.Surfaces.ImageSurfaces (
	CairoSurfaceImageT,
	pattern CairoSurfaceTImage,

	cairoImageSurfaceCreate,

	cairoImageSurfaceCreateForCairoImage,
	cairoImageSurfaceCreateForCairoImageMut,

	cairoImageSurfaceGetCairoImage,
	cairoImageSurfaceGetCairoImageMut,

	cairoImageSurfaceGetWidth,
	cairoImageSurfaceGetHeight,
	cairoImageSurfaceGetStride,

	mkCairoSurfaceImageT
	) where

import Foreign.Ptr
import Foreign.ForeignPtr hiding (newForeignPtr)
import Foreign.Concurrent
import Foreign.Marshal
import Foreign.Storable
import Control.Monad.Primitive
import Data.Word
import Data.Int

import Graphics.Cairo.Surfaces.CairoSurfaceT.Internal
import Graphics.Cairo.Surfaces.CairoSurfaceTypeT

import Data.CairoImage.Internal hiding (Argb32, pixelAt, Image, Pixel)



newtype CairoSurfaceImageT s ps = CairoSurfaceImageT (ForeignPtr (CairoSurfaceT s ps)) deriving Int -> CairoSurfaceImageT s ps -> ShowS
[CairoSurfaceImageT s ps] -> ShowS
CairoSurfaceImageT s ps -> String
(Int -> CairoSurfaceImageT s ps -> ShowS)
-> (CairoSurfaceImageT s ps -> String)
-> ([CairoSurfaceImageT s ps] -> ShowS)
-> Show (CairoSurfaceImageT s ps)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall s ps. Int -> CairoSurfaceImageT s ps -> ShowS
forall s ps. [CairoSurfaceImageT s ps] -> ShowS
forall s ps. CairoSurfaceImageT s ps -> String
$cshowsPrec :: forall s ps. Int -> CairoSurfaceImageT s ps -> ShowS
showsPrec :: Int -> CairoSurfaceImageT s ps -> ShowS
$cshow :: forall s ps. CairoSurfaceImageT s ps -> String
show :: CairoSurfaceImageT s ps -> String
$cshowList :: forall s ps. [CairoSurfaceImageT s ps] -> ShowS
showList :: [CairoSurfaceImageT s ps] -> ShowS
Show

pattern CairoSurfaceTImage :: CairoSurfaceImageT s ps -> CairoSurfaceT s ps
pattern $mCairoSurfaceTImage :: forall {r} {s} {ps}.
CairoSurfaceT s ps
-> (CairoSurfaceImageT s ps -> r) -> ((# #) -> r) -> r
$bCairoSurfaceTImage :: forall s ps. CairoSurfaceImageT s ps -> CairoSurfaceT s ps
CairoSurfaceTImage sr <- (cairoSurfaceTImage -> Just sr) where
	CairoSurfaceTImage = CairoSurfaceImageT s ps -> CairoSurfaceT s ps
forall s ps. CairoSurfaceImageT s ps -> CairoSurfaceT s ps
forall (sr :: * -> * -> *) s ps.
IsCairoSurfaceT sr =>
sr s ps -> CairoSurfaceT s ps
toCairoSurfaceT

cairoSurfaceTImage :: CairoSurfaceT s ps -> Maybe (CairoSurfaceImageT s ps)
cairoSurfaceTImage :: forall s ps. CairoSurfaceT s ps -> Maybe (CairoSurfaceImageT s ps)
cairoSurfaceTImage sr :: CairoSurfaceT s ps
sr@(CairoSurfaceT ForeignPtr (CairoSurfaceT s ps)
fsr) = case CairoSurfaceT s ps -> CairoSurfaceTypeT
forall (sr :: * -> * -> *) s ps.
IsCairoSurfaceT sr =>
sr s ps -> CairoSurfaceTypeT
cairoSurfaceGetType CairoSurfaceT s ps
sr of
	CairoSurfaceTypeT
CairoSurfaceTypeImage -> CairoSurfaceImageT s ps -> Maybe (CairoSurfaceImageT s ps)
forall a. a -> Maybe a
Just (CairoSurfaceImageT s ps -> Maybe (CairoSurfaceImageT s ps))
-> CairoSurfaceImageT s ps -> Maybe (CairoSurfaceImageT s ps)
forall a b. (a -> b) -> a -> b
$ ForeignPtr (CairoSurfaceT s ps) -> CairoSurfaceImageT s ps
forall s ps.
ForeignPtr (CairoSurfaceT s ps) -> CairoSurfaceImageT s ps
CairoSurfaceImageT ForeignPtr (CairoSurfaceT s ps)
fsr
	CairoSurfaceTypeT
_ -> Maybe (CairoSurfaceImageT s ps)
forall a. Maybe a
Nothing

instance IsCairoSurfaceT CairoSurfaceImageT where
	toCairoSurfaceT :: forall s ps. CairoSurfaceImageT s ps -> CairoSurfaceT s ps
toCairoSurfaceT (CairoSurfaceImageT ForeignPtr (CairoSurfaceT s ps)
fsr) = ForeignPtr (CairoSurfaceT s ps) -> CairoSurfaceT s ps
forall s ps. ForeignPtr (CairoSurfaceT s ps) -> CairoSurfaceT s ps
CairoSurfaceT ForeignPtr (CairoSurfaceT s ps)
fsr

cairoImageSurfaceCreate :: PrimMonad m => CairoFormatT -> Int32 -> Int32 -> m (CairoSurfaceImageT s (PrimState m))
{-# LINE 56 "src/Graphics/Cairo/Surfaces/ImageSurfaces.hsc" #-}
cairoImageSurfaceCreate (CairoFormatT f) w h =
	returnCairoSurfaceT $ c_cairo_image_surface_create f w h

foreign import ccall "cairo_image_surface_create" c_cairo_image_surface_create ::
	Int32 -> Int32 -> Int32 -> IO (Ptr (CairoSurfaceT s ps))
{-# LINE 61 "src/Graphics/Cairo/Surfaces/ImageSurfaces.hsc" #-}

foreign import ccall "cairo_image_surface_get_format" c_cairo_image_surface_get_format ::
	Ptr (CairoSurfaceT s ps) -> IO Int32
{-# LINE 64 "src/Graphics/Cairo/Surfaces/ImageSurfaces.hsc" #-}

foreign import ccall "cairo_image_surface_get_stride" c_cairo_image_surface_get_stride ::
	Ptr (CairoSurfaceT s ps) -> IO Int32
{-# LINE 67 "src/Graphics/Cairo/Surfaces/ImageSurfaces.hsc" #-}

foreign import ccall "cairo_image_surface_get_width" c_cairo_image_surface_get_width ::
	Ptr (CairoSurfaceT s ps) -> IO Int32
{-# LINE 70 "src/Graphics/Cairo/Surfaces/ImageSurfaces.hsc" #-}

foreign import ccall "cairo_image_surface_get_height" c_cairo_image_surface_get_height ::
	Ptr (CairoSurfaceT s ps) -> IO Int32
{-# LINE 73 "src/Graphics/Cairo/Surfaces/ImageSurfaces.hsc" #-}

cairoImageSurfaceGetCairoImage :: PrimMonad m => CairoSurfaceImageT s (PrimState m) -> m CairoImage
cairoImageSurfaceGetCairoImage :: forall (m :: * -> *) s.
PrimMonad m =>
CairoSurfaceImageT s (PrimState m) -> m CairoImage
cairoImageSurfaceGetCairoImage = (Ptr (CairoSurfaceT s (PrimState m)) -> IO CairoImage)
-> CairoSurfaceImageT s (PrimState m) -> m CairoImage
forall (m :: * -> *) s a.
PrimMonad m =>
(Ptr (CairoSurfaceT s (PrimState m)) -> IO a)
-> CairoSurfaceImageT s (PrimState m) -> m a
argCairoSurfaceT \Ptr (CairoSurfaceT s (PrimState m))
sfc -> do
	d <- Ptr (CairoSurfaceT s (PrimState m)) -> IO (Ptr Word8)
forall s ps. Ptr (CairoSurfaceT s ps) -> IO (Ptr Word8)
c_cairo_image_surface_get_data Ptr (CairoSurfaceT s (PrimState m))
sfc
	f <- c_cairo_image_surface_get_format sfc
	w <- c_cairo_image_surface_get_width sfc
	h <- c_cairo_image_surface_get_height sfc
	s <- c_cairo_image_surface_get_stride sfc
	p <- mallocBytes . fromIntegral $ s * h
	copyBytes p d . fromIntegral $ s * h
	fd <- newForeignPtr (castPtr p) $ free (castPtr p)
	pure $ CairoImage (CairoFormatT f) (fromIntegral w) (fromIntegral h) (fromIntegral s) fd

cairoImageSurfaceGetCairoImageMut :: PrimMonad m => CairoSurfaceImageT s (PrimState m) -> m (CairoImageMut (PrimState m))
cairoImageSurfaceGetCairoImageMut :: forall (m :: * -> *) s.
PrimMonad m =>
CairoSurfaceImageT s (PrimState m)
-> m (CairoImageMut (PrimState m))
cairoImageSurfaceGetCairoImageMut = (Ptr (CairoSurfaceT s (PrimState m))
 -> IO (CairoImageMut (PrimState m)))
-> CairoSurfaceImageT s (PrimState m)
-> m (CairoImageMut (PrimState m))
forall (m :: * -> *) s a.
PrimMonad m =>
(Ptr (CairoSurfaceT s (PrimState m)) -> IO a)
-> CairoSurfaceImageT s (PrimState m) -> m a
argCairoSurfaceT \Ptr (CairoSurfaceT s (PrimState m))
sfc -> do
	d <- Ptr (CairoSurfaceT s (PrimState m)) -> IO (Ptr Word8)
forall s ps. Ptr (CairoSurfaceT s ps) -> IO (Ptr Word8)
c_cairo_image_surface_get_data Ptr (CairoSurfaceT s (PrimState m))
sfc
	f <- c_cairo_image_surface_get_format sfc
	w <- c_cairo_image_surface_get_width sfc
	h <- c_cairo_image_surface_get_height sfc
	s <- c_cairo_image_surface_get_stride sfc
	p <- mallocBytes . fromIntegral $ s * h
	copyBytes p d . fromIntegral $ s * h
	fd <- newForeignPtr (castPtr p) $ free (castPtr p)
	pure $ CairoImageMut (CairoFormatT f) (fromIntegral w) (fromIntegral h) (fromIntegral s) fd

newtype Argb32 = Argb32 Word32 deriving (Int -> Argb32 -> ShowS
[Argb32] -> ShowS
Argb32 -> String
(Int -> Argb32 -> ShowS)
-> (Argb32 -> String) -> ([Argb32] -> ShowS) -> Show Argb32
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Argb32 -> ShowS
showsPrec :: Int -> Argb32 -> ShowS
$cshow :: Argb32 -> String
show :: Argb32 -> String
$cshowList :: [Argb32] -> ShowS
showList :: [Argb32] -> ShowS
Show, Ptr Argb32 -> IO Argb32
Ptr Argb32 -> Int -> IO Argb32
Ptr Argb32 -> Int -> Argb32 -> IO ()
Ptr Argb32 -> Argb32 -> IO ()
Argb32 -> Int
(Argb32 -> Int)
-> (Argb32 -> Int)
-> (Ptr Argb32 -> Int -> IO Argb32)
-> (Ptr Argb32 -> Int -> Argb32 -> IO ())
-> (forall b. Ptr b -> Int -> IO Argb32)
-> (forall b. Ptr b -> Int -> Argb32 -> IO ())
-> (Ptr Argb32 -> IO Argb32)
-> (Ptr Argb32 -> Argb32 -> IO ())
-> Storable Argb32
forall b. Ptr b -> Int -> IO Argb32
forall b. Ptr b -> Int -> Argb32 -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: Argb32 -> Int
sizeOf :: Argb32 -> Int
$calignment :: Argb32 -> Int
alignment :: Argb32 -> Int
$cpeekElemOff :: Ptr Argb32 -> Int -> IO Argb32
peekElemOff :: Ptr Argb32 -> Int -> IO Argb32
$cpokeElemOff :: Ptr Argb32 -> Int -> Argb32 -> IO ()
pokeElemOff :: Ptr Argb32 -> Int -> Argb32 -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Argb32
peekByteOff :: forall b. Ptr b -> Int -> IO Argb32
$cpokeByteOff :: forall b. Ptr b -> Int -> Argb32 -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> Argb32 -> IO ()
$cpeek :: Ptr Argb32 -> IO Argb32
peek :: Ptr Argb32 -> IO Argb32
$cpoke :: Ptr Argb32 -> Argb32 -> IO ()
poke :: Ptr Argb32 -> Argb32 -> IO ()
Storable)

foreign import ccall "cairo_image_surface_create_for_data" c_cairo_image_surface_create_for_data ::
	Ptr Word8 -> Int32 -> Int32 -> Int32 -> Int32 -> IO (Ptr (CairoSurfaceT s ps))
{-# LINE 102 "src/Graphics/Cairo/Surfaces/ImageSurfaces.hsc" #-}

cairoImageSurfaceCreateForCairoImage ::
	PrimMonad m => CairoImage -> m (CairoSurfaceImageT s (PrimState m))
cairoImageSurfaceCreateForCairoImage :: forall (m :: * -> *) s.
PrimMonad m =>
CairoImage -> m (CairoSurfaceImageT s (PrimState m))
cairoImageSurfaceCreateForCairoImage (CairoImage (CairoFormatT Int32
f) CInt
w CInt
h CInt
s ForeignPtr CUChar
d) = IO (CairoSurfaceImageT s (PrimState m))
-> m (CairoSurfaceImageT s (PrimState m))
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim do
	p <- Int -> IO (Ptr CUChar)
forall a. Int -> IO (Ptr a)
mallocBytes Int
n
	withForeignPtr d \Ptr CUChar
pd -> Ptr CUChar -> Ptr CUChar -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr CUChar
p Ptr CUChar
pd Int
n
	sp <- c_cairo_image_surface_create_for_data (castPtr p) f (fromIntegral w) (fromIntegral h) (fromIntegral s)
	mkCairoSurfaceImageT' sp p
	where n :: Int
n = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> CInt -> Int
forall a b. (a -> b) -> a -> b
$ CInt
s CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
* CInt
h

cairoImageSurfaceCreateForCairoImageMut ::
	PrimMonad m => CairoImageMut (PrimState m) -> m (CairoSurfaceImageT s (PrimState m))
cairoImageSurfaceCreateForCairoImageMut :: forall (m :: * -> *) s.
PrimMonad m =>
CairoImageMut (PrimState m)
-> m (CairoSurfaceImageT s (PrimState m))
cairoImageSurfaceCreateForCairoImageMut (CairoImageMut (CairoFormatT Int32
f) CInt
w CInt
h CInt
s ForeignPtr CUChar
d) = IO (CairoSurfaceImageT s (PrimState m))
-> m (CairoSurfaceImageT s (PrimState m))
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim do
	p <- Int -> IO (Ptr CUChar)
forall a. Int -> IO (Ptr a)
mallocBytes Int
n
	withForeignPtr d \Ptr CUChar
pd -> Ptr CUChar -> Ptr CUChar -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr CUChar
p Ptr CUChar
pd Int
n
	sp <- c_cairo_image_surface_create_for_data (castPtr p) f (fromIntegral w) (fromIntegral h) (fromIntegral s)
	mkCairoSurfaceImageT' sp p
	where n :: Int
n = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> CInt -> Int
forall a b. (a -> b) -> a -> b
$ CInt
s CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
* CInt
h

foreign import ccall "cairo_image_surface_get_data" c_cairo_image_surface_get_data ::
	Ptr (CairoSurfaceT s ps) -> IO (Ptr Word8)
{-# LINE 123 "src/Graphics/Cairo/Surfaces/ImageSurfaces.hsc" #-}

argCairoSurfaceT :: PrimMonad m => (Ptr (CairoSurfaceT s (PrimState m)) -> IO a) -> CairoSurfaceImageT s (PrimState m) -> m a
argCairoSurfaceT :: forall (m :: * -> *) s a.
PrimMonad m =>
(Ptr (CairoSurfaceT s (PrimState m)) -> IO a)
-> CairoSurfaceImageT s (PrimState m) -> m a
argCairoSurfaceT Ptr (CairoSurfaceT s (PrimState m)) -> IO a
io (CairoSurfaceImageT ForeignPtr (CairoSurfaceT s (PrimState m))
fs) = IO a -> m a
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ ForeignPtr (CairoSurfaceT s (PrimState m))
-> (Ptr (CairoSurfaceT s (PrimState m)) -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr (CairoSurfaceT s (PrimState m))
fs Ptr (CairoSurfaceT s (PrimState m)) -> IO a
io

returnCairoSurfaceT :: PrimMonad m => IO (Ptr (CairoSurfaceT s (PrimState m))) -> m (CairoSurfaceImageT s (PrimState m))
returnCairoSurfaceT :: forall (m :: * -> *) s.
PrimMonad m =>
IO (Ptr (CairoSurfaceT s (PrimState m)))
-> m (CairoSurfaceImageT s (PrimState m))
returnCairoSurfaceT IO (Ptr (CairoSurfaceT s (PrimState m)))
io = IO (CairoSurfaceImageT s (PrimState m))
-> m (CairoSurfaceImageT s (PrimState m))
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim (IO (CairoSurfaceImageT s (PrimState m))
 -> m (CairoSurfaceImageT s (PrimState m)))
-> IO (CairoSurfaceImageT s (PrimState m))
-> m (CairoSurfaceImageT s (PrimState m))
forall a b. (a -> b) -> a -> b
$ Ptr (CairoSurfaceT s (PrimState m))
-> IO (CairoSurfaceImageT s (PrimState m))
forall s ps.
Ptr (CairoSurfaceT s ps) -> IO (CairoSurfaceImageT s ps)
mkCairoSurfaceImageT (Ptr (CairoSurfaceT s (PrimState m))
 -> IO (CairoSurfaceImageT s (PrimState m)))
-> IO (Ptr (CairoSurfaceT s (PrimState m)))
-> IO (CairoSurfaceImageT s (PrimState m))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Ptr (CairoSurfaceT s (PrimState m)))
io

mkCairoSurfaceImageT :: Ptr (CairoSurfaceT s ps) -> IO (CairoSurfaceImageT s ps)
mkCairoSurfaceImageT :: forall s ps.
Ptr (CairoSurfaceT s ps) -> IO (CairoSurfaceImageT s ps)
mkCairoSurfaceImageT Ptr (CairoSurfaceT s ps)
p = ForeignPtr (CairoSurfaceT s ps) -> CairoSurfaceImageT s ps
forall s ps.
ForeignPtr (CairoSurfaceT s ps) -> CairoSurfaceImageT s ps
CairoSurfaceImageT (ForeignPtr (CairoSurfaceT s ps) -> CairoSurfaceImageT s ps)
-> IO (ForeignPtr (CairoSurfaceT s ps))
-> IO (CairoSurfaceImageT s ps)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr (CairoSurfaceT s ps)
-> IO () -> IO (ForeignPtr (CairoSurfaceT s ps))
forall a. Ptr a -> IO () -> IO (ForeignPtr a)
newForeignPtr Ptr (CairoSurfaceT s ps)
p (Ptr (CairoSurfaceT s ps) -> IO ()
forall s ps. Ptr (CairoSurfaceT s ps) -> IO ()
c_cairo_surface_destroy Ptr (CairoSurfaceT s ps)
p)

mkCairoSurfaceImageT' :: Ptr (CairoSurfaceT s ps) -> Ptr a -> IO (CairoSurfaceImageT s ps)
mkCairoSurfaceImageT' :: forall s ps a.
Ptr (CairoSurfaceT s ps) -> Ptr a -> IO (CairoSurfaceImageT s ps)
mkCairoSurfaceImageT' Ptr (CairoSurfaceT s ps)
ps Ptr a
p = ForeignPtr (CairoSurfaceT s ps) -> CairoSurfaceImageT s ps
forall s ps.
ForeignPtr (CairoSurfaceT s ps) -> CairoSurfaceImageT s ps
CairoSurfaceImageT (ForeignPtr (CairoSurfaceT s ps) -> CairoSurfaceImageT s ps)
-> IO (ForeignPtr (CairoSurfaceT s ps))
-> IO (CairoSurfaceImageT s ps)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr (CairoSurfaceT s ps)
-> IO () -> IO (ForeignPtr (CairoSurfaceT s ps))
forall a. Ptr a -> IO () -> IO (ForeignPtr a)
newForeignPtr Ptr (CairoSurfaceT s ps)
ps (Ptr a -> IO ()
forall a. Ptr a -> IO ()
free Ptr a
p IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr (CairoSurfaceT s ps) -> IO ()
forall s ps. Ptr (CairoSurfaceT s ps) -> IO ()
c_cairo_surface_destroy Ptr (CairoSurfaceT s ps)
ps)

cairoImageSurfaceGetWidth :: PrimMonad m =>
	CairoSurfaceImageT s (PrimState m) -> m Int32
{-# LINE 138 "src/Graphics/Cairo/Surfaces/ImageSurfaces.hsc" #-}
cairoImageSurfaceGetWidth = argCairoSurfaceT \sfc ->
	c_cairo_image_surface_get_width sfc

cairoImageSurfaceGetHeight :: PrimMonad m =>
	CairoSurfaceImageT s (PrimState m) -> m Int32
{-# LINE 143 "src/Graphics/Cairo/Surfaces/ImageSurfaces.hsc" #-}
cairoImageSurfaceGetHeight = argCairoSurfaceT \sfc ->
	c_cairo_image_surface_get_height sfc

cairoImageSurfaceGetStride :: PrimMonad m =>
	CairoSurfaceImageT s (PrimState m) -> m Int32
{-# LINE 148 "src/Graphics/Cairo/Surfaces/ImageSurfaces.hsc" #-}
cairoImageSurfaceGetStride = argCairoSurfaceT \sfc ->
	c_cairo_image_surface_get_stride sfc