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

module Gpu.Vulkan.RenderPass.Middle.Internal where

import Foreign.Ptr
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.Storable
import Foreign.Storable.PeekPoke
import Control.Arrow
import Data.TypeLevel.Maybe qualified as TMaybe
import Data.TypeLevel.ParMaybe qualified as TPMaybe
import Data.TypeLevel.List qualified as TL
import qualified Data.HeteroParList as HeteroParList

import Gpu.Vulkan.Middle.Internal
import Gpu.Vulkan.Exception.Middle.Internal
import Gpu.Vulkan.Exception.Enum
import Gpu.Vulkan.RenderPass.Enum

import Gpu.Vulkan.Misc.Middle.Internal

import Gpu.Vulkan.AllocationCallbacks.Middle.Internal
	qualified as AllocationCallbacks
import qualified Gpu.Vulkan.Device.Middle.Types as Device
import qualified Gpu.Vulkan.Attachment.Middle.Internal as Attachment
import qualified Gpu.Vulkan.Subpass.Middle.Internal as Subpass
import qualified Gpu.Vulkan.Framebuffer.Middle.Internal as Framebuffer
import qualified Gpu.Vulkan.RenderPass.Core as C

data CreateInfo mn = CreateInfo {
	forall (mn :: Maybe (*)). CreateInfo mn -> M mn
createInfoNext :: TMaybe.M mn,
	forall (mn :: Maybe (*)). CreateInfo mn -> CreateFlags
createInfoFlags :: CreateFlags,
	forall (mn :: Maybe (*)). CreateInfo mn -> [Description]
createInfoAttachments :: [Attachment.Description],
	forall (mn :: Maybe (*)). CreateInfo mn -> [Description]
createInfoSubpasses :: [Subpass.Description],
	forall (mn :: Maybe (*)). CreateInfo mn -> [Dependency]
createInfoDependencies :: [Subpass.Dependency] }

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

createInfoToCore :: WithPoked (TMaybe.M mn) =>
	CreateInfo mn -> (Ptr C.CreateInfo -> IO r) -> IO ()
createInfoToCore :: forall (mn :: Maybe (*)) r.
WithPoked (M mn) =>
CreateInfo mn -> (Ptr CreateInfo -> IO r) -> IO ()
createInfoToCore CreateInfo {
	createInfoNext :: forall (mn :: Maybe (*)). CreateInfo mn -> M mn
createInfoNext = M mn
mnxt,
	createInfoFlags :: forall (mn :: Maybe (*)). CreateInfo mn -> CreateFlags
createInfoFlags = CreateFlagBits Word32
flgs,
	createInfoAttachments :: forall (mn :: Maybe (*)). CreateInfo mn -> [Description]
createInfoAttachments =
		([Description] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Description] -> Int)
-> ([Description] -> [Description])
-> [Description]
-> (Int, [Description])
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')
&&& (Description -> Description
Attachment.descriptionToCore (Description -> Description) -> [Description] -> [Description]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)) -> (Int
ac, [Description]
as),
	createInfoSubpasses :: forall (mn :: Maybe (*)). CreateInfo mn -> [Description]
createInfoSubpasses = ([Description] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Description] -> Int)
-> ([Description] -> [Description])
-> [Description]
-> (Int, [Description])
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')
&&& [Description] -> [Description]
forall a. a -> a
id) -> (Int
sc, [Description]
ss),
	createInfoDependencies :: forall (mn :: Maybe (*)). CreateInfo mn -> [Dependency]
createInfoDependencies =
		([Dependency] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Dependency] -> Int)
-> ([Dependency] -> [Dependency])
-> [Dependency]
-> (Int, [Dependency])
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')
&&& (Dependency -> Dependency
Subpass.dependencyToCore (Dependency -> Dependency) -> [Dependency] -> [Dependency]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)) -> (Int
dc, [Dependency]
ds) } Ptr CreateInfo -> 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') ->
	Int -> (Ptr Description -> IO r) -> IO r
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
ac \Ptr Description
pas ->
	Ptr Description -> [Description] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr Description
pas [Description]
as IO () -> IO r -> IO r
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
	(Description -> (Description -> IO r) -> IO r
forall r. Description -> (Description -> IO r) -> IO r
Subpass.descriptionToCore (Description -> (Description -> IO r) -> IO r)
-> [Description] -> ([Description] -> IO r) -> IO r
forall (m :: * -> *) a b c.
Monad m =>
(a -> (b -> m c) -> m c) -> [a] -> ([b] -> m c) -> m c
`mapContM` [Description]
ss) \[Description]
css ->
	Int -> (Ptr Description -> IO r) -> IO r
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
sc \Ptr Description
pss ->
	Ptr Description -> [Description] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr Description
