{-# LINE 1 "src/Gpu/Vulkan/Pipeline/DepthStencilState/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.DepthStencilState.Middle.Internal (
	CreateInfo(..), CreateFlags(..), createInfoToCore
	) where

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

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

import qualified Gpu.Vulkan.Pipeline.DepthStencilState.Core as C



enum "CreateFlags" ''Word32
{-# LINE 31 "src/Gpu/Vulkan/Pipeline/DepthStencilState/Middle/Internal.hsc" #-}
	[''Show, ''Storable, ''Eq, ''Bits] [("CreateFlagsZero", 0)]

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 -> Bool
createInfoDepthTestEnable :: Bool,
	forall (mn :: Maybe (*)). CreateInfo mn -> Bool
createInfoDepthWriteEnable :: Bool,
	forall (mn :: Maybe (*)). CreateInfo mn -> CompareOp
createInfoDepthCompareOp :: CompareOp,
	forall (mn :: Maybe (*)). CreateInfo mn -> Bool
createInfoDepthBoundsTestEnable :: Bool,
	forall (mn :: Maybe (*)). CreateInfo mn -> Bool
createInfoStencilTestEnable :: Bool,
	forall (mn :: Maybe (*)). CreateInfo mn -> StencilOpState
createInfoFront :: StencilOpState,
	forall (mn :: Maybe (*)). CreateInfo mn -> StencilOpState
createInfoBack :: StencilOpState,
	forall (mn :: Maybe (*)). CreateInfo mn -> Float
createInfoMinDepthBounds :: Float,
	forall (mn :: Maybe (*)). CreateInfo mn -> Float
createInfoMaxDepthBounds :: Float }

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,
	createInfoDepthTestEnable :: forall (mn :: Maybe (*)). CreateInfo mn -> Bool
createInfoDepthTestEnable = Bool -> Word32
boolToBool32 -> Word32
dte,
	createInfoDepthWriteEnable :: forall (mn :: Maybe (*)). CreateInfo mn -> Bool
createInfoDepthWriteEnable = Bool -> Word32
boolToBool32 -> Word32
dwe,
	createInfoDepthCompareOp :: forall (mn :: Maybe (*)). CreateInfo mn -> CompareOp
createInfoDepthCompareOp = CompareOp Word32
dco,
	createInfoDepthBoundsTestEnable :: forall (mn :: Maybe (*)). CreateInfo mn -> Bool
createInfoDepthBoundsTestEnable = Bool -> Word32
boolToBool32 -> Word32
bte,
	createInfoStencilTestEnable :: forall (mn :: Maybe (*)). CreateInfo mn -> Bool
createInfoStencilTestEnable = Bool -> Word32
boolToBool32 -> Word32
ste,
	createInfoFront :: forall (mn :: Maybe (*)). CreateInfo mn -> StencilOpState
createInfoFront = StencilOpState -> StencilOpState
stencilOpStateToCore -> StencilOpState
fr,
	createInfoBack :: forall (mn :: Maybe (*)). CreateInfo mn -> StencilOpState
createInfoBack = StencilOpState -> StencilOpState
stencilOpStateToCore -> StencilOpState
bk,
	createInfoMinDepthBounds :: forall (mn :: Maybe (*)). CreateInfo mn -> Float
createInfoMinDepthBounds = Float
mndb,
	createInfoMaxDepthBounds :: forall (mn :: Maybe (*)). CreateInfo mn -> Float
createInfoMaxDepthBounds = Float
mxdb } 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') ->
	let	ci :: CreateInfo
ci = C.CreateInfo {
			createInfoSType :: ()
C.createInfoSType = (),
			createInfoPNext :: Ptr ()
C.createInfoPNext = Ptr ()
pnxt',
			createInfoFlags :: Word32
C.createInfoFlags = Word32
flgs,
			createInfoDepthTestEnable :: Word32
C.createInfoDepthTestEnable = Word32
dte,
			createInfoDepthWriteEnable :: Word32
C.createInfoDepthWriteEnable = Word32
dwe,
			createInfoDepthCompareOp :: Word32
C.createInfoDepthCompareOp = Word32
dco,
			createInfoDepthBoundsTestEnable :: Word32
C.createInfoDepthBoundsTestEnable = Word32
bte,
			createInfoStencilTestEnable :: Word32
C.createInfoStencilTestEnable = Word32
ste,
			createInfoFront :: StencilOpState
C.createInfoFront = StencilOpState
fr,
			createInfoBack :: StencilOpState
C.createInfoBack = StencilOpState
bk,
			createInfoMinDepthBounds :: Float
C.createInfoMinDepthBounds = Float
mndb,
			createInfoMaxDepthBounds :: Float
C.createInfoMaxDepthBounds = Float
mxdb } 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