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


{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MagicHash             #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE Strict                #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE UndecidableInstances  #-}
module Graphics.Vulkan.Types.Struct.Clear
       (VkClearAttachment(..), VkClearColorValue(..),
        VkClearDepthStencilValue(..), VkClearRect(..), VkClearValue(..))
       where
import           Foreign.Storable                  (Storable (..))
import           GHC.Base                          (Addr#, ByteArray#, Proxy#,
                                                    byteArrayContents#,
                                                    plusAddr#, proxy#)
import           GHC.TypeLits                      (KnownNat, natVal') -- ' closing tick for hsc2hs
import           Graphics.Vulkan.Marshal
import           Graphics.Vulkan.Marshal.Internal
import           Graphics.Vulkan.Types.Enum.Image  (VkImageAspectFlags)
import           Graphics.Vulkan.Types.Struct.Rect (VkRect2D)
import           System.IO.Unsafe                  (unsafeDupablePerformIO)

-- | > typedef struct VkClearAttachment {
--   >     VkImageAspectFlags     aspectMask;
--   >     uint32_t               colorAttachment;
--   >     VkClearValue           clearValue;
--   > } VkClearAttachment;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkClearAttachment VkClearAttachment registry at www.khronos.org>
data VkClearAttachment = VkClearAttachment# Addr# ByteArray#

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

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

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

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkClearAttachment where
        type StructFields VkClearAttachment =
             '["aspectMask", "colorAttachment", "clearValue"] -- ' closing tick for hsc2hs
        type CUnionType VkClearAttachment = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkClearAttachment = 'False -- ' closing tick for hsc2hs
        type StructExtends VkClearAttachment = '[] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "aspectMask" VkClearAttachment where
        type FieldType "aspectMask" VkClearAttachment = VkImageAspectFlags
        type FieldOptional "aspectMask" VkClearAttachment = 'False -- ' closing tick for hsc2hs
        type FieldOffset "aspectMask" VkClearAttachment =
             (0)
{-# LINE 89 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}
        type FieldIsArray "aspectMask" VkClearAttachment = 'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkClearAttachment
-> IO (FieldType "aspectMask" VkClearAttachment)
readField Ptr VkClearAttachment
p
          = Ptr VkClearAttachment -> Int -> IO VkImageAspectFlags
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkClearAttachment
p (Int
0)
{-# LINE 107 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "aspectMask" VkClearAttachment where
        {-# INLINE writeField #-}
        writeField :: Ptr VkClearAttachment
-> FieldType "aspectMask" VkClearAttachment -> IO ()
writeField Ptr VkClearAttachment
p
          = Ptr VkClearAttachment -> Int -> VkImageAspectFlags -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkClearAttachment
p (Int
0)
{-# LINE 113 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}

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

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

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

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

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

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

instance {-# OVERLAPPING #-}
         HasField "clearValue" VkClearAttachment where
        type FieldType "clearValue" VkClearAttachment = VkClearValue
        type FieldOptional "clearValue" VkClearAttachment = 'False -- ' closing tick for hsc2hs
        type FieldOffset "clearValue" VkClearAttachment =
             (8)
{-# LINE 152 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}
        type FieldIsArray "clearValue" VkClearAttachment = 'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkClearAttachment
-> IO (FieldType "clearValue" VkClearAttachment)
readField Ptr VkClearAttachment
p
          = Ptr VkClearAttachment -> Int -> IO VkClearValue
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkClearAttachment
p (Int
8)
{-# LINE 170 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "clearValue" VkClearAttachment where
        {-# INLINE writeField #-}
        writeField :: Ptr VkClearAttachment
-> FieldType "clearValue" VkClearAttachment -> IO ()
writeField Ptr VkClearAttachment
p
          = Ptr VkClearAttachment -> Int -> VkClearValue -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkClearAttachment
p (Int
8)
{-# LINE 176 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}

instance Show VkClearAttachment where
        showsPrec :: Int -> VkClearAttachment -> ShowS
showsPrec Int
d VkClearAttachment
x
          = String -> ShowS
showString String
"VkClearAttachment {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              String -> ShowS
showString String
"aspectMask = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Int -> VkImageAspectFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkClearAttachment -> FieldType "aspectMask" VkClearAttachment
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"aspectMask" VkClearAttachment
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
"colorAttachment = " 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 (VkClearAttachment -> FieldType "colorAttachment" VkClearAttachment
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"colorAttachment" VkClearAttachment
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
"clearValue = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            Int -> VkClearValue -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (VkClearAttachment -> FieldType "clearValue" VkClearAttachment
forall (fname :: Symbol) a.
CanReadField fname a =>
a -> FieldType fname a
getField @"clearValue" VkClearAttachment
x) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | // Union allowing specification of floating point, integer, or unsigned integer color data. Actual value selected is based on image/attachment being cleared.
--
--   > typedef union VkClearColorValue {
--   >     float                  float32[4];
--   >     int32_t                int32[4];
--   >     uint32_t               uint32[4];
--   > } VkClearColorValue;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkClearColorValue VkClearColorValue registry at www.khronos.org>
data VkClearColorValue = VkClearColorValue# Addr# ByteArray#

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

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

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

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkClearColorValue where
        type StructFields VkClearColorValue =
             '["float32", "int32", "uint32"] -- ' closing tick for hsc2hs
        type CUnionType VkClearColorValue = 'True -- ' closing tick for hsc2hs
        type ReturnedOnly VkClearColorValue = 'False -- ' closing tick for hsc2hs
        type StructExtends VkClearColorValue = '[] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-} HasField "float32" VkClearColorValue
         where
        type FieldType "float32" VkClearColorValue =
             Float
{-# LINE 249 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}
        type FieldOptional "float32" VkClearColorValue = 'False -- ' closing tick for hsc2hs
        type FieldOffset "float32" VkClearColorValue =
             (0)
{-# LINE 252 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}
        type FieldIsArray "float32" VkClearColorValue = 'True -- ' closing tick for hsc2hs

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

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

instance {-# OVERLAPPING #-}
         (KnownNat idx, IndexInBounds "float32" idx VkClearColorValue) =>
         CanReadFieldArray "float32" idx VkClearColorValue
         where
        {-# SPECIALISE instance
                       CanReadFieldArray "float32" 0 VkClearColorValue #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "float32" 1 VkClearColorValue #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "float32" 2 VkClearColorValue #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "float32" 3 VkClearColorValue #-}
        type FieldArrayLength "float32" VkClearColorValue = 4

        {-# INLINE fieldArrayLength #-}
        fieldArrayLength :: Int
fieldArrayLength = Int
4

        {-# INLINE getFieldArray #-}
        getFieldArray :: VkClearColorValue -> FieldType "float32" VkClearColorValue
getFieldArray = VkClearColorValue -> Float
VkClearColorValue -> FieldType "float32" VkClearColorValue
f
          where {-# NOINLINE f #-}
                f :: VkClearColorValue -> Float
f VkClearColorValue
x = IO Float -> Float
forall a. IO a -> a
unsafeDupablePerformIO (Ptr VkClearColorValue -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkClearColorValue -> Ptr VkClearColorValue
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkClearColorValue
x) Int
off)
                off :: Int
off
                  = (Int
0) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
{-# LINE 286 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}
                      Float -> Int
forall a. Storable a => a -> Int
sizeOf (Float
forall a. HasCallStack => a
undefined :: Float) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
{-# LINE 287 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}
                        Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
proxy# :: Proxy# idx)) -- ' closing tick for hsc2hs

        {-# INLINE readFieldArray #-}
        readFieldArray :: Ptr VkClearColorValue -> IO (FieldType "float32" VkClearColorValue)
readFieldArray Ptr VkClearColorValue
p
          = Ptr VkClearColorValue -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkClearColorValue
p
              ((Int
0) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
{-# LINE 293 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}
                 Float -> Int
forall a. Storable a => a -> Int
sizeOf (Float
forall a. HasCallStack => a
undefined :: Float) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
{-# LINE 294 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         (KnownNat idx, IndexInBounds "float32" idx VkClearColorValue) =>
         CanWriteFieldArray "float32" idx VkClearColorValue
         where
        {-# SPECIALISE instance
                       CanWriteFieldArray "float32" 0 VkClearColorValue #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "float32" 1 VkClearColorValue #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "float32" 2 VkClearColorValue #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "float32" 3 VkClearColorValue #-}

        {-# INLINE writeFieldArray #-}
        writeFieldArray :: Ptr VkClearColorValue
-> FieldType "float32" VkClearColorValue -> IO ()
writeFieldArray Ptr VkClearColorValue
p
          = Ptr VkClearColorValue -> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkClearColorValue
p
              ((Int
0) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
{-# LINE 316 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}
                 Float -> Int
forall a. Storable a => a -> Int
sizeOf (Float
forall a. HasCallStack => a
undefined :: Float) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
{-# LINE 317 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-} HasField "int32" VkClearColorValue
         where
        type FieldType "int32" VkClearColorValue = Int32
        type FieldOptional "int32" VkClearColorValue = 'False -- ' closing tick for hsc2hs
        type FieldOffset "int32" VkClearColorValue =
             (0)
{-# LINE 325 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}
        type FieldIsArray "int32" VkClearColorValue = 'True -- ' closing tick for hsc2hs

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

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

instance {-# OVERLAPPING #-}
         (KnownNat idx, IndexInBounds "int32" idx VkClearColorValue) =>
         CanReadFieldArray "int32" idx VkClearColorValue
         where
        {-# SPECIALISE instance
                       CanReadFieldArray "int32" 0 VkClearColorValue #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "int32" 1 VkClearColorValue #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "int32" 2 VkClearColorValue #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "int32" 3 VkClearColorValue #-}
        type FieldArrayLength "int32" VkClearColorValue = 4

        {-# INLINE fieldArrayLength #-}
        fieldArrayLength :: Int
fieldArrayLength = Int
4

        {-# INLINE getFieldArray #-}
        getFieldArray :: VkClearColorValue -> FieldType "int32" VkClearColorValue
getFieldArray = VkClearColorValue -> Int32
VkClearColorValue -> FieldType "int32" VkClearColorValue
f
          where {-# NOINLINE f #-}
                f :: VkClearColorValue -> Int32
f VkClearColorValue
x = IO Int32 -> Int32
forall a. IO a -> a
unsafeDupablePerformIO (Ptr VkClearColorValue -> Int -> IO Int32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkClearColorValue -> Ptr VkClearColorValue
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkClearColorValue
x) Int
off)
                off :: Int
off
                  = (Int
0) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
{-# LINE 359 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}
                      Int32 -> Int
forall a. Storable a => a -> Int
sizeOf (Int32
forall a. HasCallStack => a
undefined :: Int32) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                        Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
proxy# :: Proxy# idx)) -- ' closing tick for hsc2hs

        {-# INLINE readFieldArray #-}
        readFieldArray :: Ptr VkClearColorValue -> IO (FieldType "int32" VkClearColorValue)
readFieldArray Ptr VkClearColorValue
p
          = Ptr VkClearColorValue -> Int -> IO Int32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkClearColorValue
p
              ((Int
0) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
{-# LINE 366 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}
                 Int32 -> Int
forall a. Storable a => a -> Int
sizeOf (Int32
forall a. HasCallStack => a
undefined :: Int32) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         (KnownNat idx, IndexInBounds "int32" idx VkClearColorValue) =>
         CanWriteFieldArray "int32" idx VkClearColorValue
         where
        {-# SPECIALISE instance
                       CanWriteFieldArray "int32" 0 VkClearColorValue #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "int32" 1 VkClearColorValue #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "int32" 2 VkClearColorValue #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "int32" 3 VkClearColorValue #-}

        {-# INLINE writeFieldArray #-}
        writeFieldArray :: Ptr VkClearColorValue
-> FieldType "int32" VkClearColorValue -> IO ()
writeFieldArray Ptr VkClearColorValue
p
          = Ptr VkClearColorValue -> Int -> Int32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkClearColorValue
p
              ((Int
0) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
{-# LINE 389 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}
                 Int32 -> Int
forall a. Storable a => a -> Int
sizeOf (Int32
forall a. HasCallStack => a
undefined :: Int32) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-} HasField "uint32" VkClearColorValue
         where
        type FieldType "uint32" VkClearColorValue = Word32
        type FieldOptional "uint32" VkClearColorValue = 'False -- ' closing tick for hsc2hs
        type FieldOffset "uint32" VkClearColorValue =
             (0)
{-# LINE 398 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}
        type FieldIsArray "uint32" VkClearColorValue = 'True -- ' closing tick for hsc2hs

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

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

instance {-# OVERLAPPING #-}
         (KnownNat idx, IndexInBounds "uint32" idx VkClearColorValue) =>
         CanReadFieldArray "uint32" idx VkClearColorValue
         where
        {-# SPECIALISE instance
                       CanReadFieldArray "uint32" 0 VkClearColorValue #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "uint32" 1 VkClearColorValue #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "uint32" 2 VkClearColorValue #-}

        {-# SPECIALISE instance
                       CanReadFieldArray "uint32" 3 VkClearColorValue #-}
        type FieldArrayLength "uint32" VkClearColorValue = 4

        {-# INLINE fieldArrayLength #-}
        fieldArrayLength :: Int
fieldArrayLength = Int
4

        {-# INLINE getFieldArray #-}
        getFieldArray :: VkClearColorValue -> FieldType "uint32" VkClearColorValue
getFieldArray = VkClearColorValue -> Word32
VkClearColorValue -> FieldType "uint32" VkClearColorValue
f
          where {-# NOINLINE f #-}
                f :: VkClearColorValue -> Word32
f VkClearColorValue
x = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO (Ptr VkClearColorValue -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkClearColorValue -> Ptr VkClearColorValue
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkClearColorValue
x) Int
off)
                off :: Int
off
                  = (Int
0) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
{-# LINE 432 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}
                      Word32 -> Int
forall a. Storable a => a -> Int
sizeOf (Word32
forall a. HasCallStack => a
undefined :: Word32) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                        Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
proxy# :: Proxy# idx)) -- ' closing tick for hsc2hs

        {-# INLINE readFieldArray #-}
        readFieldArray :: Ptr VkClearColorValue -> IO (FieldType "uint32" VkClearColorValue)
readFieldArray Ptr VkClearColorValue
p
          = Ptr VkClearColorValue -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkClearColorValue
p
              ((Int
0) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
{-# LINE 439 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}
                 Word32 -> Int
forall a. Storable a => a -> Int
sizeOf (Word32
forall a. HasCallStack => a
undefined :: Word32) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         (KnownNat idx, IndexInBounds "uint32" idx VkClearColorValue) =>
         CanWriteFieldArray "uint32" idx VkClearColorValue
         where
        {-# SPECIALISE instance
                       CanWriteFieldArray "uint32" 0 VkClearColorValue #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "uint32" 1 VkClearColorValue #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "uint32" 2 VkClearColorValue #-}

        {-# SPECIALISE instance
                       CanWriteFieldArray "uint32" 3 VkClearColorValue #-}

        {-# INLINE writeFieldArray #-}
        writeFieldArray :: Ptr VkClearColorValue
-> FieldType "uint32" VkClearColorValue -> IO ()
writeFieldArray Ptr VkClearColorValue
p
          = Ptr VkClearColorValue -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkClearColorValue
p
              ((Int
0) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
{-# LINE 462 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}
                 Word32 -> Int
forall a. Storable a => a -> Int
sizeOf (Word32
forall a. HasCallStack => a
undefined :: Word32) Int -> Int -> Int
forall a. Num a => a -> a -> a
*
                   Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# idx -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# idx
forall k (a :: k). Proxy# a
proxy# :: Proxy# idx))) -- ' closing tick for hsc2hs

instance Show VkClearColorValue where
        showsPrec :: Int -> VkClearColorValue -> ShowS
showsPrec Int
d VkClearColorValue
x
          = String -> ShowS
showString String
"VkClearColorValue {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              (String -> ShowS
showString String
"float32 = [" 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
                   (let s :: Int
s = Float -> Int
forall a. Storable a => a -> Int
sizeOf
                              (FieldType "float32" VkClearColorValue
forall a. HasCallStack => a
undefined :: FieldType "float32" VkClearColorValue)
                        o :: Int
o = HasField "float32" VkClearColorValue => Int
forall (fname :: Symbol) a. HasField fname a => Int
fieldOffset @"float32" @VkClearColorValue
                        f :: Int -> IO (FieldType "float32" VkClearColorValue)
f Int
i
                          = Ptr VkClearColorValue -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkClearColorValue -> Ptr VkClearColorValue
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkClearColorValue
x) Int
i ::
                              IO (FieldType "float32" VkClearColorValue)
                      in
                      IO [Float] -> [Float]
forall a. IO a -> a
unsafeDupablePerformIO (IO [Float] -> [Float])
-> ([Int] -> IO [Float]) -> [Int] -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> IO Float) -> [Int] -> IO [Float]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Int -> IO Float
Int -> IO (FieldType "float32" VkClearColorValue)
f ([Int] -> [Float]) -> [Int] -> [Float]
forall a b. (a -> b) -> a -> b
$
                        (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\ Int
i -> Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
s) [Int
0 .. Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1])
                   ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
']')
                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
"int32 = [" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                     Int -> [Int32] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d
                       (let s :: Int
s = Int32 -> Int
forall a. Storable a => a -> Int
sizeOf (FieldType "int32" VkClearColorValue
forall a. HasCallStack => a
undefined :: FieldType "int32" VkClearColorValue)
                            o :: Int
o = HasField "int32" VkClearColorValue => Int
forall (fname :: Symbol) a. HasField fname a => Int
fieldOffset @"int32" @VkClearColorValue
                            f :: Int -> IO (FieldType "int32" VkClearColorValue)
f Int
i
                              = Ptr VkClearColorValue -> Int -> IO Int32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkClearColorValue -> Ptr VkClearColorValue
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkClearColorValue
x) Int
i ::
                                  IO (FieldType "int32" VkClearColorValue)
                          in
                          IO [Int32] -> [Int32]
forall a. IO a -> a
unsafeDupablePerformIO (IO [Int32] -> [Int32])
-> ([Int] -> IO [Int32]) -> [Int] -> [Int32]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> IO Int32) -> [Int] -> IO [Int32]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Int -> IO Int32
Int -> IO (FieldType "int32" VkClearColorValue)
f ([Int] -> [Int32]) -> [Int] -> [Int32]
forall a b. (a -> b) -> a -> b
$
                            (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\ Int
i -> Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
s) [Int
0 .. Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1])
                       ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
']')
                    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
"uint32 = [" 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
                           (let s :: Int
s = Word32 -> Int
forall a. Storable a => a -> Int
sizeOf (FieldType "uint32" VkClearColorValue
forall a. HasCallStack => a
undefined :: FieldType "uint32" VkClearColorValue)
                                o :: Int
o = HasField "uint32" VkClearColorValue => Int
forall (fname :: Symbol) a. HasField fname a => Int
fieldOffset @"uint32" @VkClearColorValue
                                f :: Int -> IO (FieldType "uint32" VkClearColorValue)
f Int
i
                                  = Ptr VkClearColorValue -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (VkClearColorValue -> Ptr VkClearColorValue
forall a. VulkanMarshal a => a -> Ptr a
unsafePtr VkClearColorValue
x) Int
i ::
                                      IO (FieldType "uint32" VkClearColorValue)
                              in
                              IO [Word32] -> [Word32]
forall a. IO a -> a
unsafeDupablePerformIO (IO [Word32] -> [Word32])
-> ([Int] -> IO [Word32]) -> [Int] -> [Word32]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> IO Word32) -> [Int] -> IO [Word32]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Int -> IO Word32
Int -> IO (FieldType "uint32" VkClearColorValue)
f ([Int] -> [Word32]) -> [Int] -> [Word32]
forall a b. (a -> b) -> a -> b
$
                                (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\ Int
i -> Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
s) [Int
0 .. Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1])
                           ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
']')
                        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

-- | > typedef struct VkClearDepthStencilValue {
--   >     float                  depth;
--   >     uint32_t               stencil;
--   > } VkClearDepthStencilValue;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkClearDepthStencilValue VkClearDepthStencilValue registry at www.khronos.org>
data VkClearDepthStencilValue = VkClearDepthStencilValue# Addr#
                                                          ByteArray#

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

instance Storable VkClearDepthStencilValue where
        sizeOf :: VkClearDepthStencilValue -> Int
sizeOf ~VkClearDepthStencilValue
_ = (Int
8)
{-# LINE 531 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}

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

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkClearDepthStencilValue where
        type StructFields VkClearDepthStencilValue = '["depth", "stencil"] -- ' closing tick for hsc2hs
        type CUnionType VkClearDepthStencilValue = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkClearDepthStencilValue = 'False -- ' closing tick for hsc2hs
        type StructExtends VkClearDepthStencilValue = '[] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-}
         HasField "depth" VkClearDepthStencilValue where
        type FieldType "depth" VkClearDepthStencilValue =
             Float
{-# LINE 566 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}
        type FieldOptional "depth" VkClearDepthStencilValue = 'False -- ' closing tick for hsc2hs
        type FieldOffset "depth" VkClearDepthStencilValue =
             (0)
{-# LINE 569 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}
        type FieldIsArray "depth" VkClearDepthStencilValue = 'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkClearDepthStencilValue
-> IO (FieldType "depth" VkClearDepthStencilValue)
readField Ptr VkClearDepthStencilValue
p
          = Ptr VkClearDepthStencilValue -> Int -> IO Float
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkClearDepthStencilValue
p (Int
0)
{-# LINE 587 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "depth" VkClearDepthStencilValue where
        {-# INLINE writeField #-}
        writeField :: Ptr VkClearDepthStencilValue
-> FieldType "depth" VkClearDepthStencilValue -> IO ()
writeField Ptr VkClearDepthStencilValue
p
          = Ptr VkClearDepthStencilValue -> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkClearDepthStencilValue
p (Int
0)
{-# LINE 593 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}

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

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

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

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

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

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

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

-- | > typedef struct VkClearRect {
--   >     VkRect2D       rect;
--   >     uint32_t       baseArrayLayer;
--   >     uint32_t       layerCount;
--   > } VkClearRect;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkClearRect VkClearRect registry at www.khronos.org>
data VkClearRect = VkClearRect# Addr# ByteArray#

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

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

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

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkClearRect where
        type StructFields VkClearRect =
             '["rect", "baseArrayLayer", "layerCount"] -- ' closing tick for hsc2hs
        type CUnionType VkClearRect = 'False -- ' closing tick for hsc2hs
        type ReturnedOnly VkClearRect = 'False -- ' closing tick for hsc2hs
        type StructExtends VkClearRect = '[] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-} HasField "rect" VkClearRect where
        type FieldType "rect" VkClearRect = VkRect2D
        type FieldOptional "rect" VkClearRect = 'False -- ' closing tick for hsc2hs
        type FieldOffset "rect" VkClearRect =
             (0)
{-# LINE 694 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}
        type FieldIsArray "rect" VkClearRect = 'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkClearRect -> IO (FieldType "rect" VkClearRect)
readField Ptr VkClearRect
p = Ptr VkClearRect -> Int -> IO VkRect2D
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkClearRect
p (Int
0)
{-# LINE 710 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}

instance {-# OVERLAPPING #-} CanWriteField "rect" VkClearRect where
        {-# INLINE writeField #-}
        writeField :: Ptr VkClearRect -> FieldType "rect" VkClearRect -> IO ()
writeField Ptr VkClearRect
p
          = Ptr VkClearRect -> Int -> VkRect2D -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkClearRect
p (Int
0)
{-# LINE 715 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}

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

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

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

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

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

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

instance {-# OVERLAPPING #-} HasField "layerCount" VkClearRect
         where
        type FieldType "layerCount" VkClearRect = Word32
        type FieldOptional "layerCount" VkClearRect = 'False -- ' closing tick for hsc2hs
        type FieldOffset "layerCount" VkClearRect =
             (20)
{-# LINE 753 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}
        type FieldIsArray "layerCount" VkClearRect = 'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkClearRect -> IO (FieldType "layerCount" VkClearRect)
readField Ptr VkClearRect
p
          = Ptr VkClearRect -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkClearRect
p (Int
20)
{-# LINE 771 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}

instance {-# OVERLAPPING #-} CanWriteField "layerCount" VkClearRect
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkClearRect -> FieldType "layerCount" VkClearRect -> IO ()
writeField Ptr VkClearRect
p
          = Ptr VkClearRect -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkClearRect
p (Int
20)
{-# LINE 777 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}

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

-- | // Union allowing specification of color or depth and stencil values. Actual value selected is based on attachment being cleared.
--
--   > typedef union VkClearValue {
--   >     VkClearColorValue      color;
--   >     VkClearDepthStencilValue depthStencil;
--   > } VkClearValue;
--
--   <https://www.khronos.org/registry/vulkan/specs/1.1-extensions/html/vkspec.html#VkClearValue VkClearValue registry at www.khronos.org>
data VkClearValue = VkClearValue# Addr# ByteArray#

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

        {-# INLINE (==) #-}

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

        {-# INLINE compare #-}

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

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

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

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

        {-# INLINE poke #-}

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

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

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

        {-# INLINE unsafeFromByteArrayOffset #-}

instance VulkanMarshal VkClearValue where
        type StructFields VkClearValue = '["color", "depthStencil"] -- ' closing tick for hsc2hs
        type CUnionType VkClearValue = 'True -- ' closing tick for hsc2hs
        type ReturnedOnly VkClearValue = 'False -- ' closing tick for hsc2hs
        type StructExtends VkClearValue = '[] -- ' closing tick for hsc2hs

instance {-# OVERLAPPING #-} HasField "color" VkClearValue where
        type FieldType "color" VkClearValue = VkClearColorValue
        type FieldOptional "color" VkClearValue = 'False -- ' closing tick for hsc2hs
        type FieldOffset "color" VkClearValue =
             (0)
{-# LINE 849 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}
        type FieldIsArray "color" VkClearValue = 'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkClearValue -> IO (FieldType "color" VkClearValue)
readField Ptr VkClearValue
p
          = Ptr VkClearValue -> Int -> IO VkClearColorValue
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkClearValue
p (Int
0)
{-# LINE 867 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}

instance {-# OVERLAPPING #-} CanWriteField "color" VkClearValue
         where
        {-# INLINE writeField #-}
        writeField :: Ptr VkClearValue -> FieldType "color" VkClearValue -> IO ()
writeField Ptr VkClearValue
p
          = Ptr VkClearValue -> Int -> VkClearColorValue -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkClearValue
p (Int
0)
{-# LINE 873 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}

instance {-# OVERLAPPING #-} HasField "depthStencil" VkClearValue
         where
        type FieldType "depthStencil" VkClearValue =
             VkClearDepthStencilValue
        type FieldOptional "depthStencil" VkClearValue = 'False -- ' closing tick for hsc2hs
        type FieldOffset "depthStencil" VkClearValue =
             (0)
{-# LINE 881 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}
        type FieldIsArray "depthStencil" VkClearValue = 'False -- ' closing tick for hsc2hs

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

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

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

        {-# INLINE readField #-}
        readField :: Ptr VkClearValue -> IO (FieldType "depthStencil" VkClearValue)
readField Ptr VkClearValue
p
          = Ptr VkClearValue -> Int -> IO VkClearDepthStencilValue
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr VkClearValue
p (Int
0)
{-# LINE 899 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}

instance {-# OVERLAPPING #-}
         CanWriteField "depthStencil" VkClearValue where
        {-# INLINE writeField #-}
        writeField :: Ptr VkClearValue -> FieldType "depthStencil" VkClearValue -> IO ()
writeField Ptr VkClearValue
p
          = Ptr VkClearValue -> Int -> VkClearDepthStencilValue -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr VkClearValue
p (Int
0)
{-# LINE 905 "src-gen/Graphics/Vulkan/Types/Struct/Clear.hsc" #-}

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