pss [Description]
css IO () -> IO r -> IO r
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
	Int -> (Ptr Dependency -> IO r) -> IO r
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
dc \Ptr Dependency
pds ->
	Ptr Dependency -> [Dependency] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr Dependency
pds [Dependency]
ds IO () -> IO r -> IO r
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
	let ci :: CreateInfo
ci = C.CreateInfo {
		createInfoSType :: ()
C.createInfoSType = (),
		createInfoPNext :: Ptr ()
C.createInfoPNext = Ptr ()
pnxt',
		createInfoFlags :: Word32
C.createInfoFlags = Word32
flgs,
		createInfoAttachmentCount :: Word32
C.createInfoAttachmentCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ac,
		createInfoPAttachments :: Ptr Description
C.createInfoPAttachments = Ptr Description
pas,
		createInfoSubpassCount :: Word32
C.createInfoSubpassCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sc,
		createInfoPSubpasses :: Ptr Description
C.createInfoPSubpasses = Ptr Description
pss,
		createInfoDependencyCount :: Word32
C.createInfoDependencyCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dc,
		createInfoPDependencies :: Ptr Dependency
C.createInfoPDependencies = Ptr Dependency
pds } in
	CreateInfo -> (Ptr CreateInfo -> IO r) -> IO r
forall a b. Pokable a => a -> (Ptr a -> IO b) -> IO b
withPoked CreateInfo
ci Ptr CreateInfo -> IO r
f

newtype R = R C.R deriving Int -> R -> ShowS
[R] -> ShowS
R -> String
(Int -> R -> ShowS) -> (R -> String) -> ([R] -> ShowS) -> Show R
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> R -> ShowS
showsPrec :: Int -> R -> ShowS
$cshow :: R -> String
show :: R -> String
$cshowList :: [R] -> ShowS
showList :: [R] -> ShowS
Show

create :: WithPoked (TMaybe.M mn) =>
	Device.D -> CreateInfo mn -> TPMaybe.M AllocationCallbacks.A mc -> IO R
create :: forall (mn :: Maybe (*)) (mc :: Maybe (*)).
WithPoked (M mn) =>
D -> CreateInfo mn -> M A mc -> IO R
create (Device.D D
dvc) CreateInfo mn
ci M A mc
mac = R -> R
R (R -> R) -> IO R -> IO R
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
	(Ptr R -> IO R) -> IO R
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr R
pr -> do
		CreateInfo mn -> (Ptr CreateInfo -> IO ()) -> IO ()
forall (mn :: Maybe (*)) r.
WithPoked (M mn) =>
CreateInfo mn -> (Ptr CreateInfo -> IO r) -> IO ()
createInfoToCore CreateInfo mn
ci \Ptr CreateInfo
pci ->
			M A mc -> (Ptr A -> IO ()) -> IO ()
forall (ma :: Maybe (*)) b. M A ma -> (Ptr A -> IO b) -> IO ()
AllocationCallbacks.mToCore M A mc
mac \Ptr A
pac -> do
				r <- D -> Ptr CreateInfo -> Ptr A -> Ptr R -> IO Int32
C.create D
dvc Ptr CreateInfo
pci Ptr A
pac Ptr R
pr
				throwUnlessSuccess $ Result r
		Ptr R -> IO R
forall a. Storable a => Ptr a -> IO a
peek Ptr R
pr

destroy :: Device.D -> R -> TPMaybe.M AllocationCallbacks.A md -> IO ()
destroy :: forall (md :: Maybe (*)). D -> R -> M A md -> IO ()
destroy (Device.D D
dvc) (R R
r) M A md
mac =
	M A md -> (Ptr A -> IO ()) -> IO ()
