{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUaGE ScopedTypeVariables, RankNTypes, TypeApplications #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE FlexibleContexts, FlexibleInstances, UndecidableInstances #-}
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.CommandBuffer.Middle.Internal (

	C(..),
	AllocateInfo(..), allocateCs, freeCs,

	BeginInfo(..), InheritanceInfo(..), begin, end, reset,

	SubmitInfo(..), submitInfoToCore

	) where

import Foreign.Ptr
import Foreign.Marshal.Array
import Foreign.Storable.PeekPoke (
	WithPoked, withPoked, withPoked', withPtrS, pattern NullPtr )
import Control.Arrow
import Data.TypeLevel.Maybe qualified as TMaybe
import Data.Default
import Data.IORef
import Data.Word

import Gpu.Vulkan.Enum
import Gpu.Vulkan.Exception.Middle.Internal
import Gpu.Vulkan.Exception.Enum
import Gpu.Vulkan.CommandBuffer.Enum
import Gpu.Vulkan.Base.Middle.Internal

import qualified Gpu.Vulkan.Device.Middle.Types as Device
import qualified Gpu.Vulkan.RenderPass.Middle.Internal as RenderPass
import qualified Gpu.Vulkan.Framebuffer.Middle.Internal as Framebuffer
import qualified Gpu.Vulkan.CommandPool.Middle.Internal as CommandPool
import qualified Gpu.Vulkan.CommandBuffer.Core as C
import qualified Gpu.Vulkan.Pipeline.Core as Pipeline.C

data AllocateInfo mn = AllocateInfo {
	forall (mn :: Maybe (*)). AllocateInfo mn -> M mn
allocateInfoNext :: TMaybe.M mn,
	forall (mn :: Maybe (*)). AllocateInfo mn -> C
allocateInfoCommandPool :: CommandPool.C,
	forall (mn :: Maybe (*)). AllocateInfo mn -> Level
allocateInfoLevel :: Level,
	forall (mn :: Maybe (*)). AllocateInfo mn -> Word32
allocateInfoCommandBufferCount :: Word32 }

deriving instance Show (TMaybe.M mn) => Show (AllocateInfo mn)

allocateInfoToCore :: WithPoked (TMaybe.M mn) =>
	AllocateInfo mn -> (Ptr C.AllocateInfo -> IO a) -> IO ()
allocateInfoToCore :: forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
AllocateInfo mn -> (Ptr AllocateInfo -> IO a) -> IO ()
allocateInfoToCore AllocateInfo {
	allocateInfoNext :: forall (mn :: Maybe (*)). AllocateInfo mn -> M mn
allocateInfoNext = M mn
mnxt,
	allocateInfoCommandPool :: forall (mn :: Maybe (*)). AllocateInfo mn -> C
allocateInfoCommandPool = CommandPool.C C
cp,
	allocateInfoLevel :: forall (mn :: Maybe (*)). AllocateInfo mn -> Level
allocateInfoLevel = Level Word32
lvl,
	allocateInfoCommandBufferCount :: forall (mn :: Maybe (*)). AllocateInfo mn -> Word32
allocateInfoCommandBufferCount = Word32
cbc
	} Ptr AllocateInfo -> IO a
f = M mn -> (forall s. PtrS s (M mn) -> IO ()) -> IO ()
forall a b.
WithPoked a =>
a -> (forall s. PtrS s a -> IO b) -> IO b
forall b. M mn -> (forall s. PtrS s (M mn) -> IO b) -> IO b
withPoked' M mn
mnxt \PtrS s (M mn)
pnxt -> PtrS s (M mn) -> (Ptr (M mn) -> IO a) -> IO ()
forall s a b. PtrS s a -> (Ptr a -> IO b) -> IO ()
withPtrS PtrS s (M mn)
pnxt \(Ptr (M mn) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr -> Ptr ()
pnxt') ->
	AllocateInfo -> (Ptr AllocateInfo -> IO a) -> IO a
forall a b. Pokable a => a -> (Ptr a -> IO b) -> IO b
withPoked C.AllocateInfo {
			allocateInfoSType :: ()
C.allocateInfoSType = (),
			allocateInfoPNext :: Ptr ()
C.allocateInfoPNext = Ptr ()
pnxt',
			allocateInfoCommandPool :: C
C.allocateInfoCommandPool = C
cp,
			allocateInfoLevel :: Word32
C.allocateInfoLevel = Word32
lvl,
			allocateInfoCommandBufferCount :: Word32
C.allocateInfoCommandBufferCount = Word32
cbc } Ptr AllocateInfo -> IO a
f

data C = C {
	C -> IORef P
cPipeline :: IORef Pipeline.C.P,
	C -> C
unC :: C.C }

newC :: C.C -> IO C
newC :: C -> IO C
newC C
c = IORef P -> C -> C
C (IORef P -> C -> C) -> IO (IORef P) -> IO (C -> C)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P -> IO (IORef P)
forall a. a -> IO (IORef a)
newIORef P
forall a. Ptr a
nullPtr IO (C -> C) -> IO C -> IO C
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> C -> IO C
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure C
c

allocateCs :: WithPoked (TMaybe.M mn) => Device.D -> AllocateInfo mn -> IO [C]
allocateCs :: forall (mn :: Maybe (*)).
WithPoked (M mn) =>
D -> AllocateInfo mn -> IO [C]
allocateCs (Device.D D
dvc) AllocateInfo mn
ai =  (C -> IO C) -> [C] -> IO [C]
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 C -> IO C
newC ([C] -> IO [C]) -> IO [C] -> IO [C]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
	Int -> (Ptr C -> IO [C]) -> IO [C]
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
cbc \Ptr C
pc -> do
	AllocateInfo mn -> (Ptr AllocateInfo -> IO ()) -> IO ()
forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
AllocateInfo mn -> (Ptr AllocateInfo -> IO a) -> IO ()
allocateInfoToCore AllocateInfo mn
ai \Ptr AllocateInfo
pai -> do
		r <- D -> Ptr AllocateInfo -> Ptr C -> IO Int32
C.allocateCs D
dvc Ptr AllocateInfo
pai Ptr C
pc
		throwUnlessSuccess $ Result r
	Int -> Ptr C -> IO [C]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
cbc Ptr C
pc
	where cbc :: Int
cbc = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ AllocateInfo mn -> Word32
forall (mn :: Maybe (*)). AllocateInfo mn -> Word32
allocateInfoCommandBufferCount AllocateInfo mn
ai

data BeginInfo mn ii = BeginInfo {
	forall (mn :: Maybe (*)) (ii :: Maybe (*)). BeginInfo mn ii -> M mn
beginInfoNext :: TMaybe.M mn,
	forall (mn :: Maybe (*)) (ii :: Maybe (*)).
BeginInfo mn ii -> UsageFlags
beginInfoFlags :: UsageFlags,
	forall (mn :: Maybe (*)) (ii :: Maybe (*)).
BeginInfo mn ii -> Maybe (InheritanceInfo ii)
beginInfoInheritanceInfo :: Maybe (InheritanceInfo ii) }

instance Default (BeginInfo 'Nothing ii) where
	def :: BeginInfo 'Nothing ii
def = BeginInfo {
		beginInfoNext :: M 'Nothing
beginInfoNext = M 'Nothing
TMaybe.N,
		beginInfoFlags :: UsageFlags
beginInfoFlags = UsageFlags
UsageFlagsZero,
		beginInfoInheritanceInfo :: Maybe (InheritanceInfo ii)
beginInfoInheritanceInfo = Maybe (InheritanceInfo ii)
forall a. Maybe a
Nothing }

beginInfoToCore :: (WithPoked (TMaybe.M mn), WithPoked (TMaybe.M ii)) =>
	BeginInfo mn ii -> (Ptr C.BeginInfo -> IO a) -> IO ()
beginInfoToCore :: forall (mn :: Maybe (*)) (ii :: Maybe (*)) a.
(WithPoked (M mn), WithPoked (M ii)) =>
BeginInfo mn ii -> (Ptr BeginInfo -> IO a) -> IO ()
beginInfoToCore BeginInfo {
	beginInfoNext :: forall (mn :: Maybe (*)) (ii :: Maybe (*)). BeginInfo mn ii -> M mn
beginInfoNext = M mn
mnxt,
	beginInfoFlags :: forall (mn :: Maybe (*)) (ii :: Maybe (*)).
BeginInfo mn ii -> UsageFlags
beginInfoFlags = UsageFlagBits Word32
flgs,
	beginInfoInheritanceInfo :: forall (mn :: Maybe (*)) (ii :: Maybe (*)).
BeginInfo mn ii -> Maybe (InheritanceInfo ii)
beginInfoInheritanceInfo = Maybe (InheritanceInfo ii)
mii } Ptr BeginInfo -> IO a
f =
	M mn -> (forall s. PtrS s (M mn) -> IO ()) -> IO ()
forall a b.
WithPoked a =>
a -> (forall s. PtrS s a -> IO b) -> IO b
forall b. M mn -> (forall s. PtrS s (M mn) -> IO b) -> IO b
withPoked' M mn
mnxt \PtrS s (M mn)
pnxt -> PtrS s (M mn) -> (Ptr (M mn) -> IO ()) -> IO ()
forall s a b. PtrS s a -> (Ptr a -> IO b) -> IO ()
withPtrS PtrS s (M mn)
pnxt \(Ptr (M mn) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr -> Ptr ()
pnxt') ->
	((Ptr InheritanceInfo -> IO ()) -> IO ())
-> (InheritanceInfo ii -> (Ptr InheritanceInfo -> IO ()) -> IO ())
-> Maybe (InheritanceInfo ii)
-> (Ptr InheritanceInfo -> IO ())
-> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((Ptr InheritanceInfo -> IO ()) -> Ptr InheritanceInfo -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr InheritanceInfo
forall a. Ptr a
NullPtr) InheritanceInfo ii -> (Ptr InheritanceInfo -> IO ()) -> IO ()
forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
InheritanceInfo mn -> (Ptr InheritanceInfo -> IO a) -> IO ()
inheritanceInfoToCore Maybe (InheritanceInfo ii)
mii \Ptr InheritanceInfo
pii ->
	() () -> IO a -> IO ()
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ BeginInfo -> (Ptr BeginInfo -> IO a) -> IO a
forall a b. Pokable a => a -> (Ptr a -> IO b) -> IO b
withPoked C.BeginInfo {
			beginInfoSType :: ()
C.beginInfoSType = (),
			beginInfoPNext :: Ptr ()
C.beginInfoPNext = Ptr ()
pnxt',
			beginInfoFlags :: Word32
C.beginInfoFlags = Word32
flgs,
			beginInfoPInheritanceInfo :: Ptr InheritanceInfo
C.beginInfoPInheritanceInfo = Ptr InheritanceInfo
pii } Ptr BeginInfo -> IO a
f

data InheritanceInfo mn = InheritanceInfo {
	forall (mn :: Maybe (*)). InheritanceInfo mn -> M mn
inheritanceInfoNext :: TMaybe.M mn,
	forall (mn :: Maybe (*)). InheritanceInfo mn -> R
inheritanceInfoRenderPass :: RenderPass.R,
	forall (mn :: Maybe (*)). InheritanceInfo mn -> Word32
inheritanceInfoSubpass :: Word32,
	forall (mn :: Maybe (*)). InheritanceInfo mn -> F
inheritanceInfoFramebuffer :: Framebuffer.F,
	forall (mn :: Maybe (*)). InheritanceInfo mn -> Bool
inheritanceInfoOcclusionQueryEnable :: Bool,
	forall (mn :: Maybe (*)). InheritanceInfo mn -> QueryControlFlags
inheritanceInfoQueryFlags :: QueryControlFlags,
	forall (mn :: Maybe (*)).
InheritanceInfo mn -> QueryPipelineStatisticFlags
inheritanceInfoPipelineStatistics :: QueryPipelineStatisticFlags }

inheritanceInfoToCore :: WithPoked (TMaybe.M mn) =>
	InheritanceInfo mn -> (Ptr C.InheritanceInfo -> IO a) -> IO ()
inheritanceInfoToCore :: forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
InheritanceInfo mn -> (Ptr InheritanceInfo -> IO a) -> IO ()
inheritanceInfoToCore InheritanceInfo {
	inheritanceInfoNext :: forall (mn :: Maybe (*)). InheritanceInfo mn -> M mn
inheritanceInfoNext = M mn
mnxt,
	inheritanceInfoRenderPass :: forall (mn :: Maybe (*)). InheritanceInfo mn -> R
inheritanceInfoRenderPass = RenderPass.R R
rp,
	inheritanceInfoSubpass :: forall (mn :: Maybe (*)). InheritanceInfo mn -> Word32
inheritanceInfoSubpass = Word32
sp,
	inheritanceInfoFramebuffer :: forall (mn :: Maybe (*)). InheritanceInfo mn -> F
inheritanceInfoFramebuffer = F
fb,
	inheritanceInfoOcclusionQueryEnable :: forall (mn :: Maybe (*)). InheritanceInfo mn -> Bool
inheritanceInfoOcclusionQueryEnable = Bool
oqe,
	inheritanceInfoQueryFlags :: forall (mn :: Maybe (*)). InheritanceInfo mn -> QueryControlFlags
inheritanceInfoQueryFlags = QueryControlFlagBits Word32
qf,
	inheritanceInfoPipelineStatistics :: forall (mn :: Maybe (*)).
InheritanceInfo mn -> QueryPipelineStatisticFlags
inheritanceInfoPipelineStatistics = QueryPipelineStatisticFlagBits Word32
ps
	} Ptr InheritanceInfo -> IO a
f = M mn -> (forall s. PtrS s (M mn) -> IO ()) -> IO ()
forall a b.
WithPoked a =>
a -> (forall s. PtrS s a -> IO b) -> IO b
forall b. M mn -> (forall s. PtrS s (M mn) -> IO b) -> IO b
withPoked' M mn
mnxt \PtrS s (M mn)
pnxt -> PtrS s (M mn) -> (Ptr (M mn) -> IO a) -> IO ()
forall s a b. PtrS s a -> (Ptr a -> IO b) -> IO ()
withPtrS PtrS s (M mn)
pnxt \(Ptr (M mn) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr -> Ptr ()
pnxt') ->
	F -> IO F
Framebuffer.fToCore F
fb IO F -> (F -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \F
fb' ->
	InheritanceInfo -> (Ptr InheritanceInfo -> IO a) -> IO a
forall a b. Pokable a => a -> (Ptr a -> IO b) -> IO b
withPoked C.InheritanceInfo {
			inheritanceInfoSType :: ()
C.inheritanceInfoSType = (),
			inheritanceInfoPNext :: Ptr ()
C.inheritanceInfoPNext = Ptr ()
pnxt',
			inheritanceInfoRenderPass :: R
C.inheritanceInfoRenderPass = R
rp,
			inheritanceInfoSubpass :: Word32
C.inheritanceInfoSubpass = Word32
sp,
			inheritanceInfoFramebuffer :: F
C.inheritanceInfoFramebuffer = F
fb',
			inheritanceInfoOcclusionQueryEnable :: Word32
C.inheritanceInfoOcclusionQueryEnable = Bool -> Word32
boolToBool32 Bool
oqe,
			inheritanceInfoQueryFlags :: Word32
C.inheritanceInfoQueryFlags = Word32
qf,
			inheritanceInfoPipelineStatistics :: Word32
C.inheritanceInfoPipelineStatistics = Word32
ps } Ptr InheritanceInfo -> IO a
f

begin :: (WithPoked (TMaybe.M mn), WithPoked (TMaybe.M ii)) => C -> BeginInfo mn ii -> IO ()
begin :: forall (mn :: Maybe (*)) (ii :: Maybe (*)).
(WithPoked (M mn), WithPoked (M ii)) =>
C -> BeginInfo mn ii -> IO ()
begin (C IORef P
_ C
c) BeginInfo mn ii
bi =
	BeginInfo mn ii -> (Ptr BeginInfo -> IO ()) -> IO ()
forall (mn :: Maybe (*)) (ii :: Maybe (*)) a.
(WithPoked (M mn), WithPoked (M ii)) =>
BeginInfo mn ii -> (Ptr BeginInfo -> IO a) -> IO ()
beginInfoToCore BeginInfo mn ii
bi \Ptr BeginInfo
pbi -> Result -> IO ()
throwUnlessSuccess (Result -> IO ()) -> (Int32 -> Result) -> Int32 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Result
Result (Int32 -> IO ()) -> IO Int32 -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< C -> Ptr BeginInfo -> IO Int32
C.begin C
c Ptr BeginInfo
pbi

end :: C -> IO ()
end :: C -> IO ()
end (C IORef P
rppl C
c) = Result -> IO ()
throwUnlessSuccess (Result -> IO ()) -> (Int32 -> Result) -> Int32 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Result
Result (Int32 -> IO ()) -> IO Int32 -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
	IORef P -> P -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef P
rppl P
forall a. Ptr a
nullPtr
	C -> IO Int32
C.end C
c

reset :: C -> ResetFlags -> IO ()
reset :: C -> ResetFlags -> IO ()
reset (C IORef P
_ C
c) (ResetFlagBits Word32
fs) = Result -> IO ()
throwUnlessSuccess (Result -> IO ()) -> (Int32 -> Result) -> Int32 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Result
Result (Int32 -> IO ()) -> IO Int32 -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< C -> Word32 -> IO Int32
C.reset C
c Word32
fs

freeCs :: Device.D -> CommandPool.C -> [C] -> IO ()
freeCs :: D -> C -> [C] -> IO ()
freeCs (Device.D D
dvc) (CommandPool.C C
cp)
	([C] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([C] -> Int) -> ([C] -> [C]) -> [C] -> (Int, [C])
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')
&&& ((\(C IORef P
_ C
cb) -> C
cb) (C -> C) -> [C] -> [C]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) -> (Int
cc, [C]
cs)) = Int -> (Ptr C -> IO ()) -> IO ()
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
cc \Ptr C
pcs -> do
		Ptr C -> [C] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr C
pcs [C]
cs
		D -> C -> Word32 -> Ptr C -> IO ()
C.freeCs D
dvc C
cp (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cc) Ptr C
pcs

data SubmitInfo mn = SubmitInfo {
	forall (mn :: Maybe (*)). SubmitInfo mn -> M mn
submitInfoNext :: TMaybe.M mn,
	forall (mn :: Maybe (*)). SubmitInfo mn -> C
submitInfoCommandBuffer :: C,
	forall (mn :: Maybe (*)). SubmitInfo mn -> Word32
submitInfoDeviceMask :: Word32 }

submitInfoToCore :: WithPoked (TMaybe.M mn) =>
	SubmitInfo mn -> (C.SubmitInfo -> IO r) -> IO ()
submitInfoToCore :: forall (mn :: Maybe (*)) r.
WithPoked (M mn) =>
SubmitInfo mn -> (SubmitInfo -> IO r) -> IO ()
submitInfoToCore SubmitInfo {
	submitInfoNext :: forall (mn :: Maybe (*)). SubmitInfo mn -> M mn
submitInfoNext = M mn
mnxt,
	submitInfoCommandBuffer :: forall (mn :: Maybe (*)). SubmitInfo mn -> C
submitInfoCommandBuffer = C IORef P
_ C
c, submitInfoDeviceMask :: forall (mn :: Maybe (*)). SubmitInfo mn -> Word32
submitInfoDeviceMask = Word32
dm } SubmitInfo -> IO r
f =
	M mn -> (forall s. PtrS s (M mn) -> IO ()) -> IO ()
forall a b.
WithPoked a =>
a -> (forall s. PtrS s a -> IO b) -> IO b
forall b. M mn -> (forall s. PtrS s (M mn) -> IO b) -> IO b
withPoked' M mn
mnxt \PtrS s (M mn)
pnxt -> PtrS s (M mn) -> (Ptr (M mn) -> IO r) -> IO ()
forall s a b. PtrS s a -> (Ptr a -> IO b) -> IO ()
withPtrS PtrS s (M mn)
pnxt \(Ptr (M mn) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr -> Ptr ()
pnxt') ->
	SubmitInfo -> IO r
f C.SubmitInfo {
		submitInfoSType :: ()
C.submitInfoSType = (), submitInfoPNext :: Ptr ()
C.submitInfoPNext = Ptr ()
pnxt',
		submitInfoCommandBuffer :: C
C.submitInfoCommandBuffer = C
c, submitInfoDeviceMask :: Word32
C.submitInfoDeviceMask = Word32
dm }