{-# LINE 1 "src/Gpu/Vulkan/Pipeline/VertexInputState/Middle/Internal.hsc" #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
{-# LANGUAGE StandaloneDeriving, GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.Pipeline.VertexInputState.Middle.Internal where

import Foreign.Ptr
import Foreign.Marshal.Array
import Foreign.Storable
import Foreign.Storable.PeekPoke
import Foreign.C.Enum
import Control.Arrow
import Data.TypeLevel.Maybe qualified as TMaybe
import Data.Bits
import Data.Word

import qualified Gpu.Vulkan.VertexInput.Middle.Internal as VertexInput
import qualified Gpu.Vulkan.Pipeline.VertexInputState.Core as C



enum "CreateFlags" ''Word32
{-# LINE 28 "src/Gpu/Vulkan/Pipeline/VertexInputState/Middle/Internal.hsc" #-}
		[''Show, ''Storable, ''Eq, ''Bits] []

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 -> [BindingDescription]
createInfoVertexBindingDescriptions ::
		[VertexInput.BindingDescription],
	forall (mn :: Maybe (*)). CreateInfo mn -> [AttributeDescription]
createInfoVertexAttributeDescriptions ::
		[VertexInput.AttributeDescription] }

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

createInfoToCore :: WithPoked (TMaybe.M mn) =>
	CreateInfo mn -> (Ptr C.CreateInfo -> IO a) -> IO ()
createInfoToCore :: forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
CreateInfo mn -> (Ptr CreateInfo -> IO a) -> IO ()
createInfoToCore CreateInfo {
	createInfoNext :: forall (mn :: Maybe (*)). CreateInfo mn -> M mn
createInfoNext = M mn
mnxt,
	createInfoFlags :: forall (mn :: Maybe (*)). CreateInfo mn -> CreateFlags
createInfoFlags = CreateFlags Word32
flgs,
	createInfoVertexBindingDescriptions :: forall (mn :: Maybe (*)). CreateInfo mn -> [BindingDescription]
createInfoVertexBindingDescriptions =
		(([BindingDescription] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([BindingDescription] -> Int)
-> ([BindingDescription] -> [BindingDescription])
-> [BindingDescription]
-> (Int, [BindingDescription])
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')
&&& [BindingDescription] -> [BindingDescription]
forall a. a -> a
id) ([BindingDescription] -> (Int, [BindingDescription]))
-> ([BindingDescription] -> [BindingDescription])
-> [BindingDescription]
-> (Int, [BindingDescription])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BindingDescription -> BindingDescription
VertexInput.bindingDescriptionToCore (BindingDescription -> BindingDescription)
-> [BindingDescription] -> [BindingDescription]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>))
			-> (Int
vbdc, [BindingDescription]
vbds),
	createInfoVertexAttributeDescriptions :: forall (mn :: Maybe (*)). CreateInfo mn -> [AttributeDescription]
createInfoVertexAttributeDescriptions =
		(([AttributeDescription] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([AttributeDescription] -> Int)
-> ([AttributeDescription] -> [AttributeDescription])
-> [AttributeDescription]
-> (Int, [AttributeDescription])
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')
&&& [AttributeDescription] -> [AttributeDescription]
forall a. a -> a
id) ([AttributeDescription] -> (Int, [AttributeDescription]))
-> ([AttributeDescription] -> [AttributeDescription])
-> [AttributeDescription]
-> (Int, [AttributeDescription])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AttributeDescription -> AttributeDescription
VertexInput.attributeDescriptionToCore (AttributeDescription -> AttributeDescription)
-> [AttributeDescription] -> [AttributeDescription]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>))
			-> (Int
vadc, [AttributeDescription]
vads) } Ptr CreateInfo -> 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') ->
	Int -> (Ptr BindingDescription -> IO a) -> IO a
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
vbdc \Ptr BindingDescription
pvbds ->
	Ptr BindingDescription -> [BindingDescription] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr BindingDescription
pvbds [BindingDescription]
vbds IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
	Int -> (Ptr AttributeDescription -> IO a) -> IO a
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
vadc \Ptr AttributeDescription
pvads ->
	Ptr AttributeDescription -> [AttributeDescription] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr AttributeDescription
pvads [AttributeDescription]
vads IO () -> IO a -> IO a
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,
		createInfoVertexBindingDescriptionCount :: Word32
C.createInfoVertexBindingDescriptionCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
vbdc,
		createInfoPVertexBindingDescriptions :: Ptr BindingDescription
C.createInfoPVertexBindingDescriptions = Ptr BindingDescription
pvbds,
		createInfoVertexAttributeDescriptionCount :: Word32
C.createInfoVertexAttributeDescriptionCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
vadc,
		createInfoPVertexAttributeDescriptions :: Ptr AttributeDescription
C.createInfoPVertexAttributeDescriptions = Ptr AttributeDescription
pvads } in
	CreateInfo -> (Ptr CreateInfo -> IO a) -> IO a
forall a b. Pokable a => a -> (Ptr a -> IO b) -> IO b
withPoked CreateInfo
ci Ptr CreateInfo -> IO a
f