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

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

import Foreign.Marshal.Array
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
	(_, i) <- IORef (Extent3d, I) -> IO (Extent3d, I)
forall a. IORef a -> IO a
readIORef IORef (Extent3d, I)
ir
	cbs <- S.memoryBindToCore `mapM` bs
	allocaArray 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
	(_, i) <- IORef (Extent3d, I) -> IO (Extent3d, I)
forall a. IORef a -> IO a
readIORef IORef (Extent3d, I)
ir
	cbs <- memoryBindToCore `mapM` bs
	allocaArray 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 <- IORef M -> IO M
forall a. IORef a -> IO a
readIORef IORef M
rm
	pure C.MemoryBind {
		C.memoryBindSubresource = Image.subresourceToCore sr,
		C.memoryBindOffset = o,
		C.memoryBindExtent = e,
		C.memoryBindMemory = m,
		C.memoryBindMemoryOffset = mo,
		C.memoryBindFlags = fs }