{-# LINE 1 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}


{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MagicHash             #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Strict                #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
module Graphics.Vulkan.Types.Struct.IndirectCommands
       (VkIndirectCommandsLayoutCreateInfoNVX(..),
        VkIndirectCommandsLayoutTokenNVX(..),
        VkIndirectCommandsTokenNVX(..))
       where
import           Foreign.Storable                            (Storable (..))
import           GHC.Base                                    (Addr#, ByteArray#,
                                                              byteArrayContents#,
                                                              plusAddr#)
import           Graphics.Vulkan.Marshal
import           Graphics.Vulkan.Marshal.Internal
import           Graphics.Vulkan.Types.BaseTypes             (VkDeviceSize)
import           Graphics.Vulkan.Types.Enum.IndirectCommands (VkIndirectCommandsLayoutUsageFlagsNVX,
                                                              VkIndirectCommandsTokenTypeNVX)
import           Graphics.Vulkan.Types.Enum.Pipeline         (VkPipelineBindPoint)
import           Graphics.Vulkan.Types.Enum.StructureType    (VkStructureType)
import           Graphics.Vulkan.Types.Handles               (VkBuffer)
import           System.IO.Unsafe                            (unsafeDupablePerformIO)

-- | > typedef struct VkIndirectCommandsLayoutCreateInfoNVX {
--   >     VkStructureType sType;
--   >     const void*                      pNext;
--   >     VkPipelineBindPoint                      pipelineBindPoint;
--   >     VkIndirectCommandsLayoutUsageFlagsNVX    flags;
--   >     uint32_t                                 tokenCount;
--   >     const VkIndirectCommandsLayoutTokenNVX*  pTokens;
--   > } VkIndirectCommandsLayoutCreateInfoNVX;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkIndirectCommandsLayoutCreateInfoNVX VkIndirectCommandsLayoutCreateInfoNVX registry at www.khronos.org>
data VkIndirectCommandsLayoutCreateInfoNVX = VkIndirectCommandsLayoutCreateInfoNVX# Addr#
                                                                                    ByteArray#

instance Eq VkIndirectCommandsLayoutCreateInfoNVX where
        (VkIndirectCommandsLayoutCreateInfoNVX# Addr#
a ByteArray#
_) == :: VkIndirectCommandsLayoutCreateInfoNVX
-> VkIndirectCommandsLayoutCreateInfoNVX -> Bool
==
          x :: VkIndirectCommandsLayoutCreateInfoNVX
x@(VkIndirectCommandsLayoutCreateInfoNVX# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkIndirectCommandsLayoutCreateInfoNVX -> Int
forall a. Storable a => a -> Int
sizeOf VkIndirectCommandsLayoutCreateInfoNVX
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkIndirectCommandsLayoutCreateInfoNVX where
        (VkIndirectCommandsLayoutCreateInfoNVX# Addr#
a ByteArray#
_) compare :: VkIndirectCommandsLayoutCreateInfoNVX
-> VkIndirectCommandsLayoutCreateInfoNVX -> Ordering
`compare`
          x :: VkIndirectCommandsLayoutCreateInfoNVX
x@(VkIndirectCommandsLayoutCreateInfoNVX# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkIndirectCommandsLayoutCreateInfoNVX -> Int
forall a. Storable a => a -> Int
sizeOf VkIndirectCommandsLayoutCreateInfoNVX
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

instance Storable VkIndirectCommandsLayoutCreateInfoNVX where
        sizeOf :: VkIndirectCommandsLayoutCreateInfoNVX -> Int
sizeOf ~VkIndirectCommandsLayoutCreateInfoNVX
_
          = (Int
40)
{-# LINE 59 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment :: VkIndirectCommandsLayoutCreateInfoNVX -> Int
alignment ~VkIndirectCommandsLayoutCreateInfoNVX
_
          = Int
8
{-# LINE 63 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

        {-# INLINE alignment #-}
        peek :: Ptr VkIndirectCommandsLayoutCreateInfoNVX
-> IO VkIndirectCommandsLayoutCreateInfoNVX
peek = Ptr VkIndirectCommandsLayoutCreateInfoNVX
-> IO VkIndirectCommandsLayoutCreateInfoNVX
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkIndirectCommandsLayoutCreateInfoNVX
-> VkIndirectCommandsLayoutCreateInfoNVX -> IO ()
poke = Ptr VkIndirectCommandsLayoutCreateInfoNVX
-> VkIndirectCommandsLayoutCreateInfoNVX -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkIndirectCommandsLayoutCreateInfoNVX
         where
        unsafeAddr :: VkIndirectCommandsLayoutCreateInfoNVX -> Addr#
unsafeAddr (VkIndirectCommandsLayoutCreateInfoNVX# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkIndirectCommandsLayoutCreateInfoNVX -> ByteArray#
unsafeByteArray (VkIndirectCommandsLayoutCreateInfoNVX# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkIndirectCommandsLayoutCreateInfoNVX
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkIndirectCommandsLayoutCreateInfoNVX
VkIndirectCommandsLayoutCreateInfoNVX#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkIndirectCommandsLayoutCreateInfoNVX where
        type StructFields VkIndirectCommandsLayoutCreateInfoNVX =
             '["sType", "pNext", "pipelineBindPoint", "flags", "tokenCount", -- ' closing tick for hsc2hs
               "pTokens"]
        type CUnionType VkIndirectCommandsLayoutCreateInfoNVX = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkIndirectCommandsLayoutCreateInfoNVX = 'False -- ' closing tick for hsc2hs
        type StructExtends VkIndirectCommandsLayoutCreateInfoNVX = '[] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "sType" VkIndirectCommandsLayoutCreateInfoNVX where
        type FieldType "sType" VkIndirectCommandsLayoutCreateInfoNVX =
             VkStructureType
        type FieldOptional "sType" VkIndirectCommandsLayoutCreateInfoNVX =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "sType" VkIndirectCommandsLayoutCreateInfoNVX =
             (0)
{-# LINE 103 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}
        type FieldIsArray "sType" VkIndirectCommandsLayoutCreateInfoNVX =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
0)
{-# LINE 112 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "sType" VkIndirectCommandsLayoutCreateInfoNVX where
        {-# NOINLINE getField #-}
        getField :: VkIndirectCommandsLayoutCreateInfoNVX
-> FieldType "sType" VkIndirectCommandsLayoutCreateInfoNVX
getField VkIndirectCommandsLayoutCreateInfoNVX
x
          = IO VkStructureType -> VkStructureType
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkIndirectCommandsLayoutCreateInfoNVX
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkIndirectCommandsLayoutCreateInfoNVX
-> Ptr VkIndirectCommandsLayoutCreateInfoNVX
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkIndirectCommandsLayoutCreateInfoNVX
x) (Int
0))
{-# LINE 119 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkIndirectCommandsLayoutCreateInfoNVX
-> IO (FieldType "sType" VkIndirectCommandsLayoutCreateInfoNVX)
readField Ptr VkIndirectCommandsLayoutCreateInfoNVX
p
          = Ptr VkIndirectCommandsLayoutCreateInfoNVX
-> Int -> IO VkStructureType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkIndirectCommandsLayoutCreateInfoNVX
p (Int
0)
{-# LINE 123 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "sType" VkIndirectCommandsLayoutCreateInfoNVX where
        {-# INLINE writeField #-}
        writeField :: Ptr VkIndirectCommandsLayoutCreateInfoNVX
-> FieldType "sType" VkIndirectCommandsLayoutCreateInfoNVX -> IO ()
writeField Ptr VkIndirectCommandsLayoutCreateInfoNVX
p
          = Ptr VkIndirectCommandsLayoutCreateInfoNVX
-> Int -> VkStructureType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkIndirectCommandsLayoutCreateInfoNVX
p (Int
0)
{-# LINE 129 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pNext" VkIndirectCommandsLayoutCreateInfoNVX where
        type FieldType "pNext" VkIndirectCommandsLayoutCreateInfoNVX =
             Ptr Void
        type FieldOptional "pNext" VkIndirectCommandsLayoutCreateInfoNVX =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "pNext" VkIndirectCommandsLayoutCreateInfoNVX =
             (8)
{-# LINE 138 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}
        type FieldIsArray "pNext" VkIndirectCommandsLayoutCreateInfoNVX =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
8)
{-# LINE 147 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pNext" VkIndirectCommandsLayoutCreateInfoNVX where
        {-# NOINLINE getField #-}
        getField :: VkIndirectCommandsLayoutCreateInfoNVX
-> FieldType "pNext" VkIndirectCommandsLayoutCreateInfoNVX
getField VkIndirectCommandsLayoutCreateInfoNVX
x
          = IO (Ptr Void) -> Ptr Void
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkIndirectCommandsLayoutCreateInfoNVX -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkIndirectCommandsLayoutCreateInfoNVX
-> Ptr VkIndirectCommandsLayoutCreateInfoNVX
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkIndirectCommandsLayoutCreateInfoNVX
x) (Int
8))
{-# LINE 154 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkIndirectCommandsLayoutCreateInfoNVX
-> IO (FieldType "pNext" VkIndirectCommandsLayoutCreateInfoNVX)
readField Ptr VkIndirectCommandsLayoutCreateInfoNVX
p
          = Ptr VkIndirectCommandsLayoutCreateInfoNVX -> Int -> IO (Ptr Void)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkIndirectCommandsLayoutCreateInfoNVX
p (Int
8)
{-# LINE 158 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pNext" VkIndirectCommandsLayoutCreateInfoNVX where
        {-# INLINE writeField #-}
        writeField :: Ptr VkIndirectCommandsLayoutCreateInfoNVX
-> FieldType "pNext" VkIndirectCommandsLayoutCreateInfoNVX -> IO ()
writeField Ptr VkIndirectCommandsLayoutCreateInfoNVX
p
          = Ptr VkIndirectCommandsLayoutCreateInfoNVX
-> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkIndirectCommandsLayoutCreateInfoNVX
p (Int
8)
{-# LINE 164 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pipelineBindPoint" VkIndirectCommandsLayoutCreateInfoNVX
         where
        type FieldType "pipelineBindPoint"
               VkIndirectCommandsLayoutCreateInfoNVX
             = VkPipelineBindPoint
        type FieldOptional "pipelineBindPoint"
               VkIndirectCommandsLayoutCreateInfoNVX
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pipelineBindPoint"
               VkIndirectCommandsLayoutCreateInfoNVX
             =
             (16)
{-# LINE 178 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}
        type FieldIsArray "pipelineBindPoint"
               VkIndirectCommandsLayoutCreateInfoNVX
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
16)
{-# LINE 188 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pipelineBindPoint"
           VkIndirectCommandsLayoutCreateInfoNVX
         where
        {-# NOINLINE getField #-}
        getField :: VkIndirectCommandsLayoutCreateInfoNVX
-> FieldType
     "pipelineBindPoint" VkIndirectCommandsLayoutCreateInfoNVX
getField VkIndirectCommandsLayoutCreateInfoNVX
x
          = IO VkPipelineBindPoint -> VkPipelineBindPoint
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkIndirectCommandsLayoutCreateInfoNVX
-> Int -> IO VkPipelineBindPoint
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkIndirectCommandsLayoutCreateInfoNVX
-> Ptr VkIndirectCommandsLayoutCreateInfoNVX
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkIndirectCommandsLayoutCreateInfoNVX
x) (Int
16))
{-# LINE 197 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkIndirectCommandsLayoutCreateInfoNVX
-> IO
     (FieldType
        "pipelineBindPoint" VkIndirectCommandsLayoutCreateInfoNVX)
readField Ptr VkIndirectCommandsLayoutCreateInfoNVX
p
          = Ptr VkIndirectCommandsLayoutCreateInfoNVX
-> Int -> IO VkPipelineBindPoint
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkIndirectCommandsLayoutCreateInfoNVX
p (Int
16)
{-# LINE 201 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pipelineBindPoint"
           VkIndirectCommandsLayoutCreateInfoNVX
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkIndirectCommandsLayoutCreateInfoNVX
-> FieldType
     "pipelineBindPoint" VkIndirectCommandsLayoutCreateInfoNVX
-> IO ()
writeField Ptr VkIndirectCommandsLayoutCreateInfoNVX
p
          = Ptr VkIndirectCommandsLayoutCreateInfoNVX
-> Int -> VkPipelineBindPoint -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkIndirectCommandsLayoutCreateInfoNVX
p (Int
16)
{-# LINE 209 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "flags" VkIndirectCommandsLayoutCreateInfoNVX where
        type FieldType "flags" VkIndirectCommandsLayoutCreateInfoNVX =
             VkIndirectCommandsLayoutUsageFlagsNVX
        type FieldOptional "flags" VkIndirectCommandsLayoutCreateInfoNVX =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "flags" VkIndirectCommandsLayoutCreateInfoNVX =
             (20)
{-# LINE 218 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}
        type FieldIsArray "flags" VkIndirectCommandsLayoutCreateInfoNVX =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
20)
{-# LINE 227 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "flags" VkIndirectCommandsLayoutCreateInfoNVX where
        {-# NOINLINE getField #-}
        getField :: VkIndirectCommandsLayoutCreateInfoNVX
-> FieldType "flags" VkIndirectCommandsLayoutCreateInfoNVX
getField VkIndirectCommandsLayoutCreateInfoNVX
x
          = IO VkIndirectCommandsLayoutUsageFlagsNVX
-> VkIndirectCommandsLayoutUsageFlagsNVX
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkIndirectCommandsLayoutCreateInfoNVX
-> Int -> IO VkIndirectCommandsLayoutUsageFlagsNVX
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkIndirectCommandsLayoutCreateInfoNVX
-> Ptr VkIndirectCommandsLayoutCreateInfoNVX
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkIndirectCommandsLayoutCreateInfoNVX
x) (Int
20))
{-# LINE 234 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkIndirectCommandsLayoutCreateInfoNVX
-> IO (FieldType "flags" VkIndirectCommandsLayoutCreateInfoNVX)
readField Ptr VkIndirectCommandsLayoutCreateInfoNVX
p
          = Ptr VkIndirectCommandsLayoutCreateInfoNVX
-> Int -> IO VkIndirectCommandsLayoutUsageFlagsNVX
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkIndirectCommandsLayoutCreateInfoNVX
p (Int
20)
{-# LINE 238 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "flags" VkIndirectCommandsLayoutCreateInfoNVX where
        {-# INLINE writeField #-}
        writeField :: Ptr VkIndirectCommandsLayoutCreateInfoNVX
-> FieldType "flags" VkIndirectCommandsLayoutCreateInfoNVX -> IO ()
writeField Ptr VkIndirectCommandsLayoutCreateInfoNVX
p
          = Ptr VkIndirectCommandsLayoutCreateInfoNVX
-> Int -> VkIndirectCommandsLayoutUsageFlagsNVX -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkIndirectCommandsLayoutCreateInfoNVX
p (Int
20)
{-# LINE 244 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "tokenCount" VkIndirectCommandsLayoutCreateInfoNVX where
        type FieldType "tokenCount" VkIndirectCommandsLayoutCreateInfoNVX =
             Word32
        type FieldOptional "tokenCount"
               VkIndirectCommandsLayoutCreateInfoNVX
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "tokenCount" VkIndirectCommandsLayoutCreateInfoNVX
             =
             (24)
{-# LINE 255 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}
        type FieldIsArray "tokenCount"
               VkIndirectCommandsLayoutCreateInfoNVX
             = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
24)
{-# LINE 265 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "tokenCount" VkIndirectCommandsLayoutCreateInfoNVX
         where
        {-# NOINLINE getField #-}
        getField :: VkIndirectCommandsLayoutCreateInfoNVX
-> FieldType "tokenCount" VkIndirectCommandsLayoutCreateInfoNVX
getField VkIndirectCommandsLayoutCreateInfoNVX
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkIndirectCommandsLayoutCreateInfoNVX -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkIndirectCommandsLayoutCreateInfoNVX
-> Ptr VkIndirectCommandsLayoutCreateInfoNVX
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkIndirectCommandsLayoutCreateInfoNVX
x) (Int
24))
{-# LINE 273 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkIndirectCommandsLayoutCreateInfoNVX
-> IO
     (FieldType "tokenCount" VkIndirectCommandsLayoutCreateInfoNVX)
readField Ptr VkIndirectCommandsLayoutCreateInfoNVX
p
          = Ptr VkIndirectCommandsLayoutCreateInfoNVX -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkIndirectCommandsLayoutCreateInfoNVX
p (Int
24)
{-# LINE 277 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "tokenCount" VkIndirectCommandsLayoutCreateInfoNVX
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkIndirectCommandsLayoutCreateInfoNVX
-> FieldType "tokenCount" VkIndirectCommandsLayoutCreateInfoNVX
-> IO ()
writeField Ptr VkIndirectCommandsLayoutCreateInfoNVX
p
          = Ptr VkIndirectCommandsLayoutCreateInfoNVX -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkIndirectCommandsLayoutCreateInfoNVX
p (Int
24)
{-# LINE 284 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "pTokens" VkIndirectCommandsLayoutCreateInfoNVX where
        type FieldType "pTokens" VkIndirectCommandsLayoutCreateInfoNVX =
             Ptr VkIndirectCommandsLayoutTokenNVX
        type FieldOptional "pTokens" VkIndirectCommandsLayoutCreateInfoNVX
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "pTokens" VkIndirectCommandsLayoutCreateInfoNVX =
             (32)
{-# LINE 293 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}
        type FieldIsArray "pTokens" VkIndirectCommandsLayoutCreateInfoNVX =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
32)
{-# LINE 302 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "pTokens" VkIndirectCommandsLayoutCreateInfoNVX where
        {-# NOINLINE getField #-}
        getField :: VkIndirectCommandsLayoutCreateInfoNVX
-> FieldType "pTokens" VkIndirectCommandsLayoutCreateInfoNVX
getField VkIndirectCommandsLayoutCreateInfoNVX
x
          = IO (Ptr VkIndirectCommandsLayoutTokenNVX)
-> Ptr VkIndirectCommandsLayoutTokenNVX
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkIndirectCommandsLayoutCreateInfoNVX
-> Int -> IO (Ptr VkIndirectCommandsLayoutTokenNVX)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkIndirectCommandsLayoutCreateInfoNVX
-> Ptr VkIndirectCommandsLayoutCreateInfoNVX
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkIndirectCommandsLayoutCreateInfoNVX
x) (Int
32))
{-# LINE 309 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkIndirectCommandsLayoutCreateInfoNVX
-> IO (FieldType "pTokens" VkIndirectCommandsLayoutCreateInfoNVX)
readField Ptr VkIndirectCommandsLayoutCreateInfoNVX
p
          = Ptr VkIndirectCommandsLayoutCreateInfoNVX
-> Int -> IO (Ptr VkIndirectCommandsLayoutTokenNVX)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkIndirectCommandsLayoutCreateInfoNVX
p (Int
32)
{-# LINE 313 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "pTokens" VkIndirectCommandsLayoutCreateInfoNVX where
        {-# INLINE writeField #-}
        writeField :: Ptr VkIndirectCommandsLayoutCreateInfoNVX
-> FieldType "pTokens" VkIndirectCommandsLayoutCreateInfoNVX
-> IO ()
writeField Ptr VkIndirectCommandsLayoutCreateInfoNVX
p
          = Ptr VkIndirectCommandsLayoutCreateInfoNVX
-> Int -> Ptr VkIndirectCommandsLayoutTokenNVX -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkIndirectCommandsLayoutCreateInfoNVX
p (Int
32)
{-# LINE 319 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance Show VkIndirectCommandsLayoutCreateInfoNVX where
        showsPrec :: Int -> VkIndirectCommandsLayoutCreateInfoNVX -> ShowS
showsPrec Int
d VkIndirectCommandsLayoutCreateInfoNVX
x
          = String -> ShowS
showString String
"VkIndirectCommandsLayoutCreateInfoNVX {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"sType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkStructureType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkIndirectCommandsLayoutCreateInfoNVX
-> FieldType "sType" VkIndirectCommandsLayoutCreateInfoNVX
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkIndirectCommandsLayoutCreateInfoNVX
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"pNext = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Ptr Void -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkIndirectCommandsLayoutCreateInfoNVX
-> FieldType "pNext" VkIndirectCommandsLayoutCreateInfoNVX
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkIndirectCommandsLayoutCreateInfoNVX
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"pipelineBindPoint = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkPipelineBindPoint -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkIndirectCommandsLayoutCreateInfoNVX
-> FieldType
     "pipelineBindPoint" VkIndirectCommandsLayoutCreateInfoNVX
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pipelineBindPoint" VkIndirectCommandsLayoutCreateInfoNVX
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                String -> ShowS
showString String
"flags = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  Int -> VkIndirectCommandsLayoutUsageFlagsNVX -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkIndirectCommandsLayoutCreateInfoNVX
-> FieldType "flags" VkIndirectCommandsLayoutCreateInfoNVX
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"flags" VkIndirectCommandsLayoutCreateInfoNVX
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                    String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                      String -> ShowS
showString String
"tokenCount = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                        Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkIndirectCommandsLayoutCreateInfoNVX
-> FieldType "tokenCount" VkIndirectCommandsLayoutCreateInfoNVX
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"tokenCount" VkIndirectCommandsLayoutCreateInfoNVX
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                          String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                            String -> ShowS
showString String
"pTokens = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                              Int -> Ptr VkIndirectCommandsLayoutTokenNVX -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkIndirectCommandsLayoutCreateInfoNVX
-> FieldType "pTokens" VkIndirectCommandsLayoutCreateInfoNVX
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pTokens" VkIndirectCommandsLayoutCreateInfoNVX
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | > typedef struct VkIndirectCommandsLayoutTokenNVX {
--   >     VkIndirectCommandsTokenTypeNVX      tokenType;
--   >     uint32_t                         bindingUnit;
--   >     uint32_t                         dynamicCount;
--   >     uint32_t                         divisor;
--   > } VkIndirectCommandsLayoutTokenNVX;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkIndirectCommandsLayoutTokenNVX VkIndirectCommandsLayoutTokenNVX registry at www.khronos.org>
data VkIndirectCommandsLayoutTokenNVX = VkIndirectCommandsLayoutTokenNVX# Addr#
                                                                          ByteArray#

instance Eq VkIndirectCommandsLayoutTokenNVX where
        (VkIndirectCommandsLayoutTokenNVX# Addr#
a ByteArray#
_) == :: VkIndirectCommandsLayoutTokenNVX
-> VkIndirectCommandsLayoutTokenNVX -> Bool
==
          x :: VkIndirectCommandsLayoutTokenNVX
x@(VkIndirectCommandsLayoutTokenNVX# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkIndirectCommandsLayoutTokenNVX -> Int
forall a. Storable a => a -> Int
sizeOf VkIndirectCommandsLayoutTokenNVX
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkIndirectCommandsLayoutTokenNVX where
        (VkIndirectCommandsLayoutTokenNVX# Addr#
a ByteArray#
_) compare :: VkIndirectCommandsLayoutTokenNVX
-> VkIndirectCommandsLayoutTokenNVX -> Ordering
`compare`
          x :: VkIndirectCommandsLayoutTokenNVX
x@(VkIndirectCommandsLayoutTokenNVX# Addr#
b ByteArray#
_)
          = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkIndirectCommandsLayoutTokenNVX -> Int
forall a. Storable a => a -> Int
sizeOf VkIndirectCommandsLayoutTokenNVX
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

instance Storable VkIndirectCommandsLayoutTokenNVX where
        sizeOf :: VkIndirectCommandsLayoutTokenNVX -> Int
sizeOf ~VkIndirectCommandsLayoutTokenNVX
_ = (Int
16)
{-# LINE 368 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment :: VkIndirectCommandsLayoutTokenNVX -> Int
alignment ~VkIndirectCommandsLayoutTokenNVX
_
          = Int
4
{-# LINE 372 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

        {-# INLINE alignment #-}
        peek :: Ptr VkIndirectCommandsLayoutTokenNVX
-> IO VkIndirectCommandsLayoutTokenNVX
peek = Ptr VkIndirectCommandsLayoutTokenNVX
-> IO VkIndirectCommandsLayoutTokenNVX
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkIndirectCommandsLayoutTokenNVX
-> VkIndirectCommandsLayoutTokenNVX -> IO ()
poke = Ptr VkIndirectCommandsLayoutTokenNVX
-> VkIndirectCommandsLayoutTokenNVX -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkIndirectCommandsLayoutTokenNVX where
        unsafeAddr :: VkIndirectCommandsLayoutTokenNVX -> Addr#
unsafeAddr (VkIndirectCommandsLayoutTokenNVX# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkIndirectCommandsLayoutTokenNVX -> ByteArray#
unsafeByteArray (VkIndirectCommandsLayoutTokenNVX# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkIndirectCommandsLayoutTokenNVX
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkIndirectCommandsLayoutTokenNVX
VkIndirectCommandsLayoutTokenNVX#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkIndirectCommandsLayoutTokenNVX where
        type StructFields VkIndirectCommandsLayoutTokenNVX =
             '["tokenType", "bindingUnit", "dynamicCount", "divisor"] -- ' closing tick for hsc2hs
        type CUnionType VkIndirectCommandsLayoutTokenNVX = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkIndirectCommandsLayoutTokenNVX = 'False -- ' closing tick for hsc2hs
        type StructExtends VkIndirectCommandsLayoutTokenNVX = '[] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "tokenType" VkIndirectCommandsLayoutTokenNVX where
        type FieldType "tokenType" VkIndirectCommandsLayoutTokenNVX =
             VkIndirectCommandsTokenTypeNVX
        type FieldOptional "tokenType" VkIndirectCommandsLayoutTokenNVX =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "tokenType" VkIndirectCommandsLayoutTokenNVX =
             (0)
{-# LINE 410 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}
        type FieldIsArray "tokenType" VkIndirectCommandsLayoutTokenNVX =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
0)
{-# LINE 419 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "tokenType" VkIndirectCommandsLayoutTokenNVX where
        {-# NOINLINE getField #-}
        getField :: VkIndirectCommandsLayoutTokenNVX
-> FieldType "tokenType" VkIndirectCommandsLayoutTokenNVX
getField VkIndirectCommandsLayoutTokenNVX
x
          = IO VkIndirectCommandsTokenTypeNVX -> VkIndirectCommandsTokenTypeNVX
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkIndirectCommandsLayoutTokenNVX
-> Int -> IO VkIndirectCommandsTokenTypeNVX
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkIndirectCommandsLayoutTokenNVX
-> Ptr VkIndirectCommandsLayoutTokenNVX
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkIndirectCommandsLayoutTokenNVX
x) (Int
0))
{-# LINE 426 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkIndirectCommandsLayoutTokenNVX
-> IO (FieldType "tokenType" VkIndirectCommandsLayoutTokenNVX)
readField Ptr VkIndirectCommandsLayoutTokenNVX
p
          = Ptr VkIndirectCommandsLayoutTokenNVX
-> Int -> IO VkIndirectCommandsTokenTypeNVX
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkIndirectCommandsLayoutTokenNVX
p (Int
0)
{-# LINE 430 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "tokenType" VkIndirectCommandsLayoutTokenNVX where
        {-# INLINE writeField #-}
        writeField :: Ptr VkIndirectCommandsLayoutTokenNVX
-> FieldType "tokenType" VkIndirectCommandsLayoutTokenNVX -> IO ()
writeField Ptr VkIndirectCommandsLayoutTokenNVX
p
          = Ptr VkIndirectCommandsLayoutTokenNVX
-> Int -> VkIndirectCommandsTokenTypeNVX -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkIndirectCommandsLayoutTokenNVX
p (Int
0)
{-# LINE 436 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "bindingUnit" VkIndirectCommandsLayoutTokenNVX where
        type FieldType "bindingUnit" VkIndirectCommandsLayoutTokenNVX =
             Word32
        type FieldOptional "bindingUnit" VkIndirectCommandsLayoutTokenNVX =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "bindingUnit" VkIndirectCommandsLayoutTokenNVX =
             (4)
{-# LINE 445 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}
        type FieldIsArray "bindingUnit" VkIndirectCommandsLayoutTokenNVX =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
4)
{-# LINE 454 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "bindingUnit" VkIndirectCommandsLayoutTokenNVX where
        {-# NOINLINE getField #-}
        getField :: VkIndirectCommandsLayoutTokenNVX
-> FieldType "bindingUnit" VkIndirectCommandsLayoutTokenNVX
getField VkIndirectCommandsLayoutTokenNVX
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkIndirectCommandsLayoutTokenNVX -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkIndirectCommandsLayoutTokenNVX
-> Ptr VkIndirectCommandsLayoutTokenNVX
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkIndirectCommandsLayoutTokenNVX
x) (Int
4))
{-# LINE 461 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkIndirectCommandsLayoutTokenNVX
-> IO (FieldType "bindingUnit" VkIndirectCommandsLayoutTokenNVX)
readField Ptr VkIndirectCommandsLayoutTokenNVX
p
          = Ptr VkIndirectCommandsLayoutTokenNVX -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkIndirectCommandsLayoutTokenNVX
p (Int
4)
{-# LINE 465 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "bindingUnit" VkIndirectCommandsLayoutTokenNVX where
        {-# INLINE writeField #-}
        writeField :: Ptr VkIndirectCommandsLayoutTokenNVX
-> FieldType "bindingUnit" VkIndirectCommandsLayoutTokenNVX
-> IO ()
writeField Ptr VkIndirectCommandsLayoutTokenNVX
p
          = Ptr VkIndirectCommandsLayoutTokenNVX -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkIndirectCommandsLayoutTokenNVX
p (Int
4)
{-# LINE 471 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "dynamicCount" VkIndirectCommandsLayoutTokenNVX where
        type FieldType "dynamicCount" VkIndirectCommandsLayoutTokenNVX =
             Word32
        type FieldOptional "dynamicCount" VkIndirectCommandsLayoutTokenNVX
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "dynamicCount" VkIndirectCommandsLayoutTokenNVX =
             (8)
{-# LINE 480 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}
        type FieldIsArray "dynamicCount" VkIndirectCommandsLayoutTokenNVX =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
8)
{-# LINE 489 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "dynamicCount" VkIndirectCommandsLayoutTokenNVX where
        {-# NOINLINE getField #-}
        getField :: VkIndirectCommandsLayoutTokenNVX
-> FieldType "dynamicCount" VkIndirectCommandsLayoutTokenNVX
getField VkIndirectCommandsLayoutTokenNVX
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkIndirectCommandsLayoutTokenNVX -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkIndirectCommandsLayoutTokenNVX
-> Ptr VkIndirectCommandsLayoutTokenNVX
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkIndirectCommandsLayoutTokenNVX
x) (Int
8))
{-# LINE 496 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkIndirectCommandsLayoutTokenNVX
-> IO (FieldType "dynamicCount" VkIndirectCommandsLayoutTokenNVX)
readField Ptr VkIndirectCommandsLayoutTokenNVX
p
          = Ptr VkIndirectCommandsLayoutTokenNVX -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkIndirectCommandsLayoutTokenNVX
p (Int
8)
{-# LINE 500 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "dynamicCount" VkIndirectCommandsLayoutTokenNVX where
        {-# INLINE writeField #-}
        writeField :: Ptr VkIndirectCommandsLayoutTokenNVX
-> FieldType "dynamicCount" VkIndirectCommandsLayoutTokenNVX
-> IO ()
writeField Ptr VkIndirectCommandsLayoutTokenNVX
p
          = Ptr VkIndirectCommandsLayoutTokenNVX -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkIndirectCommandsLayoutTokenNVX
p (Int
8)
{-# LINE 506 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "divisor" VkIndirectCommandsLayoutTokenNVX where
        type FieldType "divisor" VkIndirectCommandsLayoutTokenNVX = Word32
        type FieldOptional "divisor" VkIndirectCommandsLayoutTokenNVX =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "divisor" VkIndirectCommandsLayoutTokenNVX =
             (12)
{-# LINE 514 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}
        type FieldIsArray "divisor" VkIndirectCommandsLayoutTokenNVX =
             'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
12)
{-# LINE 523 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "divisor" VkIndirectCommandsLayoutTokenNVX where
        {-# NOINLINE getField #-}
        getField :: VkIndirectCommandsLayoutTokenNVX
-> FieldType "divisor" VkIndirectCommandsLayoutTokenNVX
getField VkIndirectCommandsLayoutTokenNVX
x
          = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkIndirectCommandsLayoutTokenNVX -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkIndirectCommandsLayoutTokenNVX
-> Ptr VkIndirectCommandsLayoutTokenNVX
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkIndirectCommandsLayoutTokenNVX
x) (Int
12))
{-# LINE 530 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkIndirectCommandsLayoutTokenNVX
-> IO (FieldType "divisor" VkIndirectCommandsLayoutTokenNVX)
readField Ptr VkIndirectCommandsLayoutTokenNVX
p
          = Ptr VkIndirectCommandsLayoutTokenNVX -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkIndirectCommandsLayoutTokenNVX
p (Int
12)
{-# LINE 534 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "divisor" VkIndirectCommandsLayoutTokenNVX where
        {-# INLINE writeField #-}
        writeField :: Ptr VkIndirectCommandsLayoutTokenNVX
-> FieldType "divisor" VkIndirectCommandsLayoutTokenNVX -> IO ()
writeField Ptr VkIndirectCommandsLayoutTokenNVX
p
          = Ptr VkIndirectCommandsLayoutTokenNVX -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkIndirectCommandsLayoutTokenNVX
p (Int
12)
{-# LINE 540 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance Show VkIndirectCommandsLayoutTokenNVX where
        showsPrec :: Int -> VkIndirectCommandsLayoutTokenNVX -> ShowS
showsPrec Int
d VkIndirectCommandsLayoutTokenNVX
x
          = String -> ShowS
showString String
"VkIndirectCommandsLayoutTokenNVX {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"tokenType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkIndirectCommandsTokenTypeNVX -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkIndirectCommandsLayoutTokenNVX
-> FieldType "tokenType" VkIndirectCommandsLayoutTokenNVX
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"tokenType" VkIndirectCommandsLayoutTokenNVX
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"bindingUnit = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkIndirectCommandsLayoutTokenNVX
-> FieldType "bindingUnit" VkIndirectCommandsLayoutTokenNVX
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"bindingUnit" VkIndirectCommandsLayoutTokenNVX
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"dynamicCount = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkIndirectCommandsLayoutTokenNVX
-> FieldType "dynamicCount" VkIndirectCommandsLayoutTokenNVX
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"dynamicCount" VkIndirectCommandsLayoutTokenNVX
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                String -> ShowS
showString String
"divisor = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkIndirectCommandsLayoutTokenNVX
-> FieldType "divisor" VkIndirectCommandsLayoutTokenNVX
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"divisor" VkIndirectCommandsLayoutTokenNVX
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | > typedef struct VkIndirectCommandsTokenNVX {
--   >     VkIndirectCommandsTokenTypeNVX      tokenType;
--   >     VkBuffer                         buffer;
--   >     VkDeviceSize                     offset;
--   > } VkIndirectCommandsTokenNVX;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkIndirectCommandsTokenNVX VkIndirectCommandsTokenNVX registry at www.khronos.org>
data VkIndirectCommandsTokenNVX = VkIndirectCommandsTokenNVX# Addr#
                                                              ByteArray#

instance Eq VkIndirectCommandsTokenNVX where
        (VkIndirectCommandsTokenNVX# Addr#
a ByteArray#
_) == :: VkIndirectCommandsTokenNVX -> VkIndirectCommandsTokenNVX -> Bool
==
          x :: VkIndirectCommandsTokenNVX
x@(VkIndirectCommandsTokenNVX# Addr#
b ByteArray#
_)
          = Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkIndirectCommandsTokenNVX -> Int
forall a. Storable a => a -> Int
sizeOf VkIndirectCommandsTokenNVX
x) Addr#
a Addr#
b

        {-# INLINE (==) #-}

instance Ord VkIndirectCommandsTokenNVX where
        (VkIndirectCommandsTokenNVX# Addr#
a ByteArray#
_) compare :: VkIndirectCommandsTokenNVX
-> VkIndirectCommandsTokenNVX -> Ordering
`compare`
          x :: VkIndirectCommandsTokenNVX
x@(VkIndirectCommandsTokenNVX# Addr#
b ByteArray#
_) = Int -> Addr# -> Addr# -> Ordering
cmpBytes# (VkIndirectCommandsTokenNVX -> Int
forall a. Storable a => a -> Int
sizeOf VkIndirectCommandsTokenNVX
x) Addr#
a Addr#
b

        {-# INLINE compare #-}

instance Storable VkIndirectCommandsTokenNVX where
        sizeOf :: VkIndirectCommandsTokenNVX -> Int
sizeOf ~VkIndirectCommandsTokenNVX
_ = (Int
24)
{-# LINE 581 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

        {-# INLINE sizeOf #-}
        alignment :: VkIndirectCommandsTokenNVX -> Int
alignment ~VkIndirectCommandsTokenNVX
_ = Int
8
{-# LINE 584 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

        {-# INLINE alignment #-}
        peek :: Ptr VkIndirectCommandsTokenNVX -> IO VkIndirectCommandsTokenNVX
peek = Ptr VkIndirectCommandsTokenNVX -> IO VkIndirectCommandsTokenNVX
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> IO a
peekVkData#

        {-# INLINE peek #-}
        poke :: Ptr VkIndirectCommandsTokenNVX
-> VkIndirectCommandsTokenNVX -> IO ()
poke = Ptr VkIndirectCommandsTokenNVX
-> VkIndirectCommandsTokenNVX -> IO ()
forall a. (Storable a, VulkanMarshalPrim a) => Ptr a -> a -> IO ()
pokeVkData#

        {-# INLINE poke #-}

instance VulkanMarshalPrim VkIndirectCommandsTokenNVX where
        unsafeAddr :: VkIndirectCommandsTokenNVX -> Addr#
unsafeAddr (VkIndirectCommandsTokenNVX# Addr#
a ByteArray#
_) = Addr#
a

        {-# INLINE unsafeAddr #-}
        unsafeByteArray :: VkIndirectCommandsTokenNVX -> ByteArray#
unsafeByteArray (VkIndirectCommandsTokenNVX# Addr#
_ ByteArray#
b) = ByteArray#
b

        {-# INLINE unsafeByteArray #-}
        unsafeFromByteArrayOffset :: Int# -> ByteArray# -> VkIndirectCommandsTokenNVX
unsafeFromByteArrayOffset Int#
off ByteArray#
b
          = Addr# -> ByteArray# -> VkIndirectCommandsTokenNVX
VkIndirectCommandsTokenNVX#
              (Addr# -> Int# -> Addr#
plusAddr# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
b) Int#
off)
              ByteArray#
b

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkIndirectCommandsTokenNVX where
        type StructFields VkIndirectCommandsTokenNVX =
             '["tokenType", "buffer", "offset"] -- ' closing tick for hsc2hs
        type CUnionType VkIndirectCommandsTokenNVX = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkIndirectCommandsTokenNVX = 'False -- ' closing tick for hsc2hs
        type StructExtends VkIndirectCommandsTokenNVX = '[] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "tokenType" VkIndirectCommandsTokenNVX where
        type FieldType "tokenType" VkIndirectCommandsTokenNVX =
             VkIndirectCommandsTokenTypeNVX
        type FieldOptional "tokenType" VkIndirectCommandsTokenNVX = 'False -- ' closing tick for hsc2hs
        type FieldOffset "tokenType" VkIndirectCommandsTokenNVX =
             (0)
{-# LINE 621 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}
        type FieldIsArray "tokenType" VkIndirectCommandsTokenNVX = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
0)
{-# LINE 629 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "tokenType" VkIndirectCommandsTokenNVX where
        {-# NOINLINE getField #-}
        getField :: VkIndirectCommandsTokenNVX
-> FieldType "tokenType" VkIndirectCommandsTokenNVX
getField VkIndirectCommandsTokenNVX
x
          = IO VkIndirectCommandsTokenTypeNVX -> VkIndirectCommandsTokenTypeNVX
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkIndirectCommandsTokenNVX
-> Int -> IO VkIndirectCommandsTokenTypeNVX
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkIndirectCommandsTokenNVX -> Ptr VkIndirectCommandsTokenNVX
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkIndirectCommandsTokenNVX
x) (Int
0))
{-# LINE 636 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkIndirectCommandsTokenNVX
-> IO (FieldType "tokenType" VkIndirectCommandsTokenNVX)
readField Ptr VkIndirectCommandsTokenNVX
p
          = Ptr VkIndirectCommandsTokenNVX
-> Int -> IO VkIndirectCommandsTokenTypeNVX
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkIndirectCommandsTokenNVX
p (Int
0)
{-# LINE 640 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "tokenType" VkIndirectCommandsTokenNVX where
        {-# INLINE writeField #-}
        writeField :: Ptr VkIndirectCommandsTokenNVX
-> FieldType "tokenType" VkIndirectCommandsTokenNVX -> IO ()
writeField Ptr VkIndirectCommandsTokenNVX
p
          = Ptr VkIndirectCommandsTokenNVX
-> Int -> VkIndirectCommandsTokenTypeNVX -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkIndirectCommandsTokenNVX
p (Int
0)
{-# LINE 646 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "buffer" VkIndirectCommandsTokenNVX where
        type FieldType "buffer" VkIndirectCommandsTokenNVX = VkBuffer
        type FieldOptional "buffer" VkIndirectCommandsTokenNVX = 'False -- ' closing tick for hsc2hs
        type FieldOffset "buffer" VkIndirectCommandsTokenNVX =
             (8)
{-# LINE 653 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}
        type FieldIsArray "buffer" VkIndirectCommandsTokenNVX = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
8)
{-# LINE 661 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "buffer" VkIndirectCommandsTokenNVX where
        {-# NOINLINE getField #-}
        getField :: VkIndirectCommandsTokenNVX
-> FieldType "buffer" VkIndirectCommandsTokenNVX
getField VkIndirectCommandsTokenNVX
x
          = IO VkBuffer -> VkBuffer
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkIndirectCommandsTokenNVX -> Int -> IO VkBuffer
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkIndirectCommandsTokenNVX -> Ptr VkIndirectCommandsTokenNVX
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkIndirectCommandsTokenNVX
x) (Int
8))
{-# LINE 668 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkIndirectCommandsTokenNVX
-> IO (FieldType "buffer" VkIndirectCommandsTokenNVX)
readField Ptr VkIndirectCommandsTokenNVX
p
          = Ptr VkIndirectCommandsTokenNVX -> Int -> IO VkBuffer
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkIndirectCommandsTokenNVX
p (Int
8)
{-# LINE 672 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "buffer" VkIndirectCommandsTokenNVX where
        {-# INLINE writeField #-}
        writeField :: Ptr VkIndirectCommandsTokenNVX
-> FieldType "buffer" VkIndirectCommandsTokenNVX -> IO ()
writeField Ptr VkIndirectCommandsTokenNVX
p
          = Ptr VkIndirectCommandsTokenNVX -> Int -> VkBuffer -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkIndirectCommandsTokenNVX
p (Int
8)
{-# LINE 678 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "offset" VkIndirectCommandsTokenNVX where
        type FieldType "offset" VkIndirectCommandsTokenNVX = VkDeviceSize
        type FieldOptional "offset" VkIndirectCommandsTokenNVX = 'False -- ' closing tick for hsc2hs
        type FieldOffset "offset" VkIndirectCommandsTokenNVX =
             (16)
{-# LINE 685 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}
        type FieldIsArray "offset" VkIndirectCommandsTokenNVX = 'False -- ' closing tick for hsc2hs

        {-# INLINE fieldOptional #-}
        fieldOptional :: Bool
fieldOptional = Bool
False

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
16)
{-# LINE 693 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "offset" VkIndirectCommandsTokenNVX where
        {-# NOINLINE getField #-}
        getField :: VkIndirectCommandsTokenNVX
-> FieldType "offset" VkIndirectCommandsTokenNVX
getField VkIndirectCommandsTokenNVX
x
          = IO VkDeviceSize -> VkDeviceSize
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkIndirectCommandsTokenNVX -> Int -> IO VkDeviceSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkIndirectCommandsTokenNVX -> Ptr VkIndirectCommandsTokenNVX
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkIndirectCommandsTokenNVX
x) (Int
16))
{-# LINE 700 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkIndirectCommandsTokenNVX
-> IO (FieldType "offset" VkIndirectCommandsTokenNVX)
readField Ptr VkIndirectCommandsTokenNVX
p
          = Ptr VkIndirectCommandsTokenNVX -> Int -> IO VkDeviceSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkIndirectCommandsTokenNVX
p (Int
16)
{-# LINE 704 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "offset" VkIndirectCommandsTokenNVX where
        {-# INLINE writeField #-}
        writeField :: Ptr VkIndirectCommandsTokenNVX
-> FieldType "offset" VkIndirectCommandsTokenNVX -> IO ()
writeField Ptr VkIndirectCommandsTokenNVX
p
          = Ptr VkIndirectCommandsTokenNVX -> Int -> VkDeviceSize -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkIndirectCommandsTokenNVX
p (Int
16)
{-# LINE 710 "src-gen/Graphics/Vulkan/Types/Struct/IndirectCommands.hsc" #-}

instance Show VkIndirectCommandsTokenNVX where
        showsPrec :: Int -> VkIndirectCommandsTokenNVX -> ShowS
showsPrec Int
d VkIndirectCommandsTokenNVX
x
          = String -> ShowS
showString String
"VkIndirectCommandsTokenNVX {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"tokenType = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkIndirectCommandsTokenTypeNVX -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkIndirectCommandsTokenNVX
-> FieldType "tokenType" VkIndirectCommandsTokenNVX
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"tokenType" VkIndirectCommandsTokenNVX
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    String -> ShowS
showString String
"buffer = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Int -> VkBuffer -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkIndirectCommandsTokenNVX
-> FieldType "buffer" VkIndirectCommandsTokenNVX
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"buffer" VkIndirectCommandsTokenNVX
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                          String -> ShowS
showString String
"offset = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkDeviceSize -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkIndirectCommandsTokenNVX
-> FieldType "offset" VkIndirectCommandsTokenNVX
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"offset" VkIndirectCommandsTokenNVX
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'