{-# language CPP #-}
module Vulkan.Extensions.VK_NV_inherited_viewport_scissor ( PhysicalDeviceInheritedViewportScissorFeaturesNV(..)
, CommandBufferInheritanceViewportScissorInfoNV(..)
, NV_INHERITED_VIEWPORT_SCISSOR_SPEC_VERSION
, pattern NV_INHERITED_VIEWPORT_SCISSOR_SPEC_VERSION
, NV_INHERITED_VIEWPORT_SCISSOR_EXTENSION_NAME
, pattern NV_INHERITED_VIEWPORT_SCISSOR_EXTENSION_NAME
) where
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
import Data.String (IsString)
import Data.Typeable (Typeable)
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Vulkan.Core10.FundamentalTypes (bool32ToBool)
import Vulkan.Core10.FundamentalTypes (boolToBool32)
import Vulkan.Core10.FundamentalTypes (Bool32)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Pipeline (Viewport)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_COMMAND_BUFFER_INHERITANCE_VIEWPORT_SCISSOR_INFO_NV))
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_PHYSICAL_DEVICE_INHERITED_VIEWPORT_SCISSOR_FEATURES_NV))
data PhysicalDeviceInheritedViewportScissorFeaturesNV = PhysicalDeviceInheritedViewportScissorFeaturesNV
{
PhysicalDeviceInheritedViewportScissorFeaturesNV -> Bool
inheritedViewportScissor2D :: Bool }
deriving (Typeable, PhysicalDeviceInheritedViewportScissorFeaturesNV
-> PhysicalDeviceInheritedViewportScissorFeaturesNV -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalDeviceInheritedViewportScissorFeaturesNV
-> PhysicalDeviceInheritedViewportScissorFeaturesNV -> Bool
$c/= :: PhysicalDeviceInheritedViewportScissorFeaturesNV
-> PhysicalDeviceInheritedViewportScissorFeaturesNV -> Bool
== :: PhysicalDeviceInheritedViewportScissorFeaturesNV
-> PhysicalDeviceInheritedViewportScissorFeaturesNV -> Bool
$c== :: PhysicalDeviceInheritedViewportScissorFeaturesNV
-> PhysicalDeviceInheritedViewportScissorFeaturesNV -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (PhysicalDeviceInheritedViewportScissorFeaturesNV)
#endif
deriving instance Show PhysicalDeviceInheritedViewportScissorFeaturesNV
instance ToCStruct PhysicalDeviceInheritedViewportScissorFeaturesNV where
withCStruct :: forall b.
PhysicalDeviceInheritedViewportScissorFeaturesNV
-> (Ptr PhysicalDeviceInheritedViewportScissorFeaturesNV -> IO b)
-> IO b
withCStruct PhysicalDeviceInheritedViewportScissorFeaturesNV
x Ptr PhysicalDeviceInheritedViewportScissorFeaturesNV -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
24 forall a b. (a -> b) -> a -> b
$ \Ptr PhysicalDeviceInheritedViewportScissorFeaturesNV
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceInheritedViewportScissorFeaturesNV
p PhysicalDeviceInheritedViewportScissorFeaturesNV
x (Ptr PhysicalDeviceInheritedViewportScissorFeaturesNV -> IO b
f Ptr PhysicalDeviceInheritedViewportScissorFeaturesNV
p)
pokeCStruct :: forall b.
Ptr PhysicalDeviceInheritedViewportScissorFeaturesNV
-> PhysicalDeviceInheritedViewportScissorFeaturesNV -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceInheritedViewportScissorFeaturesNV
p PhysicalDeviceInheritedViewportScissorFeaturesNV{Bool
inheritedViewportScissor2D :: Bool
$sel:inheritedViewportScissor2D:PhysicalDeviceInheritedViewportScissorFeaturesNV :: PhysicalDeviceInheritedViewportScissorFeaturesNV -> Bool
..} IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceInheritedViewportScissorFeaturesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_INHERITED_VIEWPORT_SCISSOR_FEATURES_NV)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceInheritedViewportScissorFeaturesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceInheritedViewportScissorFeaturesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
inheritedViewportScissor2D))
IO b
f
cStructSize :: Int
cStructSize = Int
24
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
Ptr PhysicalDeviceInheritedViewportScissorFeaturesNV
-> IO b -> IO b
pokeZeroCStruct Ptr PhysicalDeviceInheritedViewportScissorFeaturesNV
p IO b
f = do
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceInheritedViewportScissorFeaturesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_PHYSICAL_DEVICE_INHERITED_VIEWPORT_SCISSOR_FEATURES_NV)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceInheritedViewportScissorFeaturesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr PhysicalDeviceInheritedViewportScissorFeaturesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
IO b
f
instance FromCStruct PhysicalDeviceInheritedViewportScissorFeaturesNV where
peekCStruct :: Ptr PhysicalDeviceInheritedViewportScissorFeaturesNV
-> IO PhysicalDeviceInheritedViewportScissorFeaturesNV
peekCStruct Ptr PhysicalDeviceInheritedViewportScissorFeaturesNV
p = do
Bool32
inheritedViewportScissor2D <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr PhysicalDeviceInheritedViewportScissorFeaturesNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> PhysicalDeviceInheritedViewportScissorFeaturesNV
PhysicalDeviceInheritedViewportScissorFeaturesNV
(Bool32 -> Bool
bool32ToBool Bool32
inheritedViewportScissor2D)
instance Storable PhysicalDeviceInheritedViewportScissorFeaturesNV where
sizeOf :: PhysicalDeviceInheritedViewportScissorFeaturesNV -> Int
sizeOf ~PhysicalDeviceInheritedViewportScissorFeaturesNV
_ = Int
24
alignment :: PhysicalDeviceInheritedViewportScissorFeaturesNV -> Int
alignment ~PhysicalDeviceInheritedViewportScissorFeaturesNV
_ = Int
8
peek :: Ptr PhysicalDeviceInheritedViewportScissorFeaturesNV
-> IO PhysicalDeviceInheritedViewportScissorFeaturesNV
peek = forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
poke :: Ptr PhysicalDeviceInheritedViewportScissorFeaturesNV
-> PhysicalDeviceInheritedViewportScissorFeaturesNV -> IO ()
poke Ptr PhysicalDeviceInheritedViewportScissorFeaturesNV
ptr PhysicalDeviceInheritedViewportScissorFeaturesNV
poked = forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr PhysicalDeviceInheritedViewportScissorFeaturesNV
ptr PhysicalDeviceInheritedViewportScissorFeaturesNV
poked (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
instance Zero PhysicalDeviceInheritedViewportScissorFeaturesNV where
zero :: PhysicalDeviceInheritedViewportScissorFeaturesNV
zero = Bool -> PhysicalDeviceInheritedViewportScissorFeaturesNV
PhysicalDeviceInheritedViewportScissorFeaturesNV
forall a. Zero a => a
zero
data CommandBufferInheritanceViewportScissorInfoNV = CommandBufferInheritanceViewportScissorInfoNV
{
CommandBufferInheritanceViewportScissorInfoNV -> Bool
viewportScissor2D :: Bool
,
CommandBufferInheritanceViewportScissorInfoNV -> Word32
viewportDepthCount :: Word32
,
CommandBufferInheritanceViewportScissorInfoNV -> Viewport
viewportDepths :: Viewport
}
deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (CommandBufferInheritanceViewportScissorInfoNV)
#endif
deriving instance Show CommandBufferInheritanceViewportScissorInfoNV
instance ToCStruct CommandBufferInheritanceViewportScissorInfoNV where
withCStruct :: forall b.
CommandBufferInheritanceViewportScissorInfoNV
-> (Ptr CommandBufferInheritanceViewportScissorInfoNV -> IO b)
-> IO b
withCStruct CommandBufferInheritanceViewportScissorInfoNV
x Ptr CommandBufferInheritanceViewportScissorInfoNV -> IO b
f = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 forall a b. (a -> b) -> a -> b
$ \Ptr CommandBufferInheritanceViewportScissorInfoNV
p -> forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr CommandBufferInheritanceViewportScissorInfoNV
p CommandBufferInheritanceViewportScissorInfoNV
x (Ptr CommandBufferInheritanceViewportScissorInfoNV -> IO b
f Ptr CommandBufferInheritanceViewportScissorInfoNV
p)
pokeCStruct :: forall b.
Ptr CommandBufferInheritanceViewportScissorInfoNV
-> CommandBufferInheritanceViewportScissorInfoNV -> IO b -> IO b
pokeCStruct Ptr CommandBufferInheritanceViewportScissorInfoNV
p CommandBufferInheritanceViewportScissorInfoNV{Bool
Word32
Viewport
viewportDepths :: Viewport
viewportDepthCount :: Word32
viewportScissor2D :: Bool
$sel:viewportDepths:CommandBufferInheritanceViewportScissorInfoNV :: CommandBufferInheritanceViewportScissorInfoNV -> Viewport
$sel:viewportDepthCount:CommandBufferInheritanceViewportScissorInfoNV :: CommandBufferInheritanceViewportScissorInfoNV -> Word32
$sel:viewportScissor2D:CommandBufferInheritanceViewportScissorInfoNV :: CommandBufferInheritanceViewportScissorInfoNV -> Bool
..} IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CommandBufferInheritanceViewportScissorInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COMMAND_BUFFER_INHERITANCE_VIEWPORT_SCISSOR_INFO_NV)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CommandBufferInheritanceViewportScissorInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CommandBufferInheritanceViewportScissorInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
viewportScissor2D))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CommandBufferInheritanceViewportScissorInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) (Word32
viewportDepthCount)
Ptr Viewport
pViewportDepths'' <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (Viewport
viewportDepths)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CommandBufferInheritanceViewportScissorInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr Viewport))) Ptr Viewport
pViewportDepths''
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f
cStructSize :: Int
cStructSize = Int
32
cStructAlignment :: Int
cStructAlignment = Int
8
pokeZeroCStruct :: forall b.
Ptr CommandBufferInheritanceViewportScissorInfoNV -> IO b -> IO b
pokeZeroCStruct Ptr CommandBufferInheritanceViewportScissorInfoNV
p IO b
f = forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT forall a b. (a -> b) -> a -> b
$ do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CommandBufferInheritanceViewportScissorInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_COMMAND_BUFFER_INHERITANCE_VIEWPORT_SCISSOR_INFO_NV)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CommandBufferInheritanceViewportScissorInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (forall a. Ptr a
nullPtr)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CommandBufferInheritanceViewportScissorInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (forall a. Zero a => a
zero))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CommandBufferInheritanceViewportScissorInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32)) (forall a. Zero a => a
zero)
Ptr Viewport
pViewportDepths'' <- forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (forall a. Zero a => a
zero)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr CommandBufferInheritanceViewportScissorInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr Viewport))) Ptr Viewport
pViewportDepths''
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ IO b
f
instance FromCStruct CommandBufferInheritanceViewportScissorInfoNV where
peekCStruct :: Ptr CommandBufferInheritanceViewportScissorInfoNV
-> IO CommandBufferInheritanceViewportScissorInfoNV
peekCStruct Ptr CommandBufferInheritanceViewportScissorInfoNV
p = do
Bool32
viewportScissor2D <- forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr CommandBufferInheritanceViewportScissorInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr Bool32))
Word32
viewportDepthCount <- forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr CommandBufferInheritanceViewportScissorInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
20 :: Ptr Word32))
Viewport
pViewportDepths <- forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Viewport forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Storable a => Ptr a -> IO a
peek ((Ptr CommandBufferInheritanceViewportScissorInfoNV
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr (Ptr Viewport)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool
-> Word32
-> Viewport
-> CommandBufferInheritanceViewportScissorInfoNV
CommandBufferInheritanceViewportScissorInfoNV
(Bool32 -> Bool
bool32ToBool Bool32
viewportScissor2D) Word32
viewportDepthCount Viewport
pViewportDepths
instance Zero CommandBufferInheritanceViewportScissorInfoNV where
zero :: CommandBufferInheritanceViewportScissorInfoNV
zero = Bool
-> Word32
-> Viewport
-> CommandBufferInheritanceViewportScissorInfoNV
CommandBufferInheritanceViewportScissorInfoNV
forall a. Zero a => a
zero
forall a. Zero a => a
zero
forall a. Zero a => a
zero
type NV_INHERITED_VIEWPORT_SCISSOR_SPEC_VERSION = 1
pattern NV_INHERITED_VIEWPORT_SCISSOR_SPEC_VERSION :: forall a . Integral a => a
pattern $bNV_INHERITED_VIEWPORT_SCISSOR_SPEC_VERSION :: forall a. Integral a => a
$mNV_INHERITED_VIEWPORT_SCISSOR_SPEC_VERSION :: forall {r} {a}.
Integral a =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
NV_INHERITED_VIEWPORT_SCISSOR_SPEC_VERSION = 1
type NV_INHERITED_VIEWPORT_SCISSOR_EXTENSION_NAME = "VK_NV_inherited_viewport_scissor"
pattern NV_INHERITED_VIEWPORT_SCISSOR_EXTENSION_NAME :: forall a . (Eq a, IsString a) => a
pattern $bNV_INHERITED_VIEWPORT_SCISSOR_EXTENSION_NAME :: forall a. (Eq a, IsString a) => a
$mNV_INHERITED_VIEWPORT_SCISSOR_EXTENSION_NAME :: forall {r} {a}.
(Eq a, IsString a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
NV_INHERITED_VIEWPORT_SCISSOR_EXTENSION_NAME = "VK_NV_inherited_viewport_scissor"