{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.Sparse.Image.Middle.Internal where

import Foreign.Ptr
import Foreign.Marshal.Array
import Foreign.Storable.PeekPoke
import Control.Arrow
import Data.IORef

import Gpu.Vulkan.Middle
import Gpu.Vulkan.Device.Middle.Internal qualified as Device
import Gpu.Vulkan.Memory.Middle.Internal qualified as Memory
import Gpu.Vulkan.Image.Middle.Internal qualified as Image
import Gpu.Vulkan.Sparse.Enum qualified as S
import Gpu.Vulkan.Sparse.Middle.Internal qualified as S

import Gpu.Vulkan.Sparse.Image.Core qualified as C

data OpaqueMemoryBindInfo = OpaqueMemoryBindInfo {
	OpaqueMemoryBindInfo -> I
opaqueMemoryBindInfoImage :: Image.I,
	OpaqueMemoryBindInfo -> [MemoryBind]
opaqueMemoryBindInfoBinds :: [S.MemoryBind] }

opaqueMemoryBindInfoToCore ::
	OpaqueMemoryBindInfo -> (C.OpaqueMemoryBindInfo -> IO a) -> IO a
opaqueMemoryBindInfoToCore :: forall a.
OpaqueMemoryBindInfo -> (OpaqueMemoryBindInfo -> IO a) -> IO a
opaqueMemoryBindInfoToCore OpaqueMemoryBindInfo {
	opaqueMemoryBindInfoImage :: OpaqueMemoryBindInfo -> I
opaqueMemoryBindInfoImage = Image.I IORef (Extent3d, I)
ir,
	opaqueMemoryBindInfoBinds :: OpaqueMemoryBindInfo -> [MemoryBind]
opaqueMemoryBindInfoBinds = [MemoryBind] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([MemoryBind] -> Int)
-> ([MemoryBind] -> [MemoryBind])
-> [MemoryBind]
-> (Int, [MemoryBind])
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [MemoryBind] -> [MemoryBind]
forall a. a -> a
id -> (Int
bc, [MemoryBind]
bs) } OpaqueMemoryBindInfo -> IO a
f = do
	(Extent3d
_, I
i) <- IORef (Extent3d, I) -> IO (Extent3d, I)
forall a. IORef a -> IO a
readIORef IORef (Extent3d, I)
ir
	[MemoryBind]
cbs <- MemoryBind -> IO MemoryBind
S.memoryBindToCore (MemoryBind -> IO MemoryBind) -> [MemoryBind] -> IO [MemoryBind]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
`mapM` [MemoryBind]
bs
	Int -> (Ptr MemoryBind -> IO a) -> IO a
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
bc \Ptr MemoryBind
pbs -> do
		Ptr MemoryBind -> [MemoryBind] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr MemoryBind
pbs [MemoryBind]
cbs
		OpaqueMemoryBindInfo -> IO a
f C.OpaqueMemoryBindInfo {
			opaqueMemoryBindInfoImage :: I
C.opaqueMemoryBindInfoImage = I
i,
			opaqueMemoryBindInfoBindCount :: Word32
C.opaqueMemoryBindInfoBindCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bc,
			opaqueMemoryBindInfoPBinds :: Ptr MemoryBind
C.opaqueMemoryBindInfoPBinds = Ptr MemoryBind
pbs }

data MemoryBindInfo = MemoryBindInfo {
	MemoryBindInfo -> I
memoryBindInfoImage :: Image.I,
	MemoryBindInfo -> [MemoryBind]
memoryBindInfoBinds :: [MemoryBind] }

memoryBindInfoToCore ::
	MemoryBindInfo -> (C.MemoryBindInfo -> IO a) -> IO a
memoryBindInfoToCore :: forall a. MemoryBindInfo -> (MemoryBindInfo -> IO a) -> IO a
memoryBindInfoToCore MemoryBindInfo {
	memoryBindInfoImage :: MemoryBindInfo -> I
memoryBindInfoImage = Image.I IORef (Extent3d, I)
ir,
	memoryBindInfoBinds :: MemoryBindInfo -> [MemoryBind]
memoryBindInfoBinds = [MemoryBind] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([MemoryBind] -> Int)
-> ([MemoryBind] -> [MemoryBind])
-> [MemoryBind]
-> (Int, [MemoryBind])
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [MemoryBind] -> [MemoryBind]
forall a. a -> a
id -> (Int
bc, [MemoryBind]
bs) } MemoryBindInfo -> IO a
f =  do
	(Extent3d
_, I
i) <- IORef (Extent3d, I) -> IO (Extent3d, I)
forall a. IORef a -> IO a
readIORef IORef (Extent3d, I)
ir
	[MemoryBind]
cbs <- MemoryBind -> IO MemoryBind
memoryBindToCore (MemoryBind -> IO MemoryBind) -> [MemoryBind] -> IO [MemoryBind]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
`mapM` [MemoryBind]
bs
	Int -> (Ptr MemoryBind -> IO a) -> IO a
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
bc \Ptr MemoryBind
pbs -> do
		Ptr MemoryBind -> [MemoryBind] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr MemoryBind
pbs [MemoryBind]
cbs
		MemoryBindInfo -> IO a
f C.MemoryBindInfo {
			memoryBindInfoImage :: I
C.memoryBindInfoImage = I
i,
			memoryBindInfoBindCount :: Word32
C.memoryBindInfoBindCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bc,
			memoryBindInfoPBinds :: Ptr MemoryBind
C.memoryBindInfoPBinds = Ptr MemoryBind
pbs }

data MemoryBind = MemoryBind {
	MemoryBind -> Subresource
memoryBindSubresource :: Image.Subresource,
	MemoryBind -> Offset3d
memoryBindOffset :: Offset3d,
	MemoryBind -> Extent3d
memoryBindExtent :: Extent3d,
	MemoryBind -> M
memoryBindMemory :: Memory.M,
	MemoryBind -> Size
memoryBindMemoryOffset :: Device.Size,
	MemoryBind -> MemoryBindFlags
memoryBindFlags :: S.MemoryBindFlags }

memoryBindToCore :: MemoryBind -> IO C.MemoryBind
memoryBindToCore :: MemoryBind -> IO MemoryBind
memoryBindToCore MemoryBind {
	memoryBindSubresource :: MemoryBind -> Subresource
memoryBindSubresource = Subresource
sr,
	memoryBindOffset :: MemoryBind -> Offset3d
memoryBindOffset = Offset3d
o,
	memoryBindExtent :: MemoryBind -> Extent3d
memoryBindExtent = Extent3d
e,
	memoryBindMemory :: MemoryBind -> M
memoryBindMemory = Memory.M IORef M
rm,
	memoryBindMemoryOffset :: MemoryBind -> Size
memoryBindMemoryOffset = Device.Size Word64
mo,
	memoryBindFlags :: MemoryBind -> MemoryBindFlags
memoryBindFlags = S.MemoryBindFlagBits Word32
fs } = do
	M
m <- IORef M -> IO M
forall a. IORef a -> IO a
readIORef IORef M
rm
	MemoryBind -> IO MemoryBind
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure C.MemoryBind {
		memoryBindSubresource :: Subresource
C.memoryBindSubresource = Subresource -> Subresource
Image.subresourceToCore Subresource
sr,
		memoryBindOffset :: Offset3d
C.memoryBindOffset = Offset3d
o,
		memoryBindExtent :: Extent3d
C.memoryBindExtent = Extent3d
e,
		memoryBindMemory :: M
C.memoryBindMemory = M
m,
		memoryBindMemoryOffset :: Word64
C.memoryBindMemoryOffset = Word64
mo,
		memoryBindFlags :: Word32
C.memoryBindFlags = Word32
fs }