forall (ma :: Maybe (*)) b. M A ma -> (Ptr A -> IO b) -> IO ()
AllocationCallbacks.mToCore M A md
mac ((Ptr A -> IO ()) -> IO ()) -> (Ptr A -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ D -> R -> Ptr A -> IO ()
C.destroy D
dvc R
r

data BeginInfo mn cts = BeginInfo {
	forall (mn :: Maybe (*)) (cts :: [ClearType]).
BeginInfo mn cts -> M mn
beginInfoNext :: TMaybe.M mn,
	forall (mn :: Maybe (*)) (cts :: [ClearType]).
BeginInfo mn cts -> R
beginInfoRenderPass :: R,
	forall (mn :: Maybe (*)) (cts :: [ClearType]).
BeginInfo mn cts -> F
beginInfoFramebuffer :: Framebuffer.F,
	forall (mn :: Maybe (*)) (cts :: [ClearType]).
BeginInfo mn cts -> Rect2d
beginInfoRenderArea :: Rect2d,
	forall (mn :: Maybe (*)) (cts :: [ClearType]).
BeginInfo mn cts -> PL ClearValue cts
beginInfoClearValues :: HeteroParList.PL ClearValue cts }

beginInfoToCore :: forall mn cts a . (WithPoked (TMaybe.M mn), ClearValueListToCore cts) =>
	BeginInfo mn cts -> (Ptr C.BeginInfo -> IO a) -> IO ()
beginInfoToCore :: forall (mn :: Maybe (*)) (cts :: [ClearType]) a.
(WithPoked (M mn), ClearValueListToCore cts) =>
BeginInfo mn cts -> (Ptr BeginInfo -> IO a) -> IO ()
beginInfoToCore BeginInfo {
	beginInfoNext :: forall (mn :: Maybe (*)) (cts :: [ClearType]).
BeginInfo mn cts -> M mn
beginInfoNext = M mn
mnxt,
	beginInfoRenderPass :: forall (mn :: Maybe (*)) (cts :: [ClearType]).
BeginInfo mn cts -> R
beginInfoRenderPass = R R
rp,
	beginInfoFramebuffer :: forall (mn :: Maybe (*)) (cts :: [ClearType]).
BeginInfo mn cts -> F
beginInfoFramebuffer = F
fb,
	beginInfoRenderArea :: forall (mn :: Maybe (*)) (cts :: [ClearType]).
BeginInfo mn cts -> Rect2d
beginInfoRenderArea = Rect2d
ra,
	beginInfoClearValues :: forall (mn :: Maybe (*)) (cts :: [ClearType]).
BeginInfo mn cts -> PL ClearValue cts
beginInfoClearValues = Word32 -> PL ClearValue cts -> Word32
forall a b. a -> b -> a
const (forall k (as :: [k]) n. (Length as, Integral n) => n
TL.length @_ @cts) (PL ClearValue cts -> Word32)
-> (PL ClearValue cts -> PL ClearValue cts)
-> PL ClearValue cts
-> (Word32, PL ClearValue cts)
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')
&&& PL ClearValue cts -> PL ClearValue cts
forall a. a -> a
id -> (Word32
cvc, PL ClearValue cts
cvs)
	} 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 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') ->
		PL ClearValue cts -> ([Ptr ClearValue] -> IO a) -> IO a
forall (cts :: [ClearType]) a.
ClearValueListToCore cts =>
PL ClearValue cts -> ([Ptr ClearValue] -> IO a) -> IO a
forall a. PL ClearValue cts -> ([Ptr ClearValue] -> IO a) -> IO a
clearValueListToCore PL ClearValue cts
cvs \[Ptr ClearValue]
pcvl ->
		[Ptr ClearValue] -> (Ptr ClearValue -> IO a) -> IO a
forall a. [Ptr ClearValue] -> (Ptr ClearValue -> IO a) -> IO a
clearValueListToArray [Ptr ClearValue]
pcvl \Ptr ClearValue
pcva -> do
		fb' <- F -> IO F
Framebuffer.fToCore F
fb
		let	ci = C.BeginInfo {
				beginInfoSType :: ()
C.beginInfoSType = (),
				beginInfoPNext :: Ptr ()
C.beginInfoPNext = Ptr ()
pnxt',
				beginInfoRenderPass :: R
C.beginInfoRenderPass = R
rp,
				beginInfoFramebuffer :: F
C.beginInfoFramebuffer = F
fb',
				beginInfoRenderArea :: Rect2d
C.beginInfoRenderArea = Rect2d
ra,
				beginInfoClearValueCount :: Word32
C.beginInfoClearValueCount = Word32
cvc,
				beginInfoPClearValues :: Ptr ClearValue
C.beginInfoPClearValues = Ptr ClearValue
pcva }
		withPoked ci f