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


{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MagicHash             #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Strict                #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
module Graphics.Vulkan.Types.Struct.Sampler
       (VkSamplerCreateInfo(..), VkSamplerReductionModeCreateInfoEXT(..),
        VkSamplerYcbcrConversionCreateInfo(..),
        VkSamplerYcbcrConversionCreateInfoKHR,
        VkSamplerYcbcrConversionImageFormatProperties(..),
        VkSamplerYcbcrConversionImageFormatPropertiesKHR,
        VkSamplerYcbcrConversionInfo(..), VkSamplerYcbcrConversionInfoKHR)
       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               (VkBool32)
import           Graphics.Vulkan.Types.Bitmasks                (VkSamplerCreateFlags)
import           Graphics.Vulkan.Types.Enum.BorderColor        (VkBorderColor)
import           Graphics.Vulkan.Types.Enum.ChromaLocation     (VkChromaLocation)
import           Graphics.Vulkan.Types.Enum.CompareOp          (VkCompareOp)
import           Graphics.Vulkan.Types.Enum.Filter             (VkFilter)
import           Graphics.Vulkan.Types.Enum.Format             (VkFormat)
import           Graphics.Vulkan.Types.Enum.Sampler            (VkSamplerAddressMode,
                                                                VkSamplerMipmapMode,
                                                                VkSamplerReductionModeEXT,
                                                                VkSamplerYcbcrModelConversion,
                                                                VkSamplerYcbcrRange)
import           Graphics.Vulkan.Types.Enum.StructureType      (VkStructureType)
import           Graphics.Vulkan.Types.Handles                 (VkSamplerYcbcrConversion)
import           Graphics.Vulkan.Types.Struct.ComponentMapping (VkComponentMapping)
import           Graphics.Vulkan.Types.Struct.Image            (VkImageFormatProperties2,
                                                                VkImageViewCreateInfo)
import           System.IO.Unsafe                              (unsafeDupablePerformIO)

-- | > typedef struct VkSamplerCreateInfo {
--   >     VkStructureType sType;
--   >     const void*            pNext;
--   >     VkSamplerCreateFlags   flags;
--   >     VkFilter               magFilter;
--   >     VkFilter               minFilter;
--   >     VkSamplerMipmapMode    mipmapMode;
--   >     VkSamplerAddressMode   addressModeU;
--   >     VkSamplerAddressMode   addressModeV;
--   >     VkSamplerAddressMode   addressModeW;
--   >     float                  mipLodBias;
--   >     VkBool32               anisotropyEnable;
--   >     float                  maxAnisotropy;
--   >     VkBool32               compareEnable;
--   >     VkCompareOp            compareOp;
--   >     float                  minLod;
--   >     float                  maxLod;
--   >     VkBorderColor          borderColor;
--   >     VkBool32               unnormalizedCoordinates;
--   > } VkSamplerCreateInfo;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkSamplerCreateInfo VkSamplerCreateInfo registry at www.khronos.org>
data VkSamplerCreateInfo = VkSamplerCreateInfo# Addr# ByteArray#

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

instance Storable VkSamplerCreateInfo where
        sizeOf :: VkSamplerCreateInfo -> Int
sizeOf ~VkSamplerCreateInfo
_ = (Int
80)
{-# LINE 82 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

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

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkSamplerCreateInfo where
        type StructFields VkSamplerCreateInfo =
             '["sType", "pNext", "flags", "magFilter", "minFilter", -- ' closing tick for hsc2hs
               "mipmapMode", "addressModeU", "addressModeV", "addressModeW",
               "mipLodBias", "anisotropyEnable", "maxAnisotropy", "compareEnable",
               "compareOp", "minLod", "maxLod", "borderColor",
               "unnormalizedCoordinates"]
        type CUnionType VkSamplerCreateInfo = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkSamplerCreateInfo = 'False -- ' closing tick for hsc2hs
        type StructExtends VkSamplerCreateInfo = '[] -- ' closing tick for hsc2hs

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

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

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

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

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

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

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

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

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

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

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

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

instance {-# OVERLAPPING #-} HasField "flags" VkSamplerCreateInfo
         where
        type FieldType "flags" VkSamplerCreateInfo = VkSamplerCreateFlags
        type FieldOptional "flags" VkSamplerCreateInfo = 'True -- ' closing tick for hsc2hs
        type FieldOffset "flags" VkSamplerCreateInfo =
             (16)
{-# LINE 185 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}
        type FieldIsArray "flags" VkSamplerCreateInfo = 'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkSamplerCreateInfo
-> IO (FieldType "flags" VkSamplerCreateInfo)
readField Ptr VkSamplerCreateInfo
p
          = Ptr VkSamplerCreateInfo -> Int -> IO VkSamplerCreateFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSamplerCreateInfo
p (Int
16)
{-# LINE 203 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

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

instance {-# OVERLAPPING #-}
         HasField "magFilter" VkSamplerCreateInfo where
        type FieldType "magFilter" VkSamplerCreateInfo = VkFilter
        type FieldOptional "magFilter" VkSamplerCreateInfo = 'False -- ' closing tick for hsc2hs
        type FieldOffset "magFilter" VkSamplerCreateInfo =
             (20)
{-# LINE 216 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}
        type FieldIsArray "magFilter" VkSamplerCreateInfo = 'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkSamplerCreateInfo
-> IO (FieldType "magFilter" VkSamplerCreateInfo)
readField Ptr VkSamplerCreateInfo
p
          = Ptr VkSamplerCreateInfo -> Int -> IO VkFilter
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSamplerCreateInfo
p (Int
20)
{-# LINE 234 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "magFilter" VkSamplerCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSamplerCreateInfo
-> FieldType "magFilter" VkSamplerCreateInfo -> IO ()
writeField Ptr VkSamplerCreateInfo
p
          = Ptr VkSamplerCreateInfo -> Int -> VkFilter -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSamplerCreateInfo
p (Int
20)
{-# LINE 240 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "minFilter" VkSamplerCreateInfo where
        type FieldType "minFilter" VkSamplerCreateInfo = VkFilter
        type FieldOptional "minFilter" VkSamplerCreateInfo = 'False -- ' closing tick for hsc2hs
        type FieldOffset "minFilter" VkSamplerCreateInfo =
             (24)
{-# LINE 247 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}
        type FieldIsArray "minFilter" VkSamplerCreateInfo = 'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkSamplerCreateInfo
-> IO (FieldType "minFilter" VkSamplerCreateInfo)
readField Ptr VkSamplerCreateInfo
p
          = Ptr VkSamplerCreateInfo -> Int -> IO VkFilter
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSamplerCreateInfo
p (Int
24)
{-# LINE 265 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "minFilter" VkSamplerCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSamplerCreateInfo
-> FieldType "minFilter" VkSamplerCreateInfo -> IO ()
writeField Ptr VkSamplerCreateInfo
p
          = Ptr VkSamplerCreateInfo -> Int -> VkFilter -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSamplerCreateInfo
p (Int
24)
{-# LINE 271 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "mipmapMode" VkSamplerCreateInfo where
        type FieldType "mipmapMode" VkSamplerCreateInfo =
             VkSamplerMipmapMode
        type FieldOptional "mipmapMode" VkSamplerCreateInfo = 'False -- ' closing tick for hsc2hs
        type FieldOffset "mipmapMode" VkSamplerCreateInfo =
             (28)
{-# LINE 279 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}
        type FieldIsArray "mipmapMode" VkSamplerCreateInfo = 'False -- ' closing tick for hsc2hs

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

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset = (Int
28)
{-# LINE 286 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "mipmapMode" VkSamplerCreateInfo where
        {-# NOINLINE getField #-}
        getField :: VkSamplerCreateInfo -> FieldType "mipmapMode" VkSamplerCreateInfo
getField VkSamplerCreateInfo
x
          = IO VkSamplerMipmapMode -> VkSamplerMipmapMode
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkSamplerCreateInfo -> Int -> IO VkSamplerMipmapMode
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkSamplerCreateInfo -> Ptr VkSamplerCreateInfo
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkSamplerCreateInfo
x) (Int
28))
{-# LINE 293 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkSamplerCreateInfo
-> IO (FieldType "mipmapMode" VkSamplerCreateInfo)
readField Ptr VkSamplerCreateInfo
p
          = Ptr VkSamplerCreateInfo -> Int -> IO VkSamplerMipmapMode
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSamplerCreateInfo
p (Int
28)
{-# LINE 297 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "mipmapMode" VkSamplerCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSamplerCreateInfo
-> FieldType "mipmapMode" VkSamplerCreateInfo -> IO ()
writeField Ptr VkSamplerCreateInfo
p
          = Ptr VkSamplerCreateInfo -> Int -> VkSamplerMipmapMode -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSamplerCreateInfo
p (Int
28)
{-# LINE 303 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "addressModeU" VkSamplerCreateInfo where
        type FieldType "addressModeU" VkSamplerCreateInfo =
             VkSamplerAddressMode
        type FieldOptional "addressModeU" VkSamplerCreateInfo = 'False -- ' closing tick for hsc2hs
        type FieldOffset "addressModeU" VkSamplerCreateInfo =
             (32)
{-# LINE 311 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}
        type FieldIsArray "addressModeU" VkSamplerCreateInfo = 'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkSamplerCreateInfo
-> IO (FieldType "addressModeU" VkSamplerCreateInfo)
readField Ptr VkSamplerCreateInfo
p
          = Ptr VkSamplerCreateInfo -> Int -> IO VkSamplerAddressMode
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSamplerCreateInfo
p (Int
32)
{-# LINE 330 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "addressModeU" VkSamplerCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSamplerCreateInfo
-> FieldType "addressModeU" VkSamplerCreateInfo -> IO ()
writeField Ptr VkSamplerCreateInfo
p
          = Ptr VkSamplerCreateInfo -> Int -> VkSamplerAddressMode -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSamplerCreateInfo
p (Int
32)
{-# LINE 336 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "addressModeV" VkSamplerCreateInfo where
        type FieldType "addressModeV" VkSamplerCreateInfo =
             VkSamplerAddressMode
        type FieldOptional "addressModeV" VkSamplerCreateInfo = 'False -- ' closing tick for hsc2hs
        type FieldOffset "addressModeV" VkSamplerCreateInfo =
             (36)
{-# LINE 344 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}
        type FieldIsArray "addressModeV" VkSamplerCreateInfo = 'False -- ' closing tick for hsc2hs

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

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
36)
{-# LINE 352 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "addressModeV" VkSamplerCreateInfo where
        {-# NOINLINE getField #-}
        getField :: VkSamplerCreateInfo -> FieldType "addressModeV" VkSamplerCreateInfo
getField VkSamplerCreateInfo
x
          = IO VkSamplerAddressMode -> VkSamplerAddressMode
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkSamplerCreateInfo -> Int -> IO VkSamplerAddressMode
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkSamplerCreateInfo -> Ptr VkSamplerCreateInfo
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkSamplerCreateInfo
x) (Int
36))
{-# LINE 359 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkSamplerCreateInfo
-> IO (FieldType "addressModeV" VkSamplerCreateInfo)
readField Ptr VkSamplerCreateInfo
p
          = Ptr VkSamplerCreateInfo -> Int -> IO VkSamplerAddressMode
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSamplerCreateInfo
p (Int
36)
{-# LINE 363 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "addressModeV" VkSamplerCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSamplerCreateInfo
-> FieldType "addressModeV" VkSamplerCreateInfo -> IO ()
writeField Ptr VkSamplerCreateInfo
p
          = Ptr VkSamplerCreateInfo -> Int -> VkSamplerAddressMode -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSamplerCreateInfo
p (Int
36)
{-# LINE 369 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "addressModeW" VkSamplerCreateInfo where
        type FieldType "addressModeW" VkSamplerCreateInfo =
             VkSamplerAddressMode
        type FieldOptional "addressModeW" VkSamplerCreateInfo = 'False -- ' closing tick for hsc2hs
        type FieldOffset "addressModeW" VkSamplerCreateInfo =
             (40)
{-# LINE 377 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}
        type FieldIsArray "addressModeW" VkSamplerCreateInfo = 'False -- ' closing tick for hsc2hs

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

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
40)
{-# LINE 385 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "addressModeW" VkSamplerCreateInfo where
        {-# NOINLINE getField #-}
        getField :: VkSamplerCreateInfo -> FieldType "addressModeW" VkSamplerCreateInfo
getField VkSamplerCreateInfo
x
          = IO VkSamplerAddressMode -> VkSamplerAddressMode
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkSamplerCreateInfo -> Int -> IO VkSamplerAddressMode
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkSamplerCreateInfo -> Ptr VkSamplerCreateInfo
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkSamplerCreateInfo
x) (Int
40))
{-# LINE 392 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkSamplerCreateInfo
-> IO (FieldType "addressModeW" VkSamplerCreateInfo)
readField Ptr VkSamplerCreateInfo
p
          = Ptr VkSamplerCreateInfo -> Int -> IO VkSamplerAddressMode
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSamplerCreateInfo
p (Int
40)
{-# LINE 396 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "addressModeW" VkSamplerCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSamplerCreateInfo
-> FieldType "addressModeW" VkSamplerCreateInfo -> IO ()
writeField Ptr VkSamplerCreateInfo
p
          = Ptr VkSamplerCreateInfo -> Int -> VkSamplerAddressMode -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSamplerCreateInfo
p (Int
40)
{-# LINE 402 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "mipLodBias" VkSamplerCreateInfo where
        type FieldType "mipLodBias" VkSamplerCreateInfo =
             Float
{-# LINE 407 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}
        type FieldOptional "mipLodBias" VkSamplerCreateInfo = 'False -- ' closing tick for hsc2hs
        type FieldOffset "mipLodBias" VkSamplerCreateInfo =
             (44)
{-# LINE 410 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}
        type FieldIsArray "mipLodBias" VkSamplerCreateInfo = 'False -- ' closing tick for hsc2hs

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

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset = (Int
44)
{-# LINE 417 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "mipLodBias" VkSamplerCreateInfo where
        {-# NOINLINE getField #-}
        getField :: VkSamplerCreateInfo -> FieldType "mipLodBias" VkSamplerCreateInfo
getField VkSamplerCreateInfo
x
          = IO Float -> Float
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkSamplerCreateInfo -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkSamplerCreateInfo -> Ptr VkSamplerCreateInfo
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkSamplerCreateInfo
x) (Int
44))
{-# LINE 424 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkSamplerCreateInfo
-> IO (FieldType "mipLodBias" VkSamplerCreateInfo)
readField Ptr VkSamplerCreateInfo
p
          = Ptr VkSamplerCreateInfo -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSamplerCreateInfo
p (Int
44)
{-# LINE 428 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "mipLodBias" VkSamplerCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSamplerCreateInfo
-> FieldType "mipLodBias" VkSamplerCreateInfo -> IO ()
writeField Ptr VkSamplerCreateInfo
p
          = Ptr VkSamplerCreateInfo -> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSamplerCreateInfo
p (Int
44)
{-# LINE 434 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "anisotropyEnable" VkSamplerCreateInfo where
        type FieldType "anisotropyEnable" VkSamplerCreateInfo = VkBool32
        type FieldOptional "anisotropyEnable" VkSamplerCreateInfo = 'False -- ' closing tick for hsc2hs
        type FieldOffset "anisotropyEnable" VkSamplerCreateInfo =
             (48)
{-# LINE 441 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}
        type FieldIsArray "anisotropyEnable" VkSamplerCreateInfo = 'False -- ' closing tick for hsc2hs

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

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
48)
{-# LINE 449 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "anisotropyEnable" VkSamplerCreateInfo where
        {-# NOINLINE getField #-}
        getField :: VkSamplerCreateInfo
-> FieldType "anisotropyEnable" VkSamplerCreateInfo
getField VkSamplerCreateInfo
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkSamplerCreateInfo -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkSamplerCreateInfo -> Ptr VkSamplerCreateInfo
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkSamplerCreateInfo
x) (Int
48))
{-# LINE 456 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkSamplerCreateInfo
-> IO (FieldType "anisotropyEnable" VkSamplerCreateInfo)
readField Ptr VkSamplerCreateInfo
p
          = Ptr VkSamplerCreateInfo -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSamplerCreateInfo
p (Int
48)
{-# LINE 460 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "anisotropyEnable" VkSamplerCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSamplerCreateInfo
-> FieldType "anisotropyEnable" VkSamplerCreateInfo -> IO ()
writeField Ptr VkSamplerCreateInfo
p
          = Ptr VkSamplerCreateInfo -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSamplerCreateInfo
p (Int
48)
{-# LINE 466 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "maxAnisotropy" VkSamplerCreateInfo where
        type FieldType "maxAnisotropy" VkSamplerCreateInfo =
             Float
{-# LINE 471 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}
        type FieldOptional "maxAnisotropy" VkSamplerCreateInfo = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxAnisotropy" VkSamplerCreateInfo =
             (52)
{-# LINE 474 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}
        type FieldIsArray "maxAnisotropy" VkSamplerCreateInfo = 'False -- ' closing tick for hsc2hs

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

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
52)
{-# LINE 482 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxAnisotropy" VkSamplerCreateInfo where
        {-# NOINLINE getField #-}
        getField :: VkSamplerCreateInfo
-> FieldType "maxAnisotropy" VkSamplerCreateInfo
getField VkSamplerCreateInfo
x
          = IO Float -> Float
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkSamplerCreateInfo -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkSamplerCreateInfo -> Ptr VkSamplerCreateInfo
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkSamplerCreateInfo
x) (Int
52))
{-# LINE 489 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkSamplerCreateInfo
-> IO (FieldType "maxAnisotropy" VkSamplerCreateInfo)
readField Ptr VkSamplerCreateInfo
p
          = Ptr VkSamplerCreateInfo -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSamplerCreateInfo
p (Int
52)
{-# LINE 493 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxAnisotropy" VkSamplerCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSamplerCreateInfo
-> FieldType "maxAnisotropy" VkSamplerCreateInfo -> IO ()
writeField Ptr VkSamplerCreateInfo
p
          = Ptr VkSamplerCreateInfo -> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSamplerCreateInfo
p (Int
52)
{-# LINE 499 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "compareEnable" VkSamplerCreateInfo where
        type FieldType "compareEnable" VkSamplerCreateInfo = VkBool32
        type FieldOptional "compareEnable" VkSamplerCreateInfo = 'False -- ' closing tick for hsc2hs
        type FieldOffset "compareEnable" VkSamplerCreateInfo =
             (56)
{-# LINE 506 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}
        type FieldIsArray "compareEnable" VkSamplerCreateInfo = 'False -- ' closing tick for hsc2hs

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

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
56)
{-# LINE 514 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "compareEnable" VkSamplerCreateInfo where
        {-# NOINLINE getField #-}
        getField :: VkSamplerCreateInfo
-> FieldType "compareEnable" VkSamplerCreateInfo
getField VkSamplerCreateInfo
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkSamplerCreateInfo -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkSamplerCreateInfo -> Ptr VkSamplerCreateInfo
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkSamplerCreateInfo
x) (Int
56))
{-# LINE 521 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkSamplerCreateInfo
-> IO (FieldType "compareEnable" VkSamplerCreateInfo)
readField Ptr VkSamplerCreateInfo
p
          = Ptr VkSamplerCreateInfo -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSamplerCreateInfo
p (Int
56)
{-# LINE 525 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "compareEnable" VkSamplerCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSamplerCreateInfo
-> FieldType "compareEnable" VkSamplerCreateInfo -> IO ()
writeField Ptr VkSamplerCreateInfo
p
          = Ptr VkSamplerCreateInfo -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSamplerCreateInfo
p (Int
56)
{-# LINE 531 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "compareOp" VkSamplerCreateInfo where
        type FieldType "compareOp" VkSamplerCreateInfo = VkCompareOp
        type FieldOptional "compareOp" VkSamplerCreateInfo = 'False -- ' closing tick for hsc2hs
        type FieldOffset "compareOp" VkSamplerCreateInfo =
             (60)
{-# LINE 538 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}
        type FieldIsArray "compareOp" VkSamplerCreateInfo = 'False -- ' closing tick for hsc2hs

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

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset = (Int
60)
{-# LINE 545 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "compareOp" VkSamplerCreateInfo where
        {-# NOINLINE getField #-}
        getField :: VkSamplerCreateInfo -> FieldType "compareOp" VkSamplerCreateInfo
getField VkSamplerCreateInfo
x
          = IO VkCompareOp -> VkCompareOp
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkSamplerCreateInfo -> Int -> IO VkCompareOp
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkSamplerCreateInfo -> Ptr VkSamplerCreateInfo
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkSamplerCreateInfo
x) (Int
60))
{-# LINE 552 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkSamplerCreateInfo
-> IO (FieldType "compareOp" VkSamplerCreateInfo)
readField Ptr VkSamplerCreateInfo
p
          = Ptr VkSamplerCreateInfo -> Int -> IO VkCompareOp
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSamplerCreateInfo
p (Int
60)
{-# LINE 556 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "compareOp" VkSamplerCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSamplerCreateInfo
-> FieldType "compareOp" VkSamplerCreateInfo -> IO ()
writeField Ptr VkSamplerCreateInfo
p
          = Ptr VkSamplerCreateInfo -> Int -> VkCompareOp -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSamplerCreateInfo
p (Int
60)
{-# LINE 562 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-} HasField "minLod" VkSamplerCreateInfo
         where
        type FieldType "minLod" VkSamplerCreateInfo =
             Float
{-# LINE 567 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}
        type FieldOptional "minLod" VkSamplerCreateInfo = 'False -- ' closing tick for hsc2hs
        type FieldOffset "minLod" VkSamplerCreateInfo =
             (64)
{-# LINE 570 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}
        type FieldIsArray "minLod" VkSamplerCreateInfo = 'False -- ' closing tick for hsc2hs

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

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset = (Int
64)
{-# LINE 577 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "minLod" VkSamplerCreateInfo where
        {-# NOINLINE getField #-}
        getField :: VkSamplerCreateInfo -> FieldType "minLod" VkSamplerCreateInfo
getField VkSamplerCreateInfo
x
          = IO Float -> Float
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkSamplerCreateInfo -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkSamplerCreateInfo -> Ptr VkSamplerCreateInfo
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkSamplerCreateInfo
x) (Int
64))
{-# LINE 584 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkSamplerCreateInfo
-> IO (FieldType "minLod" VkSamplerCreateInfo)
readField Ptr VkSamplerCreateInfo
p
          = Ptr VkSamplerCreateInfo -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSamplerCreateInfo
p (Int
64)
{-# LINE 588 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "minLod" VkSamplerCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSamplerCreateInfo
-> FieldType "minLod" VkSamplerCreateInfo -> IO ()
writeField Ptr VkSamplerCreateInfo
p
          = Ptr VkSamplerCreateInfo -> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSamplerCreateInfo
p (Int
64)
{-# LINE 594 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-} HasField "maxLod" VkSamplerCreateInfo
         where
        type FieldType "maxLod" VkSamplerCreateInfo =
             Float
{-# LINE 599 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}
        type FieldOptional "maxLod" VkSamplerCreateInfo = 'False -- ' closing tick for hsc2hs
        type FieldOffset "maxLod" VkSamplerCreateInfo =
             (68)
{-# LINE 602 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}
        type FieldIsArray "maxLod" VkSamplerCreateInfo = 'False -- ' closing tick for hsc2hs

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

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset = (Int
68)
{-# LINE 609 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "maxLod" VkSamplerCreateInfo where
        {-# NOINLINE getField #-}
        getField :: VkSamplerCreateInfo -> FieldType "maxLod" VkSamplerCreateInfo
getField VkSamplerCreateInfo
x
          = IO Float -> Float
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkSamplerCreateInfo -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkSamplerCreateInfo -> Ptr VkSamplerCreateInfo
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkSamplerCreateInfo
x) (Int
68))
{-# LINE 616 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkSamplerCreateInfo
-> IO (FieldType "maxLod" VkSamplerCreateInfo)
readField Ptr VkSamplerCreateInfo
p
          = Ptr VkSamplerCreateInfo -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSamplerCreateInfo
p (Int
68)
{-# LINE 620 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "maxLod" VkSamplerCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSamplerCreateInfo
-> FieldType "maxLod" VkSamplerCreateInfo -> IO ()
writeField Ptr VkSamplerCreateInfo
p
          = Ptr VkSamplerCreateInfo -> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSamplerCreateInfo
p (Int
68)
{-# LINE 626 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "borderColor" VkSamplerCreateInfo where
        type FieldType "borderColor" VkSamplerCreateInfo = VkBorderColor
        type FieldOptional "borderColor" VkSamplerCreateInfo = 'False -- ' closing tick for hsc2hs
        type FieldOffset "borderColor" VkSamplerCreateInfo =
             (72)
{-# LINE 633 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}
        type FieldIsArray "borderColor" VkSamplerCreateInfo = 'False -- ' closing tick for hsc2hs

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

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
72)
{-# LINE 641 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "borderColor" VkSamplerCreateInfo where
        {-# NOINLINE getField #-}
        getField :: VkSamplerCreateInfo -> FieldType "borderColor" VkSamplerCreateInfo
getField VkSamplerCreateInfo
x
          = IO VkBorderColor -> VkBorderColor
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkSamplerCreateInfo -> Int -> IO VkBorderColor
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkSamplerCreateInfo -> Ptr VkSamplerCreateInfo
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkSamplerCreateInfo
x) (Int
72))
{-# LINE 648 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkSamplerCreateInfo
-> IO (FieldType "borderColor" VkSamplerCreateInfo)
readField Ptr VkSamplerCreateInfo
p
          = Ptr VkSamplerCreateInfo -> Int -> IO VkBorderColor
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSamplerCreateInfo
p (Int
72)
{-# LINE 652 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "borderColor" VkSamplerCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSamplerCreateInfo
-> FieldType "borderColor" VkSamplerCreateInfo -> IO ()
writeField Ptr VkSamplerCreateInfo
p
          = Ptr VkSamplerCreateInfo -> Int -> VkBorderColor -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSamplerCreateInfo
p (Int
72)
{-# LINE 658 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "unnormalizedCoordinates" VkSamplerCreateInfo where
        type FieldType "unnormalizedCoordinates" VkSamplerCreateInfo =
             VkBool32
        type FieldOptional "unnormalizedCoordinates" VkSamplerCreateInfo =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "unnormalizedCoordinates" VkSamplerCreateInfo =
             (76)
{-# LINE 667 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}
        type FieldIsArray "unnormalizedCoordinates" VkSamplerCreateInfo =
             'False -- ' closing tick for hsc2hs

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

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
76)
{-# LINE 676 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "unnormalizedCoordinates" VkSamplerCreateInfo where
        {-# NOINLINE getField #-}
        getField :: VkSamplerCreateInfo
-> FieldType "unnormalizedCoordinates" VkSamplerCreateInfo
getField VkSamplerCreateInfo
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkSamplerCreateInfo -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkSamplerCreateInfo -> Ptr VkSamplerCreateInfo
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkSamplerCreateInfo
x) (Int
76))
{-# LINE 683 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkSamplerCreateInfo
-> IO (FieldType "unnormalizedCoordinates" VkSamplerCreateInfo)
readField Ptr VkSamplerCreateInfo
p
          = Ptr VkSamplerCreateInfo -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSamplerCreateInfo
p (Int
76)
{-# LINE 687 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "unnormalizedCoordinates" VkSamplerCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSamplerCreateInfo
-> FieldType "unnormalizedCoordinates" VkSamplerCreateInfo -> IO ()
writeField Ptr VkSamplerCreateInfo
p
          = Ptr VkSamplerCreateInfo -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSamplerCreateInfo
p (Int
76)
{-# LINE 693 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance Show VkSamplerCreateInfo where
        showsPrec :: Int -> VkSamplerCreateInfo -> ShowS
showsPrec Int
d VkSamplerCreateInfo
x
          = String -> ShowS
showString String
"VkSamplerCreateInfo {" 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 (VkSamplerCreateInfo -> FieldType "sType" VkSamplerCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkSamplerCreateInfo
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 (VkSamplerCreateInfo -> FieldType "pNext" VkSamplerCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkSamplerCreateInfo
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 -> VkSamplerCreateFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkSamplerCreateInfo -> FieldType "flags" VkSamplerCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"flags" VkSamplerCreateInfo
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
"magFilter = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  Int -> VkFilter -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkSamplerCreateInfo -> FieldType "magFilter" VkSamplerCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"magFilter" VkSamplerCreateInfo
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
"minFilter = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                        Int -> VkFilter -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkSamplerCreateInfo -> FieldType "minFilter" VkSamplerCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"minFilter" VkSamplerCreateInfo
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
"mipmapMode = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                              Int -> VkSamplerMipmapMode -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkSamplerCreateInfo -> FieldType "mipmapMode" VkSamplerCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"mipmapMode" VkSamplerCreateInfo
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
"addressModeU = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                    Int -> VkSamplerAddressMode -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkSamplerCreateInfo -> FieldType "addressModeU" VkSamplerCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"addressModeU" VkSamplerCreateInfo
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
"addressModeV = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                          Int -> VkSamplerAddressMode -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkSamplerCreateInfo -> FieldType "addressModeV" VkSamplerCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"addressModeV" VkSamplerCreateInfo
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
"addressModeW = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                Int -> VkSamplerAddressMode -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                                  (VkSamplerCreateInfo -> FieldType "addressModeW" VkSamplerCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"addressModeW" VkSamplerCreateInfo
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
"mipLodBias = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                      Int -> Float -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                                        (VkSamplerCreateInfo -> FieldType "mipLodBias" VkSamplerCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"mipLodBias" VkSamplerCreateInfo
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
"anisotropyEnable = "
                                                                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                            Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                                              (VkSamplerCreateInfo
-> FieldType "anisotropyEnable" VkSamplerCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                 @"anisotropyEnable"
                                                                                 VkSamplerCreateInfo
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
"maxAnisotropy = "
                                                                                  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                  Int -> Float -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                                                    (VkSamplerCreateInfo
-> FieldType "maxAnisotropy" VkSamplerCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                       @"maxAnisotropy"
                                                                                       VkSamplerCreateInfo
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
"compareEnable = "
                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                        Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                                                          (VkSamplerCreateInfo
-> FieldType "compareEnable" VkSamplerCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                             @"compareEnable"
                                                                                             VkSamplerCreateInfo
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
"compareOp = "
                                                                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                              Int -> VkCompareOp -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                Int
d
                                                                                                (VkSamplerCreateInfo -> FieldType "compareOp" VkSamplerCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                   @"compareOp"
                                                                                                   VkSamplerCreateInfo
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
"minLod = "
                                                                                                    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                    Int -> Float -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                      Int
d
                                                                                                      (VkSamplerCreateInfo -> FieldType "minLod" VkSamplerCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                         @"minLod"
                                                                                                         VkSamplerCreateInfo
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
"maxLod = "
                                                                                                          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                          Int -> Float -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                            Int
d
                                                                                                            (VkSamplerCreateInfo -> FieldType "maxLod" VkSamplerCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                               @"maxLod"
                                                                                                               VkSamplerCreateInfo
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
"borderColor = "
                                                                                                                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                Int -> VkBorderColor -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                  Int
d
                                                                                                                  (VkSamplerCreateInfo -> FieldType "borderColor" VkSamplerCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                     @"borderColor"
                                                                                                                     VkSamplerCreateInfo
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
"unnormalizedCoordinates = "
                                                                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                      Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
                                                                                                                        Int
d
                                                                                                                        (VkSamplerCreateInfo
-> FieldType "unnormalizedCoordinates" VkSamplerCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                                                                           @"unnormalizedCoordinates"
                                                                                                                           VkSamplerCreateInfo
x)
                                                                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                                                                        Char -> ShowS
showChar
                                                                                                                          Char
'}'

-- | > typedef struct VkSamplerReductionModeCreateInfoEXT {
--   >     VkStructureType sType;
--   >     const void*            pNext;
--   >     VkSamplerReductionModeEXT reductionMode;
--   > } VkSamplerReductionModeCreateInfoEXT;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkSamplerReductionModeCreateInfoEXT VkSamplerReductionModeCreateInfoEXT registry at www.khronos.org>
data VkSamplerReductionModeCreateInfoEXT = VkSamplerReductionModeCreateInfoEXT# Addr#
                                                                                ByteArray#

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

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

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

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkSamplerReductionModeCreateInfoEXT where
        type StructFields VkSamplerReductionModeCreateInfoEXT =
             '["sType", "pNext", "reductionMode"] -- ' closing tick for hsc2hs
        type CUnionType VkSamplerReductionModeCreateInfoEXT = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkSamplerReductionModeCreateInfoEXT = 'False -- ' closing tick for hsc2hs
        type StructExtends VkSamplerReductionModeCreateInfoEXT =
             '[VkSamplerCreateInfo] -- ' closing tick for hsc2hs

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

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

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

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

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

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

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

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

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

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

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

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

instance {-# OVERLAPPING #-}
         HasField "reductionMode" VkSamplerReductionModeCreateInfoEXT where
        type FieldType "reductionMode" VkSamplerReductionModeCreateInfoEXT
             = VkSamplerReductionModeEXT
        type FieldOptional "reductionMode"
               VkSamplerReductionModeCreateInfoEXT
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "reductionMode"
               VkSamplerReductionModeCreateInfoEXT
             =
             (16)
{-# LINE 964 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}
        type FieldIsArray "reductionMode"
               VkSamplerReductionModeCreateInfoEXT
             = 'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkSamplerReductionModeCreateInfoEXT
-> IO
     (FieldType "reductionMode" VkSamplerReductionModeCreateInfoEXT)
readField Ptr VkSamplerReductionModeCreateInfoEXT
p
          = Ptr VkSamplerReductionModeCreateInfoEXT
-> Int -> IO VkSamplerReductionModeEXT
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSamplerReductionModeCreateInfoEXT
p (Int
16)
{-# LINE 986 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "reductionMode" VkSamplerReductionModeCreateInfoEXT
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSamplerReductionModeCreateInfoEXT
-> FieldType "reductionMode" VkSamplerReductionModeCreateInfoEXT
-> IO ()
writeField Ptr VkSamplerReductionModeCreateInfoEXT
p
          = Ptr VkSamplerReductionModeCreateInfoEXT
-> Int -> VkSamplerReductionModeEXT -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSamplerReductionModeCreateInfoEXT
p (Int
16)
{-# LINE 993 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance Show VkSamplerReductionModeCreateInfoEXT where
        showsPrec :: Int -> VkSamplerReductionModeCreateInfoEXT -> ShowS
showsPrec Int
d VkSamplerReductionModeCreateInfoEXT
x
          = String -> ShowS
showString String
"VkSamplerReductionModeCreateInfoEXT {" 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 (VkSamplerReductionModeCreateInfoEXT
-> FieldType "sType" VkSamplerReductionModeCreateInfoEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkSamplerReductionModeCreateInfoEXT
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 (VkSamplerReductionModeCreateInfoEXT
-> FieldType "pNext" VkSamplerReductionModeCreateInfoEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkSamplerReductionModeCreateInfoEXT
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
"reductionMode = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkSamplerReductionModeEXT -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkSamplerReductionModeCreateInfoEXT
-> FieldType "reductionMode" VkSamplerReductionModeCreateInfoEXT
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"reductionMode" VkSamplerReductionModeCreateInfoEXT
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | > typedef struct VkSamplerYcbcrConversionCreateInfo {
--   >     VkStructureType sType;
--   >     const void*                      pNext;
--   >     VkFormat                         format;
--   >     VkSamplerYcbcrModelConversion ycbcrModel;
--   >     VkSamplerYcbcrRange           ycbcrRange;
--   >     VkComponentMapping               components;
--   >     VkChromaLocation              xChromaOffset;
--   >     VkChromaLocation              yChromaOffset;
--   >     VkFilter                         chromaFilter;
--   >     VkBool32                         forceExplicitReconstruction;
--   > } VkSamplerYcbcrConversionCreateInfo;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkSamplerYcbcrConversionCreateInfo VkSamplerYcbcrConversionCreateInfo registry at www.khronos.org>
data VkSamplerYcbcrConversionCreateInfo = VkSamplerYcbcrConversionCreateInfo# Addr#
                                                                              ByteArray#

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

instance Storable VkSamplerYcbcrConversionCreateInfo where
        sizeOf :: VkSamplerYcbcrConversionCreateInfo -> Int
sizeOf ~VkSamplerYcbcrConversionCreateInfo
_ = (Int
64)
{-# LINE 1039 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

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

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkSamplerYcbcrConversionCreateInfo where
        type StructFields VkSamplerYcbcrConversionCreateInfo =
             '["sType", "pNext", "format", "ycbcrModel", "ycbcrRange", -- ' closing tick for hsc2hs
               "components", "xChromaOffset", "yChromaOffset", "chromaFilter",
               "forceExplicitReconstruction"]
        type CUnionType VkSamplerYcbcrConversionCreateInfo = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkSamplerYcbcrConversionCreateInfo = 'False -- ' closing tick for hsc2hs
        type StructExtends VkSamplerYcbcrConversionCreateInfo = '[] -- ' closing tick for hsc2hs

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

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

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

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

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

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

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

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

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

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

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

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

instance {-# OVERLAPPING #-}
         HasField "format" VkSamplerYcbcrConversionCreateInfo where
        type FieldType "format" VkSamplerYcbcrConversionCreateInfo =
             VkFormat
        type FieldOptional "format" VkSamplerYcbcrConversionCreateInfo =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "format" VkSamplerYcbcrConversionCreateInfo =
             (16)
{-# LINE 1153 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}
        type FieldIsArray "format" VkSamplerYcbcrConversionCreateInfo =
             'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkSamplerYcbcrConversionCreateInfo
-> IO (FieldType "format" VkSamplerYcbcrConversionCreateInfo)
readField Ptr VkSamplerYcbcrConversionCreateInfo
p
          = Ptr VkSamplerYcbcrConversionCreateInfo -> Int -> IO VkFormat
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSamplerYcbcrConversionCreateInfo
p (Int
16)
{-# LINE 1173 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "format" VkSamplerYcbcrConversionCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSamplerYcbcrConversionCreateInfo
-> FieldType "format" VkSamplerYcbcrConversionCreateInfo -> IO ()
writeField Ptr VkSamplerYcbcrConversionCreateInfo
p
          = Ptr VkSamplerYcbcrConversionCreateInfo -> Int -> VkFormat -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSamplerYcbcrConversionCreateInfo
p (Int
16)
{-# LINE 1179 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "ycbcrModel" VkSamplerYcbcrConversionCreateInfo where
        type FieldType "ycbcrModel" VkSamplerYcbcrConversionCreateInfo =
             VkSamplerYcbcrModelConversion
        type FieldOptional "ycbcrModel" VkSamplerYcbcrConversionCreateInfo
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "ycbcrModel" VkSamplerYcbcrConversionCreateInfo =
             (20)
{-# LINE 1188 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}
        type FieldIsArray "ycbcrModel" VkSamplerYcbcrConversionCreateInfo =
             'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkSamplerYcbcrConversionCreateInfo
-> IO (FieldType "ycbcrModel" VkSamplerYcbcrConversionCreateInfo)
readField Ptr VkSamplerYcbcrConversionCreateInfo
p
          = Ptr VkSamplerYcbcrConversionCreateInfo
-> Int -> IO VkSamplerYcbcrModelConversion
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSamplerYcbcrConversionCreateInfo
p (Int
20)
{-# LINE 1208 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "ycbcrModel" VkSamplerYcbcrConversionCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSamplerYcbcrConversionCreateInfo
-> FieldType "ycbcrModel" VkSamplerYcbcrConversionCreateInfo
-> IO ()
writeField Ptr VkSamplerYcbcrConversionCreateInfo
p
          = Ptr VkSamplerYcbcrConversionCreateInfo
-> Int -> VkSamplerYcbcrModelConversion -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSamplerYcbcrConversionCreateInfo
p (Int
20)
{-# LINE 1214 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "ycbcrRange" VkSamplerYcbcrConversionCreateInfo where
        type FieldType "ycbcrRange" VkSamplerYcbcrConversionCreateInfo =
             VkSamplerYcbcrRange
        type FieldOptional "ycbcrRange" VkSamplerYcbcrConversionCreateInfo
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "ycbcrRange" VkSamplerYcbcrConversionCreateInfo =
             (24)
{-# LINE 1223 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}
        type FieldIsArray "ycbcrRange" VkSamplerYcbcrConversionCreateInfo =
             'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkSamplerYcbcrConversionCreateInfo
-> IO (FieldType "ycbcrRange" VkSamplerYcbcrConversionCreateInfo)
readField Ptr VkSamplerYcbcrConversionCreateInfo
p
          = Ptr VkSamplerYcbcrConversionCreateInfo
-> Int -> IO VkSamplerYcbcrRange
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSamplerYcbcrConversionCreateInfo
p (Int
24)
{-# LINE 1243 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "ycbcrRange" VkSamplerYcbcrConversionCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSamplerYcbcrConversionCreateInfo
-> FieldType "ycbcrRange" VkSamplerYcbcrConversionCreateInfo
-> IO ()
writeField Ptr VkSamplerYcbcrConversionCreateInfo
p
          = Ptr VkSamplerYcbcrConversionCreateInfo
-> Int -> VkSamplerYcbcrRange -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSamplerYcbcrConversionCreateInfo
p (Int
24)
{-# LINE 1249 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "components" VkSamplerYcbcrConversionCreateInfo where
        type FieldType "components" VkSamplerYcbcrConversionCreateInfo =
             VkComponentMapping
        type FieldOptional "components" VkSamplerYcbcrConversionCreateInfo
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "components" VkSamplerYcbcrConversionCreateInfo =
             (28)
{-# LINE 1258 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}
        type FieldIsArray "components" VkSamplerYcbcrConversionCreateInfo =
             'False -- ' closing tick for hsc2hs

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

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
28)
{-# LINE 1267 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "components" VkSamplerYcbcrConversionCreateInfo where
        {-# NOINLINE getField #-}
        getField :: VkSamplerYcbcrConversionCreateInfo
-> FieldType "components" VkSamplerYcbcrConversionCreateInfo
getField VkSamplerYcbcrConversionCreateInfo
x
          = IO VkComponentMapping -> VkComponentMapping
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkSamplerYcbcrConversionCreateInfo
-> Int -> IO VkComponentMapping
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkSamplerYcbcrConversionCreateInfo
-> Ptr VkSamplerYcbcrConversionCreateInfo
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkSamplerYcbcrConversionCreateInfo
x) (Int
28))
{-# LINE 1274 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkSamplerYcbcrConversionCreateInfo
-> IO (FieldType "components" VkSamplerYcbcrConversionCreateInfo)
readField Ptr VkSamplerYcbcrConversionCreateInfo
p
          = Ptr VkSamplerYcbcrConversionCreateInfo
-> Int -> IO VkComponentMapping
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSamplerYcbcrConversionCreateInfo
p (Int
28)
{-# LINE 1278 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "components" VkSamplerYcbcrConversionCreateInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSamplerYcbcrConversionCreateInfo
-> FieldType "components" VkSamplerYcbcrConversionCreateInfo
-> IO ()
writeField Ptr VkSamplerYcbcrConversionCreateInfo
p
          = Ptr VkSamplerYcbcrConversionCreateInfo
-> Int -> VkComponentMapping -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSamplerYcbcrConversionCreateInfo
p (Int
28)
{-# LINE 1284 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "xChromaOffset" VkSamplerYcbcrConversionCreateInfo where
        type FieldType "xChromaOffset" VkSamplerYcbcrConversionCreateInfo =
             VkChromaLocation
        type FieldOptional "xChromaOffset"
               VkSamplerYcbcrConversionCreateInfo
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "xChromaOffset" VkSamplerYcbcrConversionCreateInfo
             =
             (44)
{-# LINE 1295 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}
        type FieldIsArray "xChromaOffset"
               VkSamplerYcbcrConversionCreateInfo
             = 'False -- ' closing tick for hsc2hs

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

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
44)
{-# LINE 1305 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "xChromaOffset" VkSamplerYcbcrConversionCreateInfo
         where
        {-# NOINLINE getField #-}
        getField :: VkSamplerYcbcrConversionCreateInfo
-> FieldType "xChromaOffset" VkSamplerYcbcrConversionCreateInfo
getField VkSamplerYcbcrConversionCreateInfo
x
          = IO VkChromaLocation -> VkChromaLocation
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkSamplerYcbcrConversionCreateInfo
-> Int -> IO VkChromaLocation
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkSamplerYcbcrConversionCreateInfo
-> Ptr VkSamplerYcbcrConversionCreateInfo
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkSamplerYcbcrConversionCreateInfo
x) (Int
44))
{-# LINE 1313 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkSamplerYcbcrConversionCreateInfo
-> IO
     (FieldType "xChromaOffset" VkSamplerYcbcrConversionCreateInfo)
readField Ptr VkSamplerYcbcrConversionCreateInfo
p
          = Ptr VkSamplerYcbcrConversionCreateInfo
-> Int -> IO VkChromaLocation
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSamplerYcbcrConversionCreateInfo
p (Int
44)
{-# LINE 1317 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "xChromaOffset" VkSamplerYcbcrConversionCreateInfo
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSamplerYcbcrConversionCreateInfo
-> FieldType "xChromaOffset" VkSamplerYcbcrConversionCreateInfo
-> IO ()
writeField Ptr VkSamplerYcbcrConversionCreateInfo
p
          = Ptr VkSamplerYcbcrConversionCreateInfo
-> Int -> VkChromaLocation -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSamplerYcbcrConversionCreateInfo
p (Int
44)
{-# LINE 1324 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "yChromaOffset" VkSamplerYcbcrConversionCreateInfo where
        type FieldType "yChromaOffset" VkSamplerYcbcrConversionCreateInfo =
             VkChromaLocation
        type FieldOptional "yChromaOffset"
               VkSamplerYcbcrConversionCreateInfo
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "yChromaOffset" VkSamplerYcbcrConversionCreateInfo
             =
             (48)
{-# LINE 1335 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}
        type FieldIsArray "yChromaOffset"
               VkSamplerYcbcrConversionCreateInfo
             = 'False -- ' closing tick for hsc2hs

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

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
48)
{-# LINE 1345 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "yChromaOffset" VkSamplerYcbcrConversionCreateInfo
         where
        {-# NOINLINE getField #-}
        getField :: VkSamplerYcbcrConversionCreateInfo
-> FieldType "yChromaOffset" VkSamplerYcbcrConversionCreateInfo
getField VkSamplerYcbcrConversionCreateInfo
x
          = IO VkChromaLocation -> VkChromaLocation
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkSamplerYcbcrConversionCreateInfo
-> Int -> IO VkChromaLocation
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkSamplerYcbcrConversionCreateInfo
-> Ptr VkSamplerYcbcrConversionCreateInfo
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkSamplerYcbcrConversionCreateInfo
x) (Int
48))
{-# LINE 1353 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkSamplerYcbcrConversionCreateInfo
-> IO
     (FieldType "yChromaOffset" VkSamplerYcbcrConversionCreateInfo)
readField Ptr VkSamplerYcbcrConversionCreateInfo
p
          = Ptr VkSamplerYcbcrConversionCreateInfo
-> Int -> IO VkChromaLocation
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSamplerYcbcrConversionCreateInfo
p (Int
48)
{-# LINE 1357 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "yChromaOffset" VkSamplerYcbcrConversionCreateInfo
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSamplerYcbcrConversionCreateInfo
-> FieldType "yChromaOffset" VkSamplerYcbcrConversionCreateInfo
-> IO ()
writeField Ptr VkSamplerYcbcrConversionCreateInfo
p
          = Ptr VkSamplerYcbcrConversionCreateInfo
-> Int -> VkChromaLocation -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSamplerYcbcrConversionCreateInfo
p (Int
48)
{-# LINE 1364 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "chromaFilter" VkSamplerYcbcrConversionCreateInfo where
        type FieldType "chromaFilter" VkSamplerYcbcrConversionCreateInfo =
             VkFilter
        type FieldOptional "chromaFilter"
               VkSamplerYcbcrConversionCreateInfo
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "chromaFilter" VkSamplerYcbcrConversionCreateInfo
             =
             (52)
{-# LINE 1375 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}
        type FieldIsArray "chromaFilter" VkSamplerYcbcrConversionCreateInfo
             = 'False -- ' closing tick for hsc2hs

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

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
52)
{-# LINE 1384 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "chromaFilter" VkSamplerYcbcrConversionCreateInfo
         where
        {-# NOINLINE getField #-}
        getField :: VkSamplerYcbcrConversionCreateInfo
-> FieldType "chromaFilter" VkSamplerYcbcrConversionCreateInfo
getField VkSamplerYcbcrConversionCreateInfo
x
          = IO VkFilter -> VkFilter
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkSamplerYcbcrConversionCreateInfo -> Int -> IO VkFilter
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkSamplerYcbcrConversionCreateInfo
-> Ptr VkSamplerYcbcrConversionCreateInfo
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkSamplerYcbcrConversionCreateInfo
x) (Int
52))
{-# LINE 1392 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkSamplerYcbcrConversionCreateInfo
-> IO (FieldType "chromaFilter" VkSamplerYcbcrConversionCreateInfo)
readField Ptr VkSamplerYcbcrConversionCreateInfo
p
          = Ptr VkSamplerYcbcrConversionCreateInfo -> Int -> IO VkFilter
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSamplerYcbcrConversionCreateInfo
p (Int
52)
{-# LINE 1396 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "chromaFilter" VkSamplerYcbcrConversionCreateInfo
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSamplerYcbcrConversionCreateInfo
-> FieldType "chromaFilter" VkSamplerYcbcrConversionCreateInfo
-> IO ()
writeField Ptr VkSamplerYcbcrConversionCreateInfo
p
          = Ptr VkSamplerYcbcrConversionCreateInfo -> Int -> VkFilter -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSamplerYcbcrConversionCreateInfo
p (Int
52)
{-# LINE 1403 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         HasField "forceExplicitReconstruction"
           VkSamplerYcbcrConversionCreateInfo
         where
        type FieldType "forceExplicitReconstruction"
               VkSamplerYcbcrConversionCreateInfo
             = VkBool32
        type FieldOptional "forceExplicitReconstruction"
               VkSamplerYcbcrConversionCreateInfo
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "forceExplicitReconstruction"
               VkSamplerYcbcrConversionCreateInfo
             =
             (56)
{-# LINE 1418 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}
        type FieldIsArray "forceExplicitReconstruction"
               VkSamplerYcbcrConversionCreateInfo
             = 'False -- ' closing tick for hsc2hs

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

        {-# INLINE fieldOffset #-}
        fieldOffset :: Int
fieldOffset
          = (Int
56)
{-# LINE 1428 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanReadField "forceExplicitReconstruction"
           VkSamplerYcbcrConversionCreateInfo
         where
        {-# NOINLINE getField #-}
        getField :: VkSamplerYcbcrConversionCreateInfo
-> FieldType
     "forceExplicitReconstruction" VkSamplerYcbcrConversionCreateInfo
getField VkSamplerYcbcrConversionCreateInfo
x
          = IO VkBool32 -> VkBool32
forall a. IO a -> a
unsafeDupablePerformIO
              (Ptr VkSamplerYcbcrConversionCreateInfo -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkSamplerYcbcrConversionCreateInfo
-> Ptr VkSamplerYcbcrConversionCreateInfo
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkSamplerYcbcrConversionCreateInfo
x) (Int
56))
{-# LINE 1437 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

        {-# INLINE readField #-}
        readField :: Ptr VkSamplerYcbcrConversionCreateInfo
-> IO
     (FieldType
        "forceExplicitReconstruction" VkSamplerYcbcrConversionCreateInfo)
readField Ptr VkSamplerYcbcrConversionCreateInfo
p
          = Ptr VkSamplerYcbcrConversionCreateInfo -> Int -> IO VkBool32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSamplerYcbcrConversionCreateInfo
p (Int
56)
{-# LINE 1441 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "forceExplicitReconstruction"
           VkSamplerYcbcrConversionCreateInfo
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSamplerYcbcrConversionCreateInfo
-> FieldType
     "forceExplicitReconstruction" VkSamplerYcbcrConversionCreateInfo
-> IO ()
writeField Ptr VkSamplerYcbcrConversionCreateInfo
p
          = Ptr VkSamplerYcbcrConversionCreateInfo -> Int -> VkBool32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSamplerYcbcrConversionCreateInfo
p (Int
56)
{-# LINE 1449 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance Show VkSamplerYcbcrConversionCreateInfo where
        showsPrec :: Int -> VkSamplerYcbcrConversionCreateInfo -> ShowS
showsPrec Int
d VkSamplerYcbcrConversionCreateInfo
x
          = String -> ShowS
showString String
"VkSamplerYcbcrConversionCreateInfo {" 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 (VkSamplerYcbcrConversionCreateInfo
-> FieldType "sType" VkSamplerYcbcrConversionCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkSamplerYcbcrConversionCreateInfo
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 (VkSamplerYcbcrConversionCreateInfo
-> FieldType "pNext" VkSamplerYcbcrConversionCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkSamplerYcbcrConversionCreateInfo
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
"format = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkFormat -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkSamplerYcbcrConversionCreateInfo
-> FieldType "format" VkSamplerYcbcrConversionCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"format" VkSamplerYcbcrConversionCreateInfo
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
"ycbcrModel = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                  Int -> VkSamplerYcbcrModelConversion -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkSamplerYcbcrConversionCreateInfo
-> FieldType "ycbcrModel" VkSamplerYcbcrConversionCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"ycbcrModel" VkSamplerYcbcrConversionCreateInfo
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
"ycbcrRange = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                        Int -> VkSamplerYcbcrRange -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkSamplerYcbcrConversionCreateInfo
-> FieldType "ycbcrRange" VkSamplerYcbcrConversionCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"ycbcrRange" VkSamplerYcbcrConversionCreateInfo
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
"components = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                              Int -> VkComponentMapping -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkSamplerYcbcrConversionCreateInfo
-> FieldType "components" VkSamplerYcbcrConversionCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"components" VkSamplerYcbcrConversionCreateInfo
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
"xChromaOffset = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                    Int -> VkChromaLocation -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkSamplerYcbcrConversionCreateInfo
-> FieldType "xChromaOffset" VkSamplerYcbcrConversionCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"xChromaOffset" VkSamplerYcbcrConversionCreateInfo
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
"yChromaOffset = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                          Int -> VkChromaLocation -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkSamplerYcbcrConversionCreateInfo
-> FieldType "yChromaOffset" VkSamplerYcbcrConversionCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"yChromaOffset" VkSamplerYcbcrConversionCreateInfo
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
"chromaFilter = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                Int -> VkFilter -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                                  (VkSamplerYcbcrConversionCreateInfo
-> FieldType "chromaFilter" VkSamplerYcbcrConversionCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"chromaFilter" VkSamplerYcbcrConversionCreateInfo
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
"forceExplicitReconstruction = "
                                                                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                                                      Int -> VkBool32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                                                                        (VkSamplerYcbcrConversionCreateInfo
-> FieldType
     "forceExplicitReconstruction" VkSamplerYcbcrConversionCreateInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField
                                                                           @"forceExplicitReconstruction"
                                                                           VkSamplerYcbcrConversionCreateInfo
x)
                                                                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | Alias for `VkSamplerYcbcrConversionCreateInfo`
type VkSamplerYcbcrConversionCreateInfoKHR =
     VkSamplerYcbcrConversionCreateInfo

-- | > typedef struct VkSamplerYcbcrConversionImageFormatProperties {
--   >     VkStructureType sType;
--   >     void*      pNext;
--   >     uint32_t                         combinedImageSamplerDescriptorCount;
--   > } VkSamplerYcbcrConversionImageFormatProperties;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkSamplerYcbcrConversionImageFormatProperties VkSamplerYcbcrConversionImageFormatProperties registry at www.khronos.org>
data VkSamplerYcbcrConversionImageFormatProperties = VkSamplerYcbcrConversionImageFormatProperties# Addr#
                                                                                                    ByteArray#

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

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

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

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal
           VkSamplerYcbcrConversionImageFormatProperties
         where
        type StructFields VkSamplerYcbcrConversionImageFormatProperties =
             '["sType", "pNext", "combinedImageSamplerDescriptorCount"] -- ' closing tick for hsc2hs
        type CUnionType VkSamplerYcbcrConversionImageFormatProperties =
             'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkSamplerYcbcrConversionImageFormatProperties =
             'True -- ' closing tick for hsc2hs
        type StructExtends VkSamplerYcbcrConversionImageFormatProperties =
             '[VkImageFormatProperties2] -- ' closing tick for hsc2hs

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

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

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

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

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

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

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

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

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

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

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

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

instance {-# OVERLAPPING #-}
         HasField "combinedImageSamplerDescriptorCount"
           VkSamplerYcbcrConversionImageFormatProperties
         where
        type FieldType "combinedImageSamplerDescriptorCount"
               VkSamplerYcbcrConversionImageFormatProperties
             = Word32
        type FieldOptional "combinedImageSamplerDescriptorCount"
               VkSamplerYcbcrConversionImageFormatProperties
             = 'False -- ' closing tick for hsc2hs
        type FieldOffset "combinedImageSamplerDescriptorCount"
               VkSamplerYcbcrConversionImageFormatProperties
             =
             (16)
{-# LINE 1666 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}
        type FieldIsArray "combinedImageSamplerDescriptorCount"
               VkSamplerYcbcrConversionImageFormatProperties
             = 'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkSamplerYcbcrConversionImageFormatProperties
-> IO
     (FieldType
        "combinedImageSamplerDescriptorCount"
        VkSamplerYcbcrConversionImageFormatProperties)
readField Ptr VkSamplerYcbcrConversionImageFormatProperties
p
          = Ptr VkSamplerYcbcrConversionImageFormatProperties
-> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSamplerYcbcrConversionImageFormatProperties
p (Int
16)
{-# LINE 1689 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "combinedImageSamplerDescriptorCount"
           VkSamplerYcbcrConversionImageFormatProperties
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSamplerYcbcrConversionImageFormatProperties
-> FieldType
     "combinedImageSamplerDescriptorCount"
     VkSamplerYcbcrConversionImageFormatProperties
-> IO ()
writeField Ptr VkSamplerYcbcrConversionImageFormatProperties
p
          = Ptr VkSamplerYcbcrConversionImageFormatProperties
-> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSamplerYcbcrConversionImageFormatProperties
p (Int
16)
{-# LINE 1697 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance Show VkSamplerYcbcrConversionImageFormatProperties where
        showsPrec :: Int -> VkSamplerYcbcrConversionImageFormatProperties -> ShowS
showsPrec Int
d VkSamplerYcbcrConversionImageFormatProperties
x
          = String -> ShowS
showString String
"VkSamplerYcbcrConversionImageFormatProperties {" 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 (VkSamplerYcbcrConversionImageFormatProperties
-> FieldType "sType" VkSamplerYcbcrConversionImageFormatProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkSamplerYcbcrConversionImageFormatProperties
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 (VkSamplerYcbcrConversionImageFormatProperties
-> FieldType "pNext" VkSamplerYcbcrConversionImageFormatProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkSamplerYcbcrConversionImageFormatProperties
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
"combinedImageSamplerDescriptorCount = " 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 (VkSamplerYcbcrConversionImageFormatProperties
-> FieldType
     "combinedImageSamplerDescriptorCount"
     VkSamplerYcbcrConversionImageFormatProperties
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"combinedImageSamplerDescriptorCount" VkSamplerYcbcrConversionImageFormatProperties
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              Char -> ShowS
showChar Char
'}'

-- | Alias for `VkSamplerYcbcrConversionImageFormatProperties`
type VkSamplerYcbcrConversionImageFormatPropertiesKHR =
     VkSamplerYcbcrConversionImageFormatProperties

-- | > typedef struct VkSamplerYcbcrConversionInfo {
--   >     VkStructureType sType;
--   >     const void*                      pNext;
--   >     VkSamplerYcbcrConversion      conversion;
--   > } VkSamplerYcbcrConversionInfo;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkSamplerYcbcrConversionInfo VkSamplerYcbcrConversionInfo registry at www.khronos.org>
data VkSamplerYcbcrConversionInfo = VkSamplerYcbcrConversionInfo# Addr#
                                                                  ByteArray#

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

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

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

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkSamplerYcbcrConversionInfo where
        type StructFields VkSamplerYcbcrConversionInfo =
             '["sType", "pNext", "conversion"] -- ' closing tick for hsc2hs
        type CUnionType VkSamplerYcbcrConversionInfo = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkSamplerYcbcrConversionInfo = 'False -- ' closing tick for hsc2hs
        type StructExtends VkSamplerYcbcrConversionInfo =
             '[VkSamplerCreateInfo, VkImageViewCreateInfo] -- ' closing tick for hsc2hs

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

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

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

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

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

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

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

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

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

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

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

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

instance {-# OVERLAPPING #-}
         HasField "conversion" VkSamplerYcbcrConversionInfo where
        type FieldType "conversion" VkSamplerYcbcrConversionInfo =
             VkSamplerYcbcrConversion
        type FieldOptional "conversion" VkSamplerYcbcrConversionInfo =
             'False -- ' closing tick for hsc2hs
        type FieldOffset "conversion" VkSamplerYcbcrConversionInfo =
             (16)
{-# LINE 1848 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}
        type FieldIsArray "conversion" VkSamplerYcbcrConversionInfo =
             'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkSamplerYcbcrConversionInfo
-> IO (FieldType "conversion" VkSamplerYcbcrConversionInfo)
readField Ptr VkSamplerYcbcrConversionInfo
p
          = Ptr VkSamplerYcbcrConversionInfo
-> Int -> IO VkSamplerYcbcrConversion
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkSamplerYcbcrConversionInfo
p (Int
16)
{-# LINE 1868 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "conversion" VkSamplerYcbcrConversionInfo where
        {-# INLINE writeField #-}
        writeField :: Ptr VkSamplerYcbcrConversionInfo
-> FieldType "conversion" VkSamplerYcbcrConversionInfo -> IO ()
writeField Ptr VkSamplerYcbcrConversionInfo
p
          = Ptr VkSamplerYcbcrConversionInfo
-> Int -> VkSamplerYcbcrConversion -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkSamplerYcbcrConversionInfo
p (Int
16)
{-# LINE 1874 "src-gen/Graphics/Vulkan/Types/Struct/Sampler.hsc" #-}

instance Show VkSamplerYcbcrConversionInfo where
        showsPrec :: Int -> VkSamplerYcbcrConversionInfo -> ShowS
showsPrec Int
d VkSamplerYcbcrConversionInfo
x
          = String -> ShowS
showString String
"VkSamplerYcbcrConversionInfo {" 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 (VkSamplerYcbcrConversionInfo
-> FieldType "sType" VkSamplerYcbcrConversionInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"sType" VkSamplerYcbcrConversionInfo
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 (VkSamplerYcbcrConversionInfo
-> FieldType "pNext" VkSamplerYcbcrConversionInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"pNext" VkSamplerYcbcrConversionInfo
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
"conversion = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkSamplerYcbcrConversion -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkSamplerYcbcrConversionInfo
-> FieldType "conversion" VkSamplerYcbcrConversionInfo
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"conversion" VkSamplerYcbcrConversionInfo
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | Alias for `VkSamplerYcbcrConversionInfo`
type VkSamplerYcbcrConversionInfoKHR = VkSamplerYcbcrConversionInfo