{-# LINE 1 "src/Data/CairoImage/Parts.hsc" #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ScopedTypeVariables, TypeApplications, PatternSynonyms,
	ViewPatterns #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Data.CairoImage.Parts (
	-- * Tool
	gen, new, ptr, stride, with,
	-- * Cairo Format
	CairoFormatT(..),
	pattern CairoFormatArgb32, pattern CairoFormatRgb24,
	pattern CairoFormatA8, pattern CairoFormatA1,
	pattern CairoFormatRgb16_565, pattern CairoFormatRgb30 ) where

import Foreign.Ptr (Ptr, plusPtr)
import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
import Foreign.Concurrent (newForeignPtr)
import Foreign.Marshal (mallocBytes, free)
import Foreign.Storable (Storable, sizeOf, alignment, poke)
import Foreign.C.Types (CInt(..))
import Foreign.C.Enum(enum)
import Control.Monad.Primitive (
	PrimMonad(..), PrimBase, unsafeIOToPrim, unsafePrimToIO )
import Data.Foldable (for_)
import Data.Int (Int32)



---------------------------------------------------------------------------

-- * CAIRO FORMAT
-- * TOOL

---------------------------------------------------------------------------
-- CAIRO FORMAT
---------------------------------------------------------------------------

enum "CairoFormatT" ''Int32 [''Show, ''Read, ''Eq] [
{-# LINE 40 "src/Data/CairoImage/Parts.hsc" #-}
	("CairoFormatArgb32", 0),
{-# LINE 41 "src/Data/CairoImage/Parts.hsc" #-}
	("CairoFormatRgb24", 1),
{-# LINE 42 "src/Data/CairoImage/Parts.hsc" #-}
	("CairoFormatA8", 2),
{-# LINE 43 "src/Data/CairoImage/Parts.hsc" #-}
	("CairoFormatA1", 3),
{-# LINE 44 "src/Data/CairoImage/Parts.hsc" #-}
	("CairoFormatRgb16_565", 4),
{-# LINE 45 "src/Data/CairoImage/Parts.hsc" #-}
	("CairoFormatRgb30", 5) ]
{-# LINE 46 "src/Data/CairoImage/Parts.hsc" #-}

---------------------------------------------------------------------------
-- TOOL
---------------------------------------------------------------------------

gen :: (PrimBase m, Storable a) =>
	CInt -> CInt -> CInt -> (CInt -> CInt -> m a) -> m (ForeignPtr a)
gen :: forall (m :: * -> *) a.
(PrimBase m, Storable a) =>
CInt -> CInt -> CInt -> (CInt -> CInt -> m a) -> m (ForeignPtr a)
gen CInt
w CInt
h CInt
s CInt -> CInt -> m a
f = IO (ForeignPtr a) -> m (ForeignPtr a)
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim (IO (ForeignPtr a) -> m (ForeignPtr a))
-> IO (ForeignPtr a) -> m (ForeignPtr a)
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ptr a)
forall a. Int -> IO (Ptr a)
mallocBytes (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) IO (Ptr a) -> (Ptr a -> IO (ForeignPtr a)) -> IO (ForeignPtr a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr a
d -> do
	[CInt] -> (CInt -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [CInt
0 .. CInt
h CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1] \CInt
y -> [CInt] -> (CInt -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [CInt
0 .. CInt
w CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
- CInt
1] \CInt
x ->
		m a -> IO a
forall (m :: * -> *) a. PrimBase m => m a -> IO a
unsafePrimToIO (CInt -> CInt -> m a
f CInt
x CInt
y) IO a -> (a -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
p ->
			IO () -> (Ptr a -> IO ()) -> Maybe (Ptr a) -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
`poke` a
p) (Maybe (Ptr a) -> IO ()) -> Maybe (Ptr a) -> IO ()
forall a b. (a -> b) -> a -> b
$ CInt -> CInt -> CInt -> Ptr a -> CInt -> CInt -> Maybe (Ptr a)
forall a.
Storable a =>
CInt -> CInt -> CInt -> Ptr a -> CInt -> CInt -> Maybe (Ptr a)
ptr CInt
w CInt
h CInt
s Ptr a
d CInt
x CInt
y
	Ptr a -> IO () -> IO (ForeignPtr a)
forall a. Ptr a -> IO () -> IO (ForeignPtr a)
newForeignPtr Ptr a
d (IO () -> IO (ForeignPtr a)) -> IO () -> IO (ForeignPtr a)
forall a b. (a -> b) -> a -> b
$ Ptr a -> IO ()
forall a. Ptr a -> IO ()
free Ptr a
d

new :: PrimMonad m => CInt -> CInt -> m (ForeignPtr a)
new :: forall (m :: * -> *) a.
PrimMonad m =>
CInt -> CInt -> m (ForeignPtr a)
new CInt
s CInt
h = IO (ForeignPtr a) -> m (ForeignPtr a)
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim
	(IO (ForeignPtr a) -> m (ForeignPtr a))
-> IO (ForeignPtr a) -> m (ForeignPtr a)
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ptr a)
forall a. Int -> IO (Ptr a)
mallocBytes (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) IO (Ptr a) -> (Ptr a -> IO (ForeignPtr a)) -> IO (ForeignPtr a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr a
d -> Ptr a -> IO () -> IO (ForeignPtr a)
forall a. Ptr a -> IO () -> IO (ForeignPtr a)
newForeignPtr Ptr a
d (IO () -> IO (ForeignPtr a)) -> IO () -> IO (ForeignPtr a)
forall a b. (a -> b) -> a -> b
$ Ptr a -> IO ()
forall a. Ptr a -> IO ()
free Ptr a
d

ptr :: forall a . Storable a =>
	CInt -> CInt -> CInt -> Ptr a -> CInt -> CInt -> Maybe (Ptr a)
ptr :: forall a.
Storable a =>
CInt -> CInt -> CInt -> Ptr a -> CInt -> CInt -> Maybe (Ptr a)
ptr (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
w) (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
h) (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
s) Ptr a
p
	(CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
x) (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
y)
	| Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
x Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w Bool -> Bool -> Bool
&& Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
y Bool -> Bool -> Bool
&& Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
h = Ptr a -> Maybe (Ptr a)
forall a. a -> Maybe a
Just (Ptr a -> Maybe (Ptr a)) -> Ptr a -> Maybe (Ptr a)
forall a b. (a -> b) -> a -> b
$ Ptr a
p Ptr a -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b)
	| Bool
otherwise = Maybe (Ptr a)
forall a. Maybe a
Nothing
	where
	b :: Int
b = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* ((forall a. Storable a => a -> Int
sizeOf @a a
forall a. HasCallStack => a
undefined Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
al Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
al
	al :: Int
al = forall a. Storable a => a -> Int
alignment @a a
forall a. HasCallStack => a
undefined

stride :: PrimMonad m => CairoFormatT -> CInt -> m CInt
stride :: forall (m :: * -> *). PrimMonad m => CairoFormatT -> CInt -> m CInt
stride = (IO CInt -> m CInt
forall (m :: * -> *) a. PrimMonad m => IO a -> m a
unsafeIOToPrim (IO CInt -> m CInt) -> (CInt -> IO CInt) -> CInt -> m CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((CInt -> IO CInt) -> CInt -> m CInt)
-> (CairoFormatT -> CInt -> IO CInt)
-> CairoFormatT
-> CInt
-> m CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CairoFormatT -> CInt -> IO CInt
c_cairo_format_stride_for_width

foreign import ccall "cairo_format_stride_for_width"
	c_cairo_format_stride_for_width :: CairoFormatT -> CInt -> IO CInt

with :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
with :: forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
with = ForeignPtr a -> (Ptr a -> IO b) -> IO b
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr