{-# language CPP #-}
-- No documentation found for Chapter "Promoted_From_VK_KHR_format_feature_flags2"
module Vulkan.Core13.Promoted_From_VK_KHR_format_feature_flags2  ( FormatProperties3(..)
                                                                 , StructureType(..)
                                                                 , FormatFeatureFlagBits2(..)
                                                                 , FormatFeatureFlags2
                                                                 ) where

import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Vulkan.CStruct (FromCStruct)
import Vulkan.CStruct (FromCStruct(..))
import Vulkan.CStruct (ToCStruct)
import Vulkan.CStruct (ToCStruct(..))
import Vulkan.Zero (Zero(..))
import Data.Typeable (Typeable)
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import Foreign.Ptr (Ptr)
import Data.Kind (Type)
import Vulkan.Core13.Enums.FormatFeatureFlags2 (FormatFeatureFlags2)
import Vulkan.Core10.Enums.StructureType (StructureType)
import Vulkan.Core10.Enums.StructureType (StructureType(STRUCTURE_TYPE_FORMAT_PROPERTIES_3))
import Vulkan.Core13.Enums.FormatFeatureFlags2 (FormatFeatureFlagBits2(..))
import Vulkan.Core13.Enums.FormatFeatureFlags2 (FormatFeatureFlags2)
import Vulkan.Core10.Enums.StructureType (StructureType(..))
-- | VkFormatProperties3 - Structure specifying image format properties
--
-- = Description
--
-- The bits reported in @linearTilingFeatures@, @optimalTilingFeatures@ and
-- @bufferFeatures@ /must/ include the bits reported in the corresponding
-- fields of
-- 'Vulkan.Core11.Promoted_From_VK_KHR_get_physical_device_properties2.FormatProperties2'::@formatProperties@.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_KHR_format_feature_flags2 VK_KHR_format_feature_flags2>,
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VK_VERSION_1_3 VK_VERSION_1_3>,
-- 'Vulkan.Core13.Enums.FormatFeatureFlags2.FormatFeatureFlags2',
-- 'Vulkan.Core10.Enums.StructureType.StructureType'
data FormatProperties3 = FormatProperties3
  { -- | @linearTilingFeatures@ is a bitmask of
    -- 'Vulkan.Core13.Enums.FormatFeatureFlags2.FormatFeatureFlagBits2'
    -- specifying features supported by images created with a @tiling@
    -- parameter of 'Vulkan.Core10.Enums.ImageTiling.IMAGE_TILING_LINEAR'.
    FormatProperties3 -> FormatFeatureFlags2
linearTilingFeatures :: FormatFeatureFlags2
  , -- | @optimalTilingFeatures@ is a bitmask of
    -- 'Vulkan.Core13.Enums.FormatFeatureFlags2.FormatFeatureFlagBits2'
    -- specifying features supported by images created with a @tiling@
    -- parameter of 'Vulkan.Core10.Enums.ImageTiling.IMAGE_TILING_OPTIMAL'.
    FormatProperties3 -> FormatFeatureFlags2
optimalTilingFeatures :: FormatFeatureFlags2
  , -- | @bufferFeatures@ is a bitmask of
    -- 'Vulkan.Core13.Enums.FormatFeatureFlags2.FormatFeatureFlagBits2'
    -- specifying features supported by buffers.
    FormatProperties3 -> FormatFeatureFlags2
bufferFeatures :: FormatFeatureFlags2
  }
  deriving (Typeable, FormatProperties3 -> FormatProperties3 -> Bool
(FormatProperties3 -> FormatProperties3 -> Bool)
-> (FormatProperties3 -> FormatProperties3 -> Bool)
-> Eq FormatProperties3
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormatProperties3 -> FormatProperties3 -> Bool
$c/= :: FormatProperties3 -> FormatProperties3 -> Bool
== :: FormatProperties3 -> FormatProperties3 -> Bool
$c== :: FormatProperties3 -> FormatProperties3 -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (FormatProperties3)
#endif
deriving instance Show FormatProperties3

instance ToCStruct FormatProperties3 where
  withCStruct :: forall b.
FormatProperties3 -> (Ptr FormatProperties3 -> IO b) -> IO b
withCStruct FormatProperties3
x Ptr FormatProperties3 -> IO b
f = Int -> (Ptr FormatProperties3 -> IO b) -> IO b
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
40 ((Ptr FormatProperties3 -> IO b) -> IO b)
-> (Ptr FormatProperties3 -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr FormatProperties3
p -> Ptr FormatProperties3 -> FormatProperties3 -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr FormatProperties3
p FormatProperties3
x (Ptr FormatProperties3 -> IO b
f Ptr FormatProperties3
p)
  pokeCStruct :: forall b.
Ptr FormatProperties3 -> FormatProperties3 -> IO b -> IO b
pokeCStruct Ptr FormatProperties3
p FormatProperties3{FormatFeatureFlags2
bufferFeatures :: FormatFeatureFlags2
optimalTilingFeatures :: FormatFeatureFlags2
linearTilingFeatures :: FormatFeatureFlags2
$sel:bufferFeatures:FormatProperties3 :: FormatProperties3 -> FormatFeatureFlags2
$sel:optimalTilingFeatures:FormatProperties3 :: FormatProperties3 -> FormatFeatureFlags2
$sel:linearTilingFeatures:FormatProperties3 :: FormatProperties3 -> FormatFeatureFlags2
..} IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr FormatProperties3
p Ptr FormatProperties3 -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_FORMAT_PROPERTIES_3)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr FormatProperties3
p Ptr FormatProperties3 -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr FormatFeatureFlags2 -> FormatFeatureFlags2 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr FormatProperties3
p Ptr FormatProperties3 -> Int -> Ptr FormatFeatureFlags2
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr FormatFeatureFlags2)) (FormatFeatureFlags2
linearTilingFeatures)
    Ptr FormatFeatureFlags2 -> FormatFeatureFlags2 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr FormatProperties3
p Ptr FormatProperties3 -> Int -> Ptr FormatFeatureFlags2
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr FormatFeatureFlags2)) (FormatFeatureFlags2
optimalTilingFeatures)
    Ptr FormatFeatureFlags2 -> FormatFeatureFlags2 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr FormatProperties3
p Ptr FormatProperties3 -> Int -> Ptr FormatFeatureFlags2
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr FormatFeatureFlags2)) (FormatFeatureFlags2
bufferFeatures)
    IO b
f
  cStructSize :: Int
cStructSize = Int
40
  cStructAlignment :: Int
cStructAlignment = Int
8
  pokeZeroCStruct :: forall b. Ptr FormatProperties3 -> IO b -> IO b
pokeZeroCStruct Ptr FormatProperties3
p IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr FormatProperties3
p Ptr FormatProperties3 -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: Ptr StructureType)) (StructureType
STRUCTURE_TYPE_FORMAT_PROPERTIES_3)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr FormatProperties3
p Ptr FormatProperties3 -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO b
f

instance FromCStruct FormatProperties3 where
  peekCStruct :: Ptr FormatProperties3 -> IO FormatProperties3
peekCStruct Ptr FormatProperties3
p = do
    FormatFeatureFlags2
linearTilingFeatures <- forall a. Storable a => Ptr a -> IO a
peek @FormatFeatureFlags2 ((Ptr FormatProperties3
p Ptr FormatProperties3 -> Int -> Ptr FormatFeatureFlags2
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16 :: Ptr FormatFeatureFlags2))
    FormatFeatureFlags2
optimalTilingFeatures <- forall a. Storable a => Ptr a -> IO a
peek @FormatFeatureFlags2 ((Ptr FormatProperties3
p Ptr FormatProperties3 -> Int -> Ptr FormatFeatureFlags2
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24 :: Ptr FormatFeatureFlags2))
    FormatFeatureFlags2
bufferFeatures <- forall a. Storable a => Ptr a -> IO a
peek @FormatFeatureFlags2 ((Ptr FormatProperties3
p Ptr FormatProperties3 -> Int -> Ptr FormatFeatureFlags2
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32 :: Ptr FormatFeatureFlags2))
    FormatProperties3 -> IO FormatProperties3
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FormatProperties3 -> IO FormatProperties3)
-> FormatProperties3 -> IO FormatProperties3
forall a b. (a -> b) -> a -> b
$ FormatFeatureFlags2
-> FormatFeatureFlags2 -> FormatFeatureFlags2 -> FormatProperties3
FormatProperties3
             FormatFeatureFlags2
linearTilingFeatures FormatFeatureFlags2
optimalTilingFeatures FormatFeatureFlags2
bufferFeatures

instance Storable FormatProperties3 where
  sizeOf :: FormatProperties3 -> Int
sizeOf ~FormatProperties3
_ = Int
40
  alignment :: FormatProperties3 -> Int
alignment ~FormatProperties3
_ = Int
8
  peek :: Ptr FormatProperties3 -> IO FormatProperties3
peek = Ptr FormatProperties3 -> IO FormatProperties3
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr FormatProperties3 -> FormatProperties3 -> IO ()
poke Ptr FormatProperties3
ptr FormatProperties3
poked = Ptr FormatProperties3 -> FormatProperties3 -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr FormatProperties3
ptr FormatProperties3
poked (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero FormatProperties3 where
  zero :: FormatProperties3
zero = FormatFeatureFlags2
-> FormatFeatureFlags2 -> FormatFeatureFlags2 -> FormatProperties3
FormatProperties3
           FormatFeatureFlags2
forall a. Zero a => a
zero
           FormatFeatureFlags2
forall a. Zero a => a
zero
           FormatFeatureFlags2
forall a. Zero a => a
zero