{-# OPTIONS_HADDOCK ignore-exports#-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures             #-}
{-# LANGUAGE PatternSynonyms            #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE Strict                     #-}
{-# LANGUAGE TypeSynonymInstances       #-}
module Graphics.Vulkan.Types.Enum.Image
       (VkImageAspectBitmask(VkImageAspectBitmask, VkImageAspectFlags,
                             VkImageAspectFlagBits, VK_IMAGE_ASPECT_COLOR_BIT,
                             VK_IMAGE_ASPECT_DEPTH_BIT, VK_IMAGE_ASPECT_STENCIL_BIT,
                             VK_IMAGE_ASPECT_METADATA_BIT),
        VkImageAspectFlags, VkImageAspectFlagBits,
        VkImageCreateBitmask(VkImageCreateBitmask, VkImageCreateFlags,
                             VkImageCreateFlagBits, VK_IMAGE_CREATE_SPARSE_BINDING_BIT,
                             VK_IMAGE_CREATE_SPARSE_RESIDENCY_BIT,
                             VK_IMAGE_CREATE_SPARSE_ALIASED_BIT,
                             VK_IMAGE_CREATE_MUTABLE_FORMAT_BIT,
                             VK_IMAGE_CREATE_CUBE_COMPATIBLE_BIT),
        VkImageCreateFlags, VkImageCreateFlagBits,
        VkImageLayout(VkImageLayout, VK_IMAGE_LAYOUT_UNDEFINED,
                      VK_IMAGE_LAYOUT_GENERAL, VK_IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL,
                      VK_IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL,
                      VK_IMAGE_LAYOUT_DEPTH_STENCIL_READ_ONLY_OPTIMAL,
                      VK_IMAGE_LAYOUT_SHADER_READ_ONLY_OPTIMAL,
                      VK_IMAGE_LAYOUT_TRANSFER_SRC_OPTIMAL,
                      VK_IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL,
                      VK_IMAGE_LAYOUT_PREINITIALIZED),
        VkImageTiling(VkImageTiling, VK_IMAGE_TILING_OPTIMAL,
                      VK_IMAGE_TILING_LINEAR),
        VkImageType(VkImageType, VK_IMAGE_TYPE_1D, VK_IMAGE_TYPE_2D,
                    VK_IMAGE_TYPE_3D),
        VkImageUsageBitmask(VkImageUsageBitmask, VkImageUsageFlags,
                            VkImageUsageFlagBits, VK_IMAGE_USAGE_TRANSFER_SRC_BIT,
                            VK_IMAGE_USAGE_TRANSFER_DST_BIT, VK_IMAGE_USAGE_SAMPLED_BIT,
                            VK_IMAGE_USAGE_STORAGE_BIT, VK_IMAGE_USAGE_COLOR_ATTACHMENT_BIT,
                            VK_IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT,
                            VK_IMAGE_USAGE_TRANSIENT_ATTACHMENT_BIT,
                            VK_IMAGE_USAGE_INPUT_ATTACHMENT_BIT),
        VkImageUsageFlags, VkImageUsageFlagBits,
        VkImageViewCreateBitmask(VkImageViewCreateBitmask,
                                 VkImageViewCreateFlags, VkImageViewCreateFlagBits),
        VkImageViewCreateFlags, VkImageViewCreateFlagBits,
        VkImageViewType(VkImageViewType, VK_IMAGE_VIEW_TYPE_1D,
                        VK_IMAGE_VIEW_TYPE_2D, VK_IMAGE_VIEW_TYPE_3D,
                        VK_IMAGE_VIEW_TYPE_CUBE, VK_IMAGE_VIEW_TYPE_1D_ARRAY,
                        VK_IMAGE_VIEW_TYPE_2D_ARRAY, VK_IMAGE_VIEW_TYPE_CUBE_ARRAY))
       where
import Data.Bits                       (Bits, FiniteBits)
import Foreign.Storable                (Storable)
import GHC.Read                        (choose, expectP)
import Graphics.Vulkan.Marshal         (FlagBit, FlagMask, FlagType, Int32)
import Graphics.Vulkan.Types.BaseTypes (VkFlags (..))
import Text.ParserCombinators.ReadPrec (prec, step, (+++))
import Text.Read                       (Read (..), parens)
import Text.Read.Lex                   (Lexeme (..))

newtype VkImageAspectBitmask (a ::
                                FlagType) = VkImageAspectBitmask VkFlags
                                            deriving (VkImageAspectBitmask a -> VkImageAspectBitmask a -> Bool
(VkImageAspectBitmask a -> VkImageAspectBitmask a -> Bool)
-> (VkImageAspectBitmask a -> VkImageAspectBitmask a -> Bool)
-> Eq (VkImageAspectBitmask a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (a :: FlagType).
VkImageAspectBitmask a -> VkImageAspectBitmask a -> Bool
/= :: VkImageAspectBitmask a -> VkImageAspectBitmask a -> Bool
$c/= :: forall (a :: FlagType).
VkImageAspectBitmask a -> VkImageAspectBitmask a -> Bool
== :: VkImageAspectBitmask a -> VkImageAspectBitmask a -> Bool
$c== :: forall (a :: FlagType).
VkImageAspectBitmask a -> VkImageAspectBitmask a -> Bool
Eq, Eq (VkImageAspectBitmask a)
Eq (VkImageAspectBitmask a)
-> (VkImageAspectBitmask a -> VkImageAspectBitmask a -> Ordering)
-> (VkImageAspectBitmask a -> VkImageAspectBitmask a -> Bool)
-> (VkImageAspectBitmask a -> VkImageAspectBitmask a -> Bool)
-> (VkImageAspectBitmask a -> VkImageAspectBitmask a -> Bool)
-> (VkImageAspectBitmask a -> VkImageAspectBitmask a -> Bool)
-> (VkImageAspectBitmask a
    -> VkImageAspectBitmask a -> VkImageAspectBitmask a)
-> (VkImageAspectBitmask a
    -> VkImageAspectBitmask a -> VkImageAspectBitmask a)
-> Ord (VkImageAspectBitmask a)
VkImageAspectBitmask a -> VkImageAspectBitmask a -> Bool
VkImageAspectBitmask a -> VkImageAspectBitmask a -> Ordering
VkImageAspectBitmask a
-> VkImageAspectBitmask a -> VkImageAspectBitmask a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (a :: FlagType). Eq (VkImageAspectBitmask a)
forall (a :: FlagType).
VkImageAspectBitmask a -> VkImageAspectBitmask a -> Bool
forall (a :: FlagType).
VkImageAspectBitmask a -> VkImageAspectBitmask a -> Ordering
forall (a :: FlagType).
VkImageAspectBitmask a
-> VkImageAspectBitmask a -> VkImageAspectBitmask a
min :: VkImageAspectBitmask a
-> VkImageAspectBitmask a -> VkImageAspectBitmask a
$cmin :: forall (a :: FlagType).
VkImageAspectBitmask a
-> VkImageAspectBitmask a -> VkImageAspectBitmask a
max :: VkImageAspectBitmask a
-> VkImageAspectBitmask a -> VkImageAspectBitmask a
$cmax :: forall (a :: FlagType).
VkImageAspectBitmask a
-> VkImageAspectBitmask a -> VkImageAspectBitmask a
>= :: VkImageAspectBitmask a -> VkImageAspectBitmask a -> Bool
$c>= :: forall (a :: FlagType).
VkImageAspectBitmask a -> VkImageAspectBitmask a -> Bool
> :: VkImageAspectBitmask a -> VkImageAspectBitmask a -> Bool
$c> :: forall (a :: FlagType).
VkImageAspectBitmask a -> VkImageAspectBitmask a -> Bool
<= :: VkImageAspectBitmask a -> VkImageAspectBitmask a -> Bool
$c<= :: forall (a :: FlagType).
VkImageAspectBitmask a -> VkImageAspectBitmask a -> Bool
< :: VkImageAspectBitmask a -> VkImageAspectBitmask a -> Bool
$c< :: forall (a :: FlagType).
VkImageAspectBitmask a -> VkImageAspectBitmask a -> Bool
compare :: VkImageAspectBitmask a -> VkImageAspectBitmask a -> Ordering
$ccompare :: forall (a :: FlagType).
VkImageAspectBitmask a -> VkImageAspectBitmask a -> Ordering
Ord, Ptr (VkImageAspectBitmask a) -> IO (VkImageAspectBitmask a)
Ptr (VkImageAspectBitmask a) -> Int -> IO (VkImageAspectBitmask a)
Ptr (VkImageAspectBitmask a)
-> Int -> VkImageAspectBitmask a -> IO ()
Ptr (VkImageAspectBitmask a) -> VkImageAspectBitmask a -> IO ()
VkImageAspectBitmask a -> Int
(VkImageAspectBitmask a -> Int)
-> (VkImageAspectBitmask a -> Int)
-> (Ptr (VkImageAspectBitmask a)
    -> Int -> IO (VkImageAspectBitmask a))
-> (Ptr (VkImageAspectBitmask a)
    -> Int -> VkImageAspectBitmask a -> IO ())
-> (forall b. Ptr b -> Int -> IO (VkImageAspectBitmask a))
-> (forall b. Ptr b -> Int -> VkImageAspectBitmask a -> IO ())
-> (Ptr (VkImageAspectBitmask a) -> IO (VkImageAspectBitmask a))
-> (Ptr (VkImageAspectBitmask a)
    -> VkImageAspectBitmask a -> IO ())
-> Storable (VkImageAspectBitmask a)
forall b. Ptr b -> Int -> IO (VkImageAspectBitmask a)
forall b. Ptr b -> Int -> VkImageAspectBitmask a -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
forall (a :: FlagType).
Ptr (VkImageAspectBitmask a) -> IO (VkImageAspectBitmask a)
forall (a :: FlagType).
Ptr (VkImageAspectBitmask a) -> Int -> IO (VkImageAspectBitmask a)
forall (a :: FlagType).
Ptr (VkImageAspectBitmask a)
-> Int -> VkImageAspectBitmask a -> IO ()
forall (a :: FlagType).
Ptr (VkImageAspectBitmask a) -> VkImageAspectBitmask a -> IO ()
forall (a :: FlagType). VkImageAspectBitmask a -> Int
forall (a :: FlagType) b.
Ptr b -> Int -> IO (VkImageAspectBitmask a)
forall (a :: FlagType) b.
Ptr b -> Int -> VkImageAspectBitmask a -> IO ()
poke :: Ptr (VkImageAspectBitmask a) -> VkImageAspectBitmask a -> IO ()
$cpoke :: forall (a :: FlagType).
Ptr (VkImageAspectBitmask a) -> VkImageAspectBitmask a -> IO ()
peek :: Ptr (VkImageAspectBitmask a) -> IO (VkImageAspectBitmask a)
$cpeek :: forall (a :: FlagType).
Ptr (VkImageAspectBitmask a) -> IO (VkImageAspectBitmask a)
pokeByteOff :: forall b. Ptr b -> Int -> VkImageAspectBitmask a -> IO ()
$cpokeByteOff :: forall (a :: FlagType) b.
Ptr b -> Int -> VkImageAspectBitmask a -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO (VkImageAspectBitmask a)
$cpeekByteOff :: forall (a :: FlagType) b.
Ptr b -> Int -> IO (VkImageAspectBitmask a)
pokeElemOff :: Ptr (VkImageAspectBitmask a)
-> Int -> VkImageAspectBitmask a -> IO ()
$cpokeElemOff :: forall (a :: FlagType).
Ptr (VkImageAspectBitmask a)
-> Int -> VkImageAspectBitmask a -> IO ()
peekElemOff :: Ptr (VkImageAspectBitmask a) -> Int -> IO (VkImageAspectBitmask a)
$cpeekElemOff :: forall (a :: FlagType).
Ptr (VkImageAspectBitmask a) -> Int -> IO (VkImageAspectBitmask a)
alignment :: VkImageAspectBitmask a -> Int
$calignment :: forall (a :: FlagType). VkImageAspectBitmask a -> Int
sizeOf :: VkImageAspectBitmask a -> Int
$csizeOf :: forall (a :: FlagType). VkImageAspectBitmask a -> Int
Storable)

type VkImageAspectFlags = VkImageAspectBitmask FlagMask

type VkImageAspectFlagBits = VkImageAspectBitmask FlagBit

pattern VkImageAspectFlagBits ::
        VkFlags -> VkImageAspectBitmask FlagBit

pattern $bVkImageAspectFlagBits :: VkFlags -> VkImageAspectBitmask FlagBit
$mVkImageAspectFlagBits :: forall {r}.
VkImageAspectBitmask FlagBit -> (VkFlags -> r) -> (Void# -> r) -> r
VkImageAspectFlagBits n = VkImageAspectBitmask n

pattern VkImageAspectFlags ::
        VkFlags -> VkImageAspectBitmask FlagMask

pattern $bVkImageAspectFlags :: VkFlags -> VkImageAspectBitmask FlagMask
$mVkImageAspectFlags :: forall {r}.
VkImageAspectBitmask FlagMask
-> (VkFlags -> r) -> (Void# -> r) -> r
VkImageAspectFlags n = VkImageAspectBitmask n

deriving instance Bits (VkImageAspectBitmask FlagMask)

deriving instance FiniteBits (VkImageAspectBitmask FlagMask)

instance Show (VkImageAspectBitmask a) where
    showsPrec :: Int -> VkImageAspectBitmask a -> ShowS
showsPrec Int
_ VkImageAspectBitmask a
VK_IMAGE_ASPECT_COLOR_BIT
      = String -> ShowS
showString String
"VK_IMAGE_ASPECT_COLOR_BIT"
    showsPrec Int
_ VkImageAspectBitmask a
VK_IMAGE_ASPECT_DEPTH_BIT
      = String -> ShowS
showString String
"VK_IMAGE_ASPECT_DEPTH_BIT"
    showsPrec Int
_ VkImageAspectBitmask a
VK_IMAGE_ASPECT_STENCIL_BIT
      = String -> ShowS
showString String
"VK_IMAGE_ASPECT_STENCIL_BIT"
    showsPrec Int
_ VkImageAspectBitmask a
VK_IMAGE_ASPECT_METADATA_BIT
      = String -> ShowS
showString String
"VK_IMAGE_ASPECT_METADATA_BIT"
    showsPrec Int
p (VkImageAspectBitmask VkFlags
x)
      = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
          (String -> ShowS
showString String
"VkImageAspectBitmask " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> VkFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 VkFlags
x)

instance Read (VkImageAspectBitmask a) where
    readPrec :: ReadPrec (VkImageAspectBitmask a)
readPrec
      = ReadPrec (VkImageAspectBitmask a)
-> ReadPrec (VkImageAspectBitmask a)
forall a. ReadPrec a -> ReadPrec a
parens
          ([(String, ReadPrec (VkImageAspectBitmask a))]
-> ReadPrec (VkImageAspectBitmask a)
forall a. [(String, ReadPrec a)] -> ReadPrec a
choose
             [(String
"VK_IMAGE_ASPECT_COLOR_BIT", VkImageAspectBitmask a -> ReadPrec (VkImageAspectBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageAspectBitmask a
forall (a :: FlagType). VkImageAspectBitmask a
VK_IMAGE_ASPECT_COLOR_BIT),
              (String
"VK_IMAGE_ASPECT_DEPTH_BIT", VkImageAspectBitmask a -> ReadPrec (VkImageAspectBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageAspectBitmask a
forall (a :: FlagType). VkImageAspectBitmask a
VK_IMAGE_ASPECT_DEPTH_BIT),
              (String
"VK_IMAGE_ASPECT_STENCIL_BIT", VkImageAspectBitmask a -> ReadPrec (VkImageAspectBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageAspectBitmask a
forall (a :: FlagType). VkImageAspectBitmask a
VK_IMAGE_ASPECT_STENCIL_BIT),
              (String
"VK_IMAGE_ASPECT_METADATA_BIT",
               VkImageAspectBitmask a -> ReadPrec (VkImageAspectBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageAspectBitmask a
forall (a :: FlagType). VkImageAspectBitmask a
VK_IMAGE_ASPECT_METADATA_BIT)]
             ReadPrec (VkImageAspectBitmask a)
-> ReadPrec (VkImageAspectBitmask a)
-> ReadPrec (VkImageAspectBitmask a)
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
             Int
-> ReadPrec (VkImageAspectBitmask a)
-> ReadPrec (VkImageAspectBitmask a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10
               (Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident String
"VkImageAspectBitmask") ReadPrec ()
-> ReadPrec (VkImageAspectBitmask a)
-> ReadPrec (VkImageAspectBitmask a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  (VkFlags -> VkImageAspectBitmask a
forall (a :: FlagType). VkFlags -> VkImageAspectBitmask a
VkImageAspectBitmask (VkFlags -> VkImageAspectBitmask a)
-> ReadPrec VkFlags -> ReadPrec (VkImageAspectBitmask a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec VkFlags -> ReadPrec VkFlags
forall a. ReadPrec a -> ReadPrec a
step ReadPrec VkFlags
forall a. Read a => ReadPrec a
readPrec)))

-- | bitpos = @0@
pattern VK_IMAGE_ASPECT_COLOR_BIT :: VkImageAspectBitmask a

pattern $bVK_IMAGE_ASPECT_COLOR_BIT :: forall (a :: FlagType). VkImageAspectBitmask a
$mVK_IMAGE_ASPECT_COLOR_BIT :: forall {r} {a :: FlagType}.
VkImageAspectBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_ASPECT_COLOR_BIT = VkImageAspectBitmask 1

-- | bitpos = @1@
pattern VK_IMAGE_ASPECT_DEPTH_BIT :: VkImageAspectBitmask a

pattern $bVK_IMAGE_ASPECT_DEPTH_BIT :: forall (a :: FlagType). VkImageAspectBitmask a
$mVK_IMAGE_ASPECT_DEPTH_BIT :: forall {r} {a :: FlagType}.
VkImageAspectBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_ASPECT_DEPTH_BIT = VkImageAspectBitmask 2

-- | bitpos = @2@
pattern VK_IMAGE_ASPECT_STENCIL_BIT :: VkImageAspectBitmask a

pattern $bVK_IMAGE_ASPECT_STENCIL_BIT :: forall (a :: FlagType). VkImageAspectBitmask a
$mVK_IMAGE_ASPECT_STENCIL_BIT :: forall {r} {a :: FlagType}.
VkImageAspectBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_ASPECT_STENCIL_BIT = VkImageAspectBitmask 4

-- | bitpos = @3@
pattern VK_IMAGE_ASPECT_METADATA_BIT :: VkImageAspectBitmask a

pattern $bVK_IMAGE_ASPECT_METADATA_BIT :: forall (a :: FlagType). VkImageAspectBitmask a
$mVK_IMAGE_ASPECT_METADATA_BIT :: forall {r} {a :: FlagType}.
VkImageAspectBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_ASPECT_METADATA_BIT = VkImageAspectBitmask 8

newtype VkImageCreateBitmask (a ::
                                FlagType) = VkImageCreateBitmask VkFlags
                                            deriving (VkImageCreateBitmask a -> VkImageCreateBitmask a -> Bool
(VkImageCreateBitmask a -> VkImageCreateBitmask a -> Bool)
-> (VkImageCreateBitmask a -> VkImageCreateBitmask a -> Bool)
-> Eq (VkImageCreateBitmask a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (a :: FlagType).
VkImageCreateBitmask a -> VkImageCreateBitmask a -> Bool
/= :: VkImageCreateBitmask a -> VkImageCreateBitmask a -> Bool
$c/= :: forall (a :: FlagType).
VkImageCreateBitmask a -> VkImageCreateBitmask a -> Bool
== :: VkImageCreateBitmask a -> VkImageCreateBitmask a -> Bool
$c== :: forall (a :: FlagType).
VkImageCreateBitmask a -> VkImageCreateBitmask a -> Bool
Eq, Eq (VkImageCreateBitmask a)
Eq (VkImageCreateBitmask a)
-> (VkImageCreateBitmask a -> VkImageCreateBitmask a -> Ordering)
-> (VkImageCreateBitmask a -> VkImageCreateBitmask a -> Bool)
-> (VkImageCreateBitmask a -> VkImageCreateBitmask a -> Bool)
-> (VkImageCreateBitmask a -> VkImageCreateBitmask a -> Bool)
-> (VkImageCreateBitmask a -> VkImageCreateBitmask a -> Bool)
-> (VkImageCreateBitmask a
    -> VkImageCreateBitmask a -> VkImageCreateBitmask a)
-> (VkImageCreateBitmask a
    -> VkImageCreateBitmask a -> VkImageCreateBitmask a)
-> Ord (VkImageCreateBitmask a)
VkImageCreateBitmask a -> VkImageCreateBitmask a -> Bool
VkImageCreateBitmask a -> VkImageCreateBitmask a -> Ordering
VkImageCreateBitmask a
-> VkImageCreateBitmask a -> VkImageCreateBitmask a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (a :: FlagType). Eq (VkImageCreateBitmask a)
forall (a :: FlagType).
VkImageCreateBitmask a -> VkImageCreateBitmask a -> Bool
forall (a :: FlagType).
VkImageCreateBitmask a -> VkImageCreateBitmask a -> Ordering
forall (a :: FlagType).
VkImageCreateBitmask a
-> VkImageCreateBitmask a -> VkImageCreateBitmask a
min :: VkImageCreateBitmask a
-> VkImageCreateBitmask a -> VkImageCreateBitmask a
$cmin :: forall (a :: FlagType).
VkImageCreateBitmask a
-> VkImageCreateBitmask a -> VkImageCreateBitmask a
max :: VkImageCreateBitmask a
-> VkImageCreateBitmask a -> VkImageCreateBitmask a
$cmax :: forall (a :: FlagType).
VkImageCreateBitmask a
-> VkImageCreateBitmask a -> VkImageCreateBitmask a
>= :: VkImageCreateBitmask a -> VkImageCreateBitmask a -> Bool
$c>= :: forall (a :: FlagType).
VkImageCreateBitmask a -> VkImageCreateBitmask a -> Bool
> :: VkImageCreateBitmask a -> VkImageCreateBitmask a -> Bool
$c> :: forall (a :: FlagType).
VkImageCreateBitmask a -> VkImageCreateBitmask a -> Bool
<= :: VkImageCreateBitmask a -> VkImageCreateBitmask a -> Bool
$c<= :: forall (a :: FlagType).
VkImageCreateBitmask a -> VkImageCreateBitmask a -> Bool
< :: VkImageCreateBitmask a -> VkImageCreateBitmask a -> Bool
$c< :: forall (a :: FlagType).
VkImageCreateBitmask a -> VkImageCreateBitmask a -> Bool
compare :: VkImageCreateBitmask a -> VkImageCreateBitmask a -> Ordering
$ccompare :: forall (a :: FlagType).
VkImageCreateBitmask a -> VkImageCreateBitmask a -> Ordering
Ord, Ptr (VkImageCreateBitmask a) -> IO (VkImageCreateBitmask a)
Ptr (VkImageCreateBitmask a) -> Int -> IO (VkImageCreateBitmask a)
Ptr (VkImageCreateBitmask a)
-> Int -> VkImageCreateBitmask a -> IO ()
Ptr (VkImageCreateBitmask a) -> VkImageCreateBitmask a -> IO ()
VkImageCreateBitmask a -> Int
(VkImageCreateBitmask a -> Int)
-> (VkImageCreateBitmask a -> Int)
-> (Ptr (VkImageCreateBitmask a)
    -> Int -> IO (VkImageCreateBitmask a))
-> (Ptr (VkImageCreateBitmask a)
    -> Int -> VkImageCreateBitmask a -> IO ())
-> (forall b. Ptr b -> Int -> IO (VkImageCreateBitmask a))
-> (forall b. Ptr b -> Int -> VkImageCreateBitmask a -> IO ())
-> (Ptr (VkImageCreateBitmask a) -> IO (VkImageCreateBitmask a))
-> (Ptr (VkImageCreateBitmask a)
    -> VkImageCreateBitmask a -> IO ())
-> Storable (VkImageCreateBitmask a)
forall b. Ptr b -> Int -> IO (VkImageCreateBitmask a)
forall b. Ptr b -> Int -> VkImageCreateBitmask a -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
forall (a :: FlagType).
Ptr (VkImageCreateBitmask a) -> IO (VkImageCreateBitmask a)
forall (a :: FlagType).
Ptr (VkImageCreateBitmask a) -> Int -> IO (VkImageCreateBitmask a)
forall (a :: FlagType).
Ptr (VkImageCreateBitmask a)
-> Int -> VkImageCreateBitmask a -> IO ()
forall (a :: FlagType).
Ptr (VkImageCreateBitmask a) -> VkImageCreateBitmask a -> IO ()
forall (a :: FlagType). VkImageCreateBitmask a -> Int
forall (a :: FlagType) b.
Ptr b -> Int -> IO (VkImageCreateBitmask a)
forall (a :: FlagType) b.
Ptr b -> Int -> VkImageCreateBitmask a -> IO ()
poke :: Ptr (VkImageCreateBitmask a) -> VkImageCreateBitmask a -> IO ()
$cpoke :: forall (a :: FlagType).
Ptr (VkImageCreateBitmask a) -> VkImageCreateBitmask a -> IO ()
peek :: Ptr (VkImageCreateBitmask a) -> IO (VkImageCreateBitmask a)
$cpeek :: forall (a :: FlagType).
Ptr (VkImageCreateBitmask a) -> IO (VkImageCreateBitmask a)
pokeByteOff :: forall b. Ptr b -> Int -> VkImageCreateBitmask a -> IO ()
$cpokeByteOff :: forall (a :: FlagType) b.
Ptr b -> Int -> VkImageCreateBitmask a -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO (VkImageCreateBitmask a)
$cpeekByteOff :: forall (a :: FlagType) b.
Ptr b -> Int -> IO (VkImageCreateBitmask a)
pokeElemOff :: Ptr (VkImageCreateBitmask a)
-> Int -> VkImageCreateBitmask a -> IO ()
$cpokeElemOff :: forall (a :: FlagType).
Ptr (VkImageCreateBitmask a)
-> Int -> VkImageCreateBitmask a -> IO ()
peekElemOff :: Ptr (VkImageCreateBitmask a) -> Int -> IO (VkImageCreateBitmask a)
$cpeekElemOff :: forall (a :: FlagType).
Ptr (VkImageCreateBitmask a) -> Int -> IO (VkImageCreateBitmask a)
alignment :: VkImageCreateBitmask a -> Int
$calignment :: forall (a :: FlagType). VkImageCreateBitmask a -> Int
sizeOf :: VkImageCreateBitmask a -> Int
$csizeOf :: forall (a :: FlagType). VkImageCreateBitmask a -> Int
Storable)

type VkImageCreateFlags = VkImageCreateBitmask FlagMask

type VkImageCreateFlagBits = VkImageCreateBitmask FlagBit

pattern VkImageCreateFlagBits ::
        VkFlags -> VkImageCreateBitmask FlagBit

pattern $bVkImageCreateFlagBits :: VkFlags -> VkImageCreateBitmask FlagBit
$mVkImageCreateFlagBits :: forall {r}.
VkImageCreateBitmask FlagBit -> (VkFlags -> r) -> (Void# -> r) -> r
VkImageCreateFlagBits n = VkImageCreateBitmask n

pattern VkImageCreateFlags ::
        VkFlags -> VkImageCreateBitmask FlagMask

pattern $bVkImageCreateFlags :: VkFlags -> VkImageCreateBitmask FlagMask
$mVkImageCreateFlags :: forall {r}.
VkImageCreateBitmask FlagMask
-> (VkFlags -> r) -> (Void# -> r) -> r
VkImageCreateFlags n = VkImageCreateBitmask n

deriving instance Bits (VkImageCreateBitmask FlagMask)

deriving instance FiniteBits (VkImageCreateBitmask FlagMask)

instance Show (VkImageCreateBitmask a) where
    showsPrec :: Int -> VkImageCreateBitmask a -> ShowS
showsPrec Int
_ VkImageCreateBitmask a
VK_IMAGE_CREATE_SPARSE_BINDING_BIT
      = String -> ShowS
showString String
"VK_IMAGE_CREATE_SPARSE_BINDING_BIT"
    showsPrec Int
_ VkImageCreateBitmask a
VK_IMAGE_CREATE_SPARSE_RESIDENCY_BIT
      = String -> ShowS
showString String
"VK_IMAGE_CREATE_SPARSE_RESIDENCY_BIT"
    showsPrec Int
_ VkImageCreateBitmask a
VK_IMAGE_CREATE_SPARSE_ALIASED_BIT
      = String -> ShowS
showString String
"VK_IMAGE_CREATE_SPARSE_ALIASED_BIT"
    showsPrec Int
_ VkImageCreateBitmask a
VK_IMAGE_CREATE_MUTABLE_FORMAT_BIT
      = String -> ShowS
showString String
"VK_IMAGE_CREATE_MUTABLE_FORMAT_BIT"
    showsPrec Int
_ VkImageCreateBitmask a
VK_IMAGE_CREATE_CUBE_COMPATIBLE_BIT
      = String -> ShowS
showString String
"VK_IMAGE_CREATE_CUBE_COMPATIBLE_BIT"
    showsPrec Int
p (VkImageCreateBitmask VkFlags
x)
      = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
          (String -> ShowS
showString String
"VkImageCreateBitmask " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> VkFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 VkFlags
x)

instance Read (VkImageCreateBitmask a) where
    readPrec :: ReadPrec (VkImageCreateBitmask a)
readPrec
      = ReadPrec (VkImageCreateBitmask a)
-> ReadPrec (VkImageCreateBitmask a)
forall a. ReadPrec a -> ReadPrec a
parens
          ([(String, ReadPrec (VkImageCreateBitmask a))]
-> ReadPrec (VkImageCreateBitmask a)
forall a. [(String, ReadPrec a)] -> ReadPrec a
choose
             [(String
"VK_IMAGE_CREATE_SPARSE_BINDING_BIT",
               VkImageCreateBitmask a -> ReadPrec (VkImageCreateBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageCreateBitmask a
forall (a :: FlagType). VkImageCreateBitmask a
VK_IMAGE_CREATE_SPARSE_BINDING_BIT),
              (String
"VK_IMAGE_CREATE_SPARSE_RESIDENCY_BIT",
               VkImageCreateBitmask a -> ReadPrec (VkImageCreateBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageCreateBitmask a
forall (a :: FlagType). VkImageCreateBitmask a
VK_IMAGE_CREATE_SPARSE_RESIDENCY_BIT),
              (String
"VK_IMAGE_CREATE_SPARSE_ALIASED_BIT",
               VkImageCreateBitmask a -> ReadPrec (VkImageCreateBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageCreateBitmask a
forall (a :: FlagType). VkImageCreateBitmask a
VK_IMAGE_CREATE_SPARSE_ALIASED_BIT),
              (String
"VK_IMAGE_CREATE_MUTABLE_FORMAT_BIT",
               VkImageCreateBitmask a -> ReadPrec (VkImageCreateBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageCreateBitmask a
forall (a :: FlagType). VkImageCreateBitmask a
VK_IMAGE_CREATE_MUTABLE_FORMAT_BIT),
              (String
"VK_IMAGE_CREATE_CUBE_COMPATIBLE_BIT",
               VkImageCreateBitmask a -> ReadPrec (VkImageCreateBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageCreateBitmask a
forall (a :: FlagType). VkImageCreateBitmask a
VK_IMAGE_CREATE_CUBE_COMPATIBLE_BIT)]
             ReadPrec (VkImageCreateBitmask a)
-> ReadPrec (VkImageCreateBitmask a)
-> ReadPrec (VkImageCreateBitmask a)
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
             Int
-> ReadPrec (VkImageCreateBitmask a)
-> ReadPrec (VkImageCreateBitmask a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10
               (Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident String
"VkImageCreateBitmask") ReadPrec ()
-> ReadPrec (VkImageCreateBitmask a)
-> ReadPrec (VkImageCreateBitmask a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  (VkFlags -> VkImageCreateBitmask a
forall (a :: FlagType). VkFlags -> VkImageCreateBitmask a
VkImageCreateBitmask (VkFlags -> VkImageCreateBitmask a)
-> ReadPrec VkFlags -> ReadPrec (VkImageCreateBitmask a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec VkFlags -> ReadPrec VkFlags
forall a. ReadPrec a -> ReadPrec a
step ReadPrec VkFlags
forall a. Read a => ReadPrec a
readPrec)))

-- | Image should support sparse backing
--
--   bitpos = @0@
pattern VK_IMAGE_CREATE_SPARSE_BINDING_BIT ::
        VkImageCreateBitmask a

pattern $bVK_IMAGE_CREATE_SPARSE_BINDING_BIT :: forall (a :: FlagType). VkImageCreateBitmask a
$mVK_IMAGE_CREATE_SPARSE_BINDING_BIT :: forall {r} {a :: FlagType}.
VkImageCreateBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_CREATE_SPARSE_BINDING_BIT = VkImageCreateBitmask 1

-- | Image should support sparse backing with partial residency
--
--   bitpos = @1@
pattern VK_IMAGE_CREATE_SPARSE_RESIDENCY_BIT ::
        VkImageCreateBitmask a

pattern $bVK_IMAGE_CREATE_SPARSE_RESIDENCY_BIT :: forall (a :: FlagType). VkImageCreateBitmask a
$mVK_IMAGE_CREATE_SPARSE_RESIDENCY_BIT :: forall {r} {a :: FlagType}.
VkImageCreateBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_CREATE_SPARSE_RESIDENCY_BIT =
        VkImageCreateBitmask 2

-- | Image should support constent data access to physical memory ranges mapped into multiple locations of sparse images
--
--   bitpos = @2@
pattern VK_IMAGE_CREATE_SPARSE_ALIASED_BIT ::
        VkImageCreateBitmask a

pattern $bVK_IMAGE_CREATE_SPARSE_ALIASED_BIT :: forall (a :: FlagType). VkImageCreateBitmask a
$mVK_IMAGE_CREATE_SPARSE_ALIASED_BIT :: forall {r} {a :: FlagType}.
VkImageCreateBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_CREATE_SPARSE_ALIASED_BIT = VkImageCreateBitmask 4

-- | Allows image views to have different format than the base image
--
--   bitpos = @3@
pattern VK_IMAGE_CREATE_MUTABLE_FORMAT_BIT ::
        VkImageCreateBitmask a

pattern $bVK_IMAGE_CREATE_MUTABLE_FORMAT_BIT :: forall (a :: FlagType). VkImageCreateBitmask a
$mVK_IMAGE_CREATE_MUTABLE_FORMAT_BIT :: forall {r} {a :: FlagType}.
VkImageCreateBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_CREATE_MUTABLE_FORMAT_BIT = VkImageCreateBitmask 8

-- | Allows creating image views with cube type from the created image
--
--   bitpos = @4@
pattern VK_IMAGE_CREATE_CUBE_COMPATIBLE_BIT ::
        VkImageCreateBitmask a

pattern $bVK_IMAGE_CREATE_CUBE_COMPATIBLE_BIT :: forall (a :: FlagType). VkImageCreateBitmask a
$mVK_IMAGE_CREATE_CUBE_COMPATIBLE_BIT :: forall {r} {a :: FlagType}.
VkImageCreateBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_CREATE_CUBE_COMPATIBLE_BIT =
        VkImageCreateBitmask 16

-- | type = @enum@
--
--   <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkImageLayout VkImageLayout registry at www.khronos.org>
newtype VkImageLayout = VkImageLayout Int32
                        deriving (VkImageLayout -> VkImageLayout -> Bool
(VkImageLayout -> VkImageLayout -> Bool)
-> (VkImageLayout -> VkImageLayout -> Bool) -> Eq VkImageLayout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VkImageLayout -> VkImageLayout -> Bool
$c/= :: VkImageLayout -> VkImageLayout -> Bool
== :: VkImageLayout -> VkImageLayout -> Bool
$c== :: VkImageLayout -> VkImageLayout -> Bool
Eq, Eq VkImageLayout
Eq VkImageLayout
-> (VkImageLayout -> VkImageLayout -> Ordering)
-> (VkImageLayout -> VkImageLayout -> Bool)
-> (VkImageLayout -> VkImageLayout -> Bool)
-> (VkImageLayout -> VkImageLayout -> Bool)
-> (VkImageLayout -> VkImageLayout -> Bool)
-> (VkImageLayout -> VkImageLayout -> VkImageLayout)
-> (VkImageLayout -> VkImageLayout -> VkImageLayout)
-> Ord VkImageLayout
VkImageLayout -> VkImageLayout -> Bool
VkImageLayout -> VkImageLayout -> Ordering
VkImageLayout -> VkImageLayout -> VkImageLayout
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VkImageLayout -> VkImageLayout -> VkImageLayout
$cmin :: VkImageLayout -> VkImageLayout -> VkImageLayout
max :: VkImageLayout -> VkImageLayout -> VkImageLayout
$cmax :: VkImageLayout -> VkImageLayout -> VkImageLayout
>= :: VkImageLayout -> VkImageLayout -> Bool
$c>= :: VkImageLayout -> VkImageLayout -> Bool
> :: VkImageLayout -> VkImageLayout -> Bool
$c> :: VkImageLayout -> VkImageLayout -> Bool
<= :: VkImageLayout -> VkImageLayout -> Bool
$c<= :: VkImageLayout -> VkImageLayout -> Bool
< :: VkImageLayout -> VkImageLayout -> Bool
$c< :: VkImageLayout -> VkImageLayout -> Bool
compare :: VkImageLayout -> VkImageLayout -> Ordering
$ccompare :: VkImageLayout -> VkImageLayout -> Ordering
Ord, Int -> VkImageLayout
VkImageLayout -> Int
VkImageLayout -> [VkImageLayout]
VkImageLayout -> VkImageLayout
VkImageLayout -> VkImageLayout -> [VkImageLayout]
VkImageLayout -> VkImageLayout -> VkImageLayout -> [VkImageLayout]
(VkImageLayout -> VkImageLayout)
-> (VkImageLayout -> VkImageLayout)
-> (Int -> VkImageLayout)
-> (VkImageLayout -> Int)
-> (VkImageLayout -> [VkImageLayout])
-> (VkImageLayout -> VkImageLayout -> [VkImageLayout])
-> (VkImageLayout -> VkImageLayout -> [VkImageLayout])
-> (VkImageLayout
    -> VkImageLayout -> VkImageLayout -> [VkImageLayout])
-> Enum VkImageLayout
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: VkImageLayout -> VkImageLayout -> VkImageLayout -> [VkImageLayout]
$cenumFromThenTo :: VkImageLayout -> VkImageLayout -> VkImageLayout -> [VkImageLayout]
enumFromTo :: VkImageLayout -> VkImageLayout -> [VkImageLayout]
$cenumFromTo :: VkImageLayout -> VkImageLayout -> [VkImageLayout]
enumFromThen :: VkImageLayout -> VkImageLayout -> [VkImageLayout]
$cenumFromThen :: VkImageLayout -> VkImageLayout -> [VkImageLayout]
enumFrom :: VkImageLayout -> [VkImageLayout]
$cenumFrom :: VkImageLayout -> [VkImageLayout]
fromEnum :: VkImageLayout -> Int
$cfromEnum :: VkImageLayout -> Int
toEnum :: Int -> VkImageLayout
$ctoEnum :: Int -> VkImageLayout
pred :: VkImageLayout -> VkImageLayout
$cpred :: VkImageLayout -> VkImageLayout
succ :: VkImageLayout -> VkImageLayout
$csucc :: VkImageLayout -> VkImageLayout
Enum, Ptr VkImageLayout -> IO VkImageLayout
Ptr VkImageLayout -> Int -> IO VkImageLayout
Ptr VkImageLayout -> Int -> VkImageLayout -> IO ()
Ptr VkImageLayout -> VkImageLayout -> IO ()
VkImageLayout -> Int
(VkImageLayout -> Int)
-> (VkImageLayout -> Int)
-> (Ptr VkImageLayout -> Int -> IO VkImageLayout)
-> (Ptr VkImageLayout -> Int -> VkImageLayout -> IO ())
-> (forall b. Ptr b -> Int -> IO VkImageLayout)
-> (forall b. Ptr b -> Int -> VkImageLayout -> IO ())
-> (Ptr VkImageLayout -> IO VkImageLayout)
-> (Ptr VkImageLayout -> VkImageLayout -> IO ())
-> Storable VkImageLayout
forall b. Ptr b -> Int -> IO VkImageLayout
forall b. Ptr b -> Int -> VkImageLayout -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr VkImageLayout -> VkImageLayout -> IO ()
$cpoke :: Ptr VkImageLayout -> VkImageLayout -> IO ()
peek :: Ptr VkImageLayout -> IO VkImageLayout
$cpeek :: Ptr VkImageLayout -> IO VkImageLayout
pokeByteOff :: forall b. Ptr b -> Int -> VkImageLayout -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> VkImageLayout -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO VkImageLayout
$cpeekByteOff :: forall b. Ptr b -> Int -> IO VkImageLayout
pokeElemOff :: Ptr VkImageLayout -> Int -> VkImageLayout -> IO ()
$cpokeElemOff :: Ptr VkImageLayout -> Int -> VkImageLayout -> IO ()
peekElemOff :: Ptr VkImageLayout -> Int -> IO VkImageLayout
$cpeekElemOff :: Ptr VkImageLayout -> Int -> IO VkImageLayout
alignment :: VkImageLayout -> Int
$calignment :: VkImageLayout -> Int
sizeOf :: VkImageLayout -> Int
$csizeOf :: VkImageLayout -> Int
Storable)

instance Show VkImageLayout where
    showsPrec :: Int -> VkImageLayout -> ShowS
showsPrec Int
_ VkImageLayout
VK_IMAGE_LAYOUT_UNDEFINED
      = String -> ShowS
showString String
"VK_IMAGE_LAYOUT_UNDEFINED"
    showsPrec Int
_ VkImageLayout
VK_IMAGE_LAYOUT_GENERAL
      = String -> ShowS
showString String
"VK_IMAGE_LAYOUT_GENERAL"
    showsPrec Int
_ VkImageLayout
VK_IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL
      = String -> ShowS
showString String
"VK_IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL"
    showsPrec Int
_ VkImageLayout
VK_IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL
      = String -> ShowS
showString String
"VK_IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL"
    showsPrec Int
_ VkImageLayout
VK_IMAGE_LAYOUT_DEPTH_STENCIL_READ_ONLY_OPTIMAL
      = String -> ShowS
showString String
"VK_IMAGE_LAYOUT_DEPTH_STENCIL_READ_ONLY_OPTIMAL"
    showsPrec Int
_ VkImageLayout
VK_IMAGE_LAYOUT_SHADER_READ_ONLY_OPTIMAL
      = String -> ShowS
showString String
"VK_IMAGE_LAYOUT_SHADER_READ_ONLY_OPTIMAL"
    showsPrec Int
_ VkImageLayout
VK_IMAGE_LAYOUT_TRANSFER_SRC_OPTIMAL
      = String -> ShowS
showString String
"VK_IMAGE_LAYOUT_TRANSFER_SRC_OPTIMAL"
    showsPrec Int
_ VkImageLayout
VK_IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL
      = String -> ShowS
showString String
"VK_IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL"
    showsPrec Int
_ VkImageLayout
VK_IMAGE_LAYOUT_PREINITIALIZED
      = String -> ShowS
showString String
"VK_IMAGE_LAYOUT_PREINITIALIZED"
    showsPrec Int
p (VkImageLayout Int32
x)
      = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
          (String -> ShowS
showString String
"VkImageLayout " 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
11 Int32
x)

instance Read VkImageLayout where
    readPrec :: ReadPrec VkImageLayout
readPrec
      = ReadPrec VkImageLayout -> ReadPrec VkImageLayout
forall a. ReadPrec a -> ReadPrec a
parens
          ([(String, ReadPrec VkImageLayout)] -> ReadPrec VkImageLayout
forall a. [(String, ReadPrec a)] -> ReadPrec a
choose
             [(String
"VK_IMAGE_LAYOUT_UNDEFINED", VkImageLayout -> ReadPrec VkImageLayout
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageLayout
VK_IMAGE_LAYOUT_UNDEFINED),
              (String
"VK_IMAGE_LAYOUT_GENERAL", VkImageLayout -> ReadPrec VkImageLayout
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageLayout
VK_IMAGE_LAYOUT_GENERAL),
              (String
"VK_IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL",
               VkImageLayout -> ReadPrec VkImageLayout
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageLayout
VK_IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL),
              (String
"VK_IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL",
               VkImageLayout -> ReadPrec VkImageLayout
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageLayout
VK_IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL),
              (String
"VK_IMAGE_LAYOUT_DEPTH_STENCIL_READ_ONLY_OPTIMAL",
               VkImageLayout -> ReadPrec VkImageLayout
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageLayout
VK_IMAGE_LAYOUT_DEPTH_STENCIL_READ_ONLY_OPTIMAL),
              (String
"VK_IMAGE_LAYOUT_SHADER_READ_ONLY_OPTIMAL",
               VkImageLayout -> ReadPrec VkImageLayout
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageLayout
VK_IMAGE_LAYOUT_SHADER_READ_ONLY_OPTIMAL),
              (String
"VK_IMAGE_LAYOUT_TRANSFER_SRC_OPTIMAL",
               VkImageLayout -> ReadPrec VkImageLayout
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageLayout
VK_IMAGE_LAYOUT_TRANSFER_SRC_OPTIMAL),
              (String
"VK_IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL",
               VkImageLayout -> ReadPrec VkImageLayout
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageLayout
VK_IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL),
              (String
"VK_IMAGE_LAYOUT_PREINITIALIZED",
               VkImageLayout -> ReadPrec VkImageLayout
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageLayout
VK_IMAGE_LAYOUT_PREINITIALIZED)]
             ReadPrec VkImageLayout
-> ReadPrec VkImageLayout -> ReadPrec VkImageLayout
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
             Int -> ReadPrec VkImageLayout -> ReadPrec VkImageLayout
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10
               (Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident String
"VkImageLayout") ReadPrec () -> ReadPrec VkImageLayout -> ReadPrec VkImageLayout
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  (Int32 -> VkImageLayout
VkImageLayout (Int32 -> VkImageLayout)
-> ReadPrec Int32 -> ReadPrec VkImageLayout
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec Int32 -> ReadPrec Int32
forall a. ReadPrec a -> ReadPrec a
step ReadPrec Int32
forall a. Read a => ReadPrec a
readPrec)))

-- | Implicit layout an image is when its contents are undefined due to various reasons (e.g. right after creation)
pattern VK_IMAGE_LAYOUT_UNDEFINED :: VkImageLayout

pattern $bVK_IMAGE_LAYOUT_UNDEFINED :: VkImageLayout
$mVK_IMAGE_LAYOUT_UNDEFINED :: forall {r}. VkImageLayout -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_LAYOUT_UNDEFINED = VkImageLayout 0

-- | General layout when image can be used for any kind of access
pattern VK_IMAGE_LAYOUT_GENERAL :: VkImageLayout

pattern $bVK_IMAGE_LAYOUT_GENERAL :: VkImageLayout
$mVK_IMAGE_LAYOUT_GENERAL :: forall {r}. VkImageLayout -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_LAYOUT_GENERAL = VkImageLayout 1

-- | Optimal layout when image is only used for color attachment read/write
pattern VK_IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL :: VkImageLayout

pattern $bVK_IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL :: VkImageLayout
$mVK_IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL :: forall {r}. VkImageLayout -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL = VkImageLayout 2

-- | Optimal layout when image is only used for depth/stencil attachment read/write
pattern VK_IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL ::
        VkImageLayout

pattern $bVK_IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL :: VkImageLayout
$mVK_IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL :: forall {r}. VkImageLayout -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL =
        VkImageLayout 3

-- | Optimal layout when image is used for read only depth/stencil attachment and shader access
pattern VK_IMAGE_LAYOUT_DEPTH_STENCIL_READ_ONLY_OPTIMAL ::
        VkImageLayout

pattern $bVK_IMAGE_LAYOUT_DEPTH_STENCIL_READ_ONLY_OPTIMAL :: VkImageLayout
$mVK_IMAGE_LAYOUT_DEPTH_STENCIL_READ_ONLY_OPTIMAL :: forall {r}. VkImageLayout -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_LAYOUT_DEPTH_STENCIL_READ_ONLY_OPTIMAL =
        VkImageLayout 4

-- | Optimal layout when image is used for read only shader access
pattern VK_IMAGE_LAYOUT_SHADER_READ_ONLY_OPTIMAL :: VkImageLayout

pattern $bVK_IMAGE_LAYOUT_SHADER_READ_ONLY_OPTIMAL :: VkImageLayout
$mVK_IMAGE_LAYOUT_SHADER_READ_ONLY_OPTIMAL :: forall {r}. VkImageLayout -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_LAYOUT_SHADER_READ_ONLY_OPTIMAL = VkImageLayout 5

-- | Optimal layout when image is used only as source of transfer operations
pattern VK_IMAGE_LAYOUT_TRANSFER_SRC_OPTIMAL :: VkImageLayout

pattern $bVK_IMAGE_LAYOUT_TRANSFER_SRC_OPTIMAL :: VkImageLayout
$mVK_IMAGE_LAYOUT_TRANSFER_SRC_OPTIMAL :: forall {r}. VkImageLayout -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_LAYOUT_TRANSFER_SRC_OPTIMAL = VkImageLayout 6

-- | Optimal layout when image is used only as destination of transfer operations
pattern VK_IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL :: VkImageLayout

pattern $bVK_IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL :: VkImageLayout
$mVK_IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL :: forall {r}. VkImageLayout -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL = VkImageLayout 7

-- | Initial layout used when the data is populated by the CPU
pattern VK_IMAGE_LAYOUT_PREINITIALIZED :: VkImageLayout

pattern $bVK_IMAGE_LAYOUT_PREINITIALIZED :: VkImageLayout
$mVK_IMAGE_LAYOUT_PREINITIALIZED :: forall {r}. VkImageLayout -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_LAYOUT_PREINITIALIZED = VkImageLayout 8

-- | type = @enum@
--
--   <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkImageTiling VkImageTiling registry at www.khronos.org>
newtype VkImageTiling = VkImageTiling Int32
                        deriving (VkImageTiling -> VkImageTiling -> Bool
(VkImageTiling -> VkImageTiling -> Bool)
-> (VkImageTiling -> VkImageTiling -> Bool) -> Eq VkImageTiling
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VkImageTiling -> VkImageTiling -> Bool
$c/= :: VkImageTiling -> VkImageTiling -> Bool
== :: VkImageTiling -> VkImageTiling -> Bool
$c== :: VkImageTiling -> VkImageTiling -> Bool
Eq, Eq VkImageTiling
Eq VkImageTiling
-> (VkImageTiling -> VkImageTiling -> Ordering)
-> (VkImageTiling -> VkImageTiling -> Bool)
-> (VkImageTiling -> VkImageTiling -> Bool)
-> (VkImageTiling -> VkImageTiling -> Bool)
-> (VkImageTiling -> VkImageTiling -> Bool)
-> (VkImageTiling -> VkImageTiling -> VkImageTiling)
-> (VkImageTiling -> VkImageTiling -> VkImageTiling)
-> Ord VkImageTiling
VkImageTiling -> VkImageTiling -> Bool
VkImageTiling -> VkImageTiling -> Ordering
VkImageTiling -> VkImageTiling -> VkImageTiling
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VkImageTiling -> VkImageTiling -> VkImageTiling
$cmin :: VkImageTiling -> VkImageTiling -> VkImageTiling
max :: VkImageTiling -> VkImageTiling -> VkImageTiling
$cmax :: VkImageTiling -> VkImageTiling -> VkImageTiling
>= :: VkImageTiling -> VkImageTiling -> Bool
$c>= :: VkImageTiling -> VkImageTiling -> Bool
> :: VkImageTiling -> VkImageTiling -> Bool
$c> :: VkImageTiling -> VkImageTiling -> Bool
<= :: VkImageTiling -> VkImageTiling -> Bool
$c<= :: VkImageTiling -> VkImageTiling -> Bool
< :: VkImageTiling -> VkImageTiling -> Bool
$c< :: VkImageTiling -> VkImageTiling -> Bool
compare :: VkImageTiling -> VkImageTiling -> Ordering
$ccompare :: VkImageTiling -> VkImageTiling -> Ordering
Ord, Int -> VkImageTiling
VkImageTiling -> Int
VkImageTiling -> [VkImageTiling]
VkImageTiling -> VkImageTiling
VkImageTiling -> VkImageTiling -> [VkImageTiling]
VkImageTiling -> VkImageTiling -> VkImageTiling -> [VkImageTiling]
(VkImageTiling -> VkImageTiling)
-> (VkImageTiling -> VkImageTiling)
-> (Int -> VkImageTiling)
-> (VkImageTiling -> Int)
-> (VkImageTiling -> [VkImageTiling])
-> (VkImageTiling -> VkImageTiling -> [VkImageTiling])
-> (VkImageTiling -> VkImageTiling -> [VkImageTiling])
-> (VkImageTiling
    -> VkImageTiling -> VkImageTiling -> [VkImageTiling])
-> Enum VkImageTiling
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: VkImageTiling -> VkImageTiling -> VkImageTiling -> [VkImageTiling]
$cenumFromThenTo :: VkImageTiling -> VkImageTiling -> VkImageTiling -> [VkImageTiling]
enumFromTo :: VkImageTiling -> VkImageTiling -> [VkImageTiling]
$cenumFromTo :: VkImageTiling -> VkImageTiling -> [VkImageTiling]
enumFromThen :: VkImageTiling -> VkImageTiling -> [VkImageTiling]
$cenumFromThen :: VkImageTiling -> VkImageTiling -> [VkImageTiling]
enumFrom :: VkImageTiling -> [VkImageTiling]
$cenumFrom :: VkImageTiling -> [VkImageTiling]
fromEnum :: VkImageTiling -> Int
$cfromEnum :: VkImageTiling -> Int
toEnum :: Int -> VkImageTiling
$ctoEnum :: Int -> VkImageTiling
pred :: VkImageTiling -> VkImageTiling
$cpred :: VkImageTiling -> VkImageTiling
succ :: VkImageTiling -> VkImageTiling
$csucc :: VkImageTiling -> VkImageTiling
Enum, Ptr VkImageTiling -> IO VkImageTiling
Ptr VkImageTiling -> Int -> IO VkImageTiling
Ptr VkImageTiling -> Int -> VkImageTiling -> IO ()
Ptr VkImageTiling -> VkImageTiling -> IO ()
VkImageTiling -> Int
(VkImageTiling -> Int)
-> (VkImageTiling -> Int)
-> (Ptr VkImageTiling -> Int -> IO VkImageTiling)
-> (Ptr VkImageTiling -> Int -> VkImageTiling -> IO ())
-> (forall b. Ptr b -> Int -> IO VkImageTiling)
-> (forall b. Ptr b -> Int -> VkImageTiling -> IO ())
-> (Ptr VkImageTiling -> IO VkImageTiling)
-> (Ptr VkImageTiling -> VkImageTiling -> IO ())
-> Storable VkImageTiling
forall b. Ptr b -> Int -> IO VkImageTiling
forall b. Ptr b -> Int -> VkImageTiling -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr VkImageTiling -> VkImageTiling -> IO ()
$cpoke :: Ptr VkImageTiling -> VkImageTiling -> IO ()
peek :: Ptr VkImageTiling -> IO VkImageTiling
$cpeek :: Ptr VkImageTiling -> IO VkImageTiling
pokeByteOff :: forall b. Ptr b -> Int -> VkImageTiling -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> VkImageTiling -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO VkImageTiling
$cpeekByteOff :: forall b. Ptr b -> Int -> IO VkImageTiling
pokeElemOff :: Ptr VkImageTiling -> Int -> VkImageTiling -> IO ()
$cpokeElemOff :: Ptr VkImageTiling -> Int -> VkImageTiling -> IO ()
peekElemOff :: Ptr VkImageTiling -> Int -> IO VkImageTiling
$cpeekElemOff :: Ptr VkImageTiling -> Int -> IO VkImageTiling
alignment :: VkImageTiling -> Int
$calignment :: VkImageTiling -> Int
sizeOf :: VkImageTiling -> Int
$csizeOf :: VkImageTiling -> Int
Storable)

instance Show VkImageTiling where
    showsPrec :: Int -> VkImageTiling -> ShowS
showsPrec Int
_ VkImageTiling
VK_IMAGE_TILING_OPTIMAL
      = String -> ShowS
showString String
"VK_IMAGE_TILING_OPTIMAL"
    showsPrec Int
_ VkImageTiling
VK_IMAGE_TILING_LINEAR
      = String -> ShowS
showString String
"VK_IMAGE_TILING_LINEAR"
    showsPrec Int
p (VkImageTiling Int32
x)
      = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
          (String -> ShowS
showString String
"VkImageTiling " 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
11 Int32
x)

instance Read VkImageTiling where
    readPrec :: ReadPrec VkImageTiling
readPrec
      = ReadPrec VkImageTiling -> ReadPrec VkImageTiling
forall a. ReadPrec a -> ReadPrec a
parens
          ([(String, ReadPrec VkImageTiling)] -> ReadPrec VkImageTiling
forall a. [(String, ReadPrec a)] -> ReadPrec a
choose
             [(String
"VK_IMAGE_TILING_OPTIMAL", VkImageTiling -> ReadPrec VkImageTiling
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageTiling
VK_IMAGE_TILING_OPTIMAL),
              (String
"VK_IMAGE_TILING_LINEAR", VkImageTiling -> ReadPrec VkImageTiling
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageTiling
VK_IMAGE_TILING_LINEAR)]
             ReadPrec VkImageTiling
-> ReadPrec VkImageTiling -> ReadPrec VkImageTiling
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
             Int -> ReadPrec VkImageTiling -> ReadPrec VkImageTiling
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10
               (Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident String
"VkImageTiling") ReadPrec () -> ReadPrec VkImageTiling -> ReadPrec VkImageTiling
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  (Int32 -> VkImageTiling
VkImageTiling (Int32 -> VkImageTiling)
-> ReadPrec Int32 -> ReadPrec VkImageTiling
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec Int32 -> ReadPrec Int32
forall a. ReadPrec a -> ReadPrec a
step ReadPrec Int32
forall a. Read a => ReadPrec a
readPrec)))

pattern VK_IMAGE_TILING_OPTIMAL :: VkImageTiling

pattern $bVK_IMAGE_TILING_OPTIMAL :: VkImageTiling
$mVK_IMAGE_TILING_OPTIMAL :: forall {r}. VkImageTiling -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_TILING_OPTIMAL = VkImageTiling 0

pattern VK_IMAGE_TILING_LINEAR :: VkImageTiling

pattern $bVK_IMAGE_TILING_LINEAR :: VkImageTiling
$mVK_IMAGE_TILING_LINEAR :: forall {r}. VkImageTiling -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_TILING_LINEAR = VkImageTiling 1

-- | type = @enum@
--
--   <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkImageType VkImageType registry at www.khronos.org>
newtype VkImageType = VkImageType Int32
                      deriving (VkImageType -> VkImageType -> Bool
(VkImageType -> VkImageType -> Bool)
-> (VkImageType -> VkImageType -> Bool) -> Eq VkImageType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VkImageType -> VkImageType -> Bool
$c/= :: VkImageType -> VkImageType -> Bool
== :: VkImageType -> VkImageType -> Bool
$c== :: VkImageType -> VkImageType -> Bool
Eq, Eq VkImageType
Eq VkImageType
-> (VkImageType -> VkImageType -> Ordering)
-> (VkImageType -> VkImageType -> Bool)
-> (VkImageType -> VkImageType -> Bool)
-> (VkImageType -> VkImageType -> Bool)
-> (VkImageType -> VkImageType -> Bool)
-> (VkImageType -> VkImageType -> VkImageType)
-> (VkImageType -> VkImageType -> VkImageType)
-> Ord VkImageType
VkImageType -> VkImageType -> Bool
VkImageType -> VkImageType -> Ordering
VkImageType -> VkImageType -> VkImageType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VkImageType -> VkImageType -> VkImageType
$cmin :: VkImageType -> VkImageType -> VkImageType
max :: VkImageType -> VkImageType -> VkImageType
$cmax :: VkImageType -> VkImageType -> VkImageType
>= :: VkImageType -> VkImageType -> Bool
$c>= :: VkImageType -> VkImageType -> Bool
> :: VkImageType -> VkImageType -> Bool
$c> :: VkImageType -> VkImageType -> Bool
<= :: VkImageType -> VkImageType -> Bool
$c<= :: VkImageType -> VkImageType -> Bool
< :: VkImageType -> VkImageType -> Bool
$c< :: VkImageType -> VkImageType -> Bool
compare :: VkImageType -> VkImageType -> Ordering
$ccompare :: VkImageType -> VkImageType -> Ordering
Ord, Int -> VkImageType
VkImageType -> Int
VkImageType -> [VkImageType]
VkImageType -> VkImageType
VkImageType -> VkImageType -> [VkImageType]
VkImageType -> VkImageType -> VkImageType -> [VkImageType]
(VkImageType -> VkImageType)
-> (VkImageType -> VkImageType)
-> (Int -> VkImageType)
-> (VkImageType -> Int)
-> (VkImageType -> [VkImageType])
-> (VkImageType -> VkImageType -> [VkImageType])
-> (VkImageType -> VkImageType -> [VkImageType])
-> (VkImageType -> VkImageType -> VkImageType -> [VkImageType])
-> Enum VkImageType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: VkImageType -> VkImageType -> VkImageType -> [VkImageType]
$cenumFromThenTo :: VkImageType -> VkImageType -> VkImageType -> [VkImageType]
enumFromTo :: VkImageType -> VkImageType -> [VkImageType]
$cenumFromTo :: VkImageType -> VkImageType -> [VkImageType]
enumFromThen :: VkImageType -> VkImageType -> [VkImageType]
$cenumFromThen :: VkImageType -> VkImageType -> [VkImageType]
enumFrom :: VkImageType -> [VkImageType]
$cenumFrom :: VkImageType -> [VkImageType]
fromEnum :: VkImageType -> Int
$cfromEnum :: VkImageType -> Int
toEnum :: Int -> VkImageType
$ctoEnum :: Int -> VkImageType
pred :: VkImageType -> VkImageType
$cpred :: VkImageType -> VkImageType
succ :: VkImageType -> VkImageType
$csucc :: VkImageType -> VkImageType
Enum, Ptr VkImageType -> IO VkImageType
Ptr VkImageType -> Int -> IO VkImageType
Ptr VkImageType -> Int -> VkImageType -> IO ()
Ptr VkImageType -> VkImageType -> IO ()
VkImageType -> Int
(VkImageType -> Int)
-> (VkImageType -> Int)
-> (Ptr VkImageType -> Int -> IO VkImageType)
-> (Ptr VkImageType -> Int -> VkImageType -> IO ())
-> (forall b. Ptr b -> Int -> IO VkImageType)
-> (forall b. Ptr b -> Int -> VkImageType -> IO ())
-> (Ptr VkImageType -> IO VkImageType)
-> (Ptr VkImageType -> VkImageType -> IO ())
-> Storable VkImageType
forall b. Ptr b -> Int -> IO VkImageType
forall b. Ptr b -> Int -> VkImageType -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr VkImageType -> VkImageType -> IO ()
$cpoke :: Ptr VkImageType -> VkImageType -> IO ()
peek :: Ptr VkImageType -> IO VkImageType
$cpeek :: Ptr VkImageType -> IO VkImageType
pokeByteOff :: forall b. Ptr b -> Int -> VkImageType -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> VkImageType -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO VkImageType
$cpeekByteOff :: forall b. Ptr b -> Int -> IO VkImageType
pokeElemOff :: Ptr VkImageType -> Int -> VkImageType -> IO ()
$cpokeElemOff :: Ptr VkImageType -> Int -> VkImageType -> IO ()
peekElemOff :: Ptr VkImageType -> Int -> IO VkImageType
$cpeekElemOff :: Ptr VkImageType -> Int -> IO VkImageType
alignment :: VkImageType -> Int
$calignment :: VkImageType -> Int
sizeOf :: VkImageType -> Int
$csizeOf :: VkImageType -> Int
Storable)

instance Show VkImageType where
    showsPrec :: Int -> VkImageType -> ShowS
showsPrec Int
_ VkImageType
VK_IMAGE_TYPE_1D = String -> ShowS
showString String
"VK_IMAGE_TYPE_1D"
    showsPrec Int
_ VkImageType
VK_IMAGE_TYPE_2D = String -> ShowS
showString String
"VK_IMAGE_TYPE_2D"
    showsPrec Int
_ VkImageType
VK_IMAGE_TYPE_3D = String -> ShowS
showString String
"VK_IMAGE_TYPE_3D"
    showsPrec Int
p (VkImageType Int32
x)
      = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11) (String -> ShowS
showString String
"VkImageType " 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
11 Int32
x)

instance Read VkImageType where
    readPrec :: ReadPrec VkImageType
readPrec
      = ReadPrec VkImageType -> ReadPrec VkImageType
forall a. ReadPrec a -> ReadPrec a
parens
          ([(String, ReadPrec VkImageType)] -> ReadPrec VkImageType
forall a. [(String, ReadPrec a)] -> ReadPrec a
choose
             [(String
"VK_IMAGE_TYPE_1D", VkImageType -> ReadPrec VkImageType
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageType
VK_IMAGE_TYPE_1D),
              (String
"VK_IMAGE_TYPE_2D", VkImageType -> ReadPrec VkImageType
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageType
VK_IMAGE_TYPE_2D),
              (String
"VK_IMAGE_TYPE_3D", VkImageType -> ReadPrec VkImageType
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageType
VK_IMAGE_TYPE_3D)]
             ReadPrec VkImageType
-> ReadPrec VkImageType -> ReadPrec VkImageType
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
             Int -> ReadPrec VkImageType -> ReadPrec VkImageType
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10
               (Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident String
"VkImageType") ReadPrec () -> ReadPrec VkImageType -> ReadPrec VkImageType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Int32 -> VkImageType
VkImageType (Int32 -> VkImageType) -> ReadPrec Int32 -> ReadPrec VkImageType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec Int32 -> ReadPrec Int32
forall a. ReadPrec a -> ReadPrec a
step ReadPrec Int32
forall a. Read a => ReadPrec a
readPrec)))

pattern VK_IMAGE_TYPE_1D :: VkImageType

pattern $bVK_IMAGE_TYPE_1D :: VkImageType
$mVK_IMAGE_TYPE_1D :: forall {r}. VkImageType -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_TYPE_1D = VkImageType 0

pattern VK_IMAGE_TYPE_2D :: VkImageType

pattern $bVK_IMAGE_TYPE_2D :: VkImageType
$mVK_IMAGE_TYPE_2D :: forall {r}. VkImageType -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_TYPE_2D = VkImageType 1

pattern VK_IMAGE_TYPE_3D :: VkImageType

pattern $bVK_IMAGE_TYPE_3D :: VkImageType
$mVK_IMAGE_TYPE_3D :: forall {r}. VkImageType -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_TYPE_3D = VkImageType 2

newtype VkImageUsageBitmask (a ::
                               FlagType) = VkImageUsageBitmask VkFlags
                                           deriving (VkImageUsageBitmask a -> VkImageUsageBitmask a -> Bool
(VkImageUsageBitmask a -> VkImageUsageBitmask a -> Bool)
-> (VkImageUsageBitmask a -> VkImageUsageBitmask a -> Bool)
-> Eq (VkImageUsageBitmask a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (a :: FlagType).
VkImageUsageBitmask a -> VkImageUsageBitmask a -> Bool
/= :: VkImageUsageBitmask a -> VkImageUsageBitmask a -> Bool
$c/= :: forall (a :: FlagType).
VkImageUsageBitmask a -> VkImageUsageBitmask a -> Bool
== :: VkImageUsageBitmask a -> VkImageUsageBitmask a -> Bool
$c== :: forall (a :: FlagType).
VkImageUsageBitmask a -> VkImageUsageBitmask a -> Bool
Eq, Eq (VkImageUsageBitmask a)
Eq (VkImageUsageBitmask a)
-> (VkImageUsageBitmask a -> VkImageUsageBitmask a -> Ordering)
-> (VkImageUsageBitmask a -> VkImageUsageBitmask a -> Bool)
-> (VkImageUsageBitmask a -> VkImageUsageBitmask a -> Bool)
-> (VkImageUsageBitmask a -> VkImageUsageBitmask a -> Bool)
-> (VkImageUsageBitmask a -> VkImageUsageBitmask a -> Bool)
-> (VkImageUsageBitmask a
    -> VkImageUsageBitmask a -> VkImageUsageBitmask a)
-> (VkImageUsageBitmask a
    -> VkImageUsageBitmask a -> VkImageUsageBitmask a)
-> Ord (VkImageUsageBitmask a)
VkImageUsageBitmask a -> VkImageUsageBitmask a -> Bool
VkImageUsageBitmask a -> VkImageUsageBitmask a -> Ordering
VkImageUsageBitmask a
-> VkImageUsageBitmask a -> VkImageUsageBitmask a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (a :: FlagType). Eq (VkImageUsageBitmask a)
forall (a :: FlagType).
VkImageUsageBitmask a -> VkImageUsageBitmask a -> Bool
forall (a :: FlagType).
VkImageUsageBitmask a -> VkImageUsageBitmask a -> Ordering
forall (a :: FlagType).
VkImageUsageBitmask a
-> VkImageUsageBitmask a -> VkImageUsageBitmask a
min :: VkImageUsageBitmask a
-> VkImageUsageBitmask a -> VkImageUsageBitmask a
$cmin :: forall (a :: FlagType).
VkImageUsageBitmask a
-> VkImageUsageBitmask a -> VkImageUsageBitmask a
max :: VkImageUsageBitmask a
-> VkImageUsageBitmask a -> VkImageUsageBitmask a
$cmax :: forall (a :: FlagType).
VkImageUsageBitmask a
-> VkImageUsageBitmask a -> VkImageUsageBitmask a
>= :: VkImageUsageBitmask a -> VkImageUsageBitmask a -> Bool
$c>= :: forall (a :: FlagType).
VkImageUsageBitmask a -> VkImageUsageBitmask a -> Bool
> :: VkImageUsageBitmask a -> VkImageUsageBitmask a -> Bool
$c> :: forall (a :: FlagType).
VkImageUsageBitmask a -> VkImageUsageBitmask a -> Bool
<= :: VkImageUsageBitmask a -> VkImageUsageBitmask a -> Bool
$c<= :: forall (a :: FlagType).
VkImageUsageBitmask a -> VkImageUsageBitmask a -> Bool
< :: VkImageUsageBitmask a -> VkImageUsageBitmask a -> Bool
$c< :: forall (a :: FlagType).
VkImageUsageBitmask a -> VkImageUsageBitmask a -> Bool
compare :: VkImageUsageBitmask a -> VkImageUsageBitmask a -> Ordering
$ccompare :: forall (a :: FlagType).
VkImageUsageBitmask a -> VkImageUsageBitmask a -> Ordering
Ord, Ptr (VkImageUsageBitmask a) -> IO (VkImageUsageBitmask a)
Ptr (VkImageUsageBitmask a) -> Int -> IO (VkImageUsageBitmask a)
Ptr (VkImageUsageBitmask a)
-> Int -> VkImageUsageBitmask a -> IO ()
Ptr (VkImageUsageBitmask a) -> VkImageUsageBitmask a -> IO ()
VkImageUsageBitmask a -> Int
(VkImageUsageBitmask a -> Int)
-> (VkImageUsageBitmask a -> Int)
-> (Ptr (VkImageUsageBitmask a)
    -> Int -> IO (VkImageUsageBitmask a))
-> (Ptr (VkImageUsageBitmask a)
    -> Int -> VkImageUsageBitmask a -> IO ())
-> (forall b. Ptr b -> Int -> IO (VkImageUsageBitmask a))
-> (forall b. Ptr b -> Int -> VkImageUsageBitmask a -> IO ())
-> (Ptr (VkImageUsageBitmask a) -> IO (VkImageUsageBitmask a))
-> (Ptr (VkImageUsageBitmask a) -> VkImageUsageBitmask a -> IO ())
-> Storable (VkImageUsageBitmask a)
forall b. Ptr b -> Int -> IO (VkImageUsageBitmask a)
forall b. Ptr b -> Int -> VkImageUsageBitmask a -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
forall (a :: FlagType).
Ptr (VkImageUsageBitmask a) -> IO (VkImageUsageBitmask a)
forall (a :: FlagType).
Ptr (VkImageUsageBitmask a) -> Int -> IO (VkImageUsageBitmask a)
forall (a :: FlagType).
Ptr (VkImageUsageBitmask a)
-> Int -> VkImageUsageBitmask a -> IO ()
forall (a :: FlagType).
Ptr (VkImageUsageBitmask a) -> VkImageUsageBitmask a -> IO ()
forall (a :: FlagType). VkImageUsageBitmask a -> Int
forall (a :: FlagType) b.
Ptr b -> Int -> IO (VkImageUsageBitmask a)
forall (a :: FlagType) b.
Ptr b -> Int -> VkImageUsageBitmask a -> IO ()
poke :: Ptr (VkImageUsageBitmask a) -> VkImageUsageBitmask a -> IO ()
$cpoke :: forall (a :: FlagType).
Ptr (VkImageUsageBitmask a) -> VkImageUsageBitmask a -> IO ()
peek :: Ptr (VkImageUsageBitmask a) -> IO (VkImageUsageBitmask a)
$cpeek :: forall (a :: FlagType).
Ptr (VkImageUsageBitmask a) -> IO (VkImageUsageBitmask a)
pokeByteOff :: forall b. Ptr b -> Int -> VkImageUsageBitmask a -> IO ()
$cpokeByteOff :: forall (a :: FlagType) b.
Ptr b -> Int -> VkImageUsageBitmask a -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO (VkImageUsageBitmask a)
$cpeekByteOff :: forall (a :: FlagType) b.
Ptr b -> Int -> IO (VkImageUsageBitmask a)
pokeElemOff :: Ptr (VkImageUsageBitmask a)
-> Int -> VkImageUsageBitmask a -> IO ()
$cpokeElemOff :: forall (a :: FlagType).
Ptr (VkImageUsageBitmask a)
-> Int -> VkImageUsageBitmask a -> IO ()
peekElemOff :: Ptr (VkImageUsageBitmask a) -> Int -> IO (VkImageUsageBitmask a)
$cpeekElemOff :: forall (a :: FlagType).
Ptr (VkImageUsageBitmask a) -> Int -> IO (VkImageUsageBitmask a)
alignment :: VkImageUsageBitmask a -> Int
$calignment :: forall (a :: FlagType). VkImageUsageBitmask a -> Int
sizeOf :: VkImageUsageBitmask a -> Int
$csizeOf :: forall (a :: FlagType). VkImageUsageBitmask a -> Int
Storable)

type VkImageUsageFlags = VkImageUsageBitmask FlagMask

type VkImageUsageFlagBits = VkImageUsageBitmask FlagBit

pattern VkImageUsageFlagBits ::
        VkFlags -> VkImageUsageBitmask FlagBit

pattern $bVkImageUsageFlagBits :: VkFlags -> VkImageUsageBitmask FlagBit
$mVkImageUsageFlagBits :: forall {r}.
VkImageUsageBitmask FlagBit -> (VkFlags -> r) -> (Void# -> r) -> r
VkImageUsageFlagBits n = VkImageUsageBitmask n

pattern VkImageUsageFlags ::
        VkFlags -> VkImageUsageBitmask FlagMask

pattern $bVkImageUsageFlags :: VkFlags -> VkImageUsageBitmask FlagMask
$mVkImageUsageFlags :: forall {r}.
VkImageUsageBitmask FlagMask -> (VkFlags -> r) -> (Void# -> r) -> r
VkImageUsageFlags n = VkImageUsageBitmask n

deriving instance Bits (VkImageUsageBitmask FlagMask)

deriving instance FiniteBits (VkImageUsageBitmask FlagMask)

instance Show (VkImageUsageBitmask a) where
    showsPrec :: Int -> VkImageUsageBitmask a -> ShowS
showsPrec Int
_ VkImageUsageBitmask a
VK_IMAGE_USAGE_TRANSFER_SRC_BIT
      = String -> ShowS
showString String
"VK_IMAGE_USAGE_TRANSFER_SRC_BIT"
    showsPrec Int
_ VkImageUsageBitmask a
VK_IMAGE_USAGE_TRANSFER_DST_BIT
      = String -> ShowS
showString String
"VK_IMAGE_USAGE_TRANSFER_DST_BIT"
    showsPrec Int
_ VkImageUsageBitmask a
VK_IMAGE_USAGE_SAMPLED_BIT
      = String -> ShowS
showString String
"VK_IMAGE_USAGE_SAMPLED_BIT"
    showsPrec Int
_ VkImageUsageBitmask a
VK_IMAGE_USAGE_STORAGE_BIT
      = String -> ShowS
showString String
"VK_IMAGE_USAGE_STORAGE_BIT"
    showsPrec Int
_ VkImageUsageBitmask a
VK_IMAGE_USAGE_COLOR_ATTACHMENT_BIT
      = String -> ShowS
showString String
"VK_IMAGE_USAGE_COLOR_ATTACHMENT_BIT"
    showsPrec Int
_ VkImageUsageBitmask a
VK_IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT
      = String -> ShowS
showString String
"VK_IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT"
    showsPrec Int
_ VkImageUsageBitmask a
VK_IMAGE_USAGE_TRANSIENT_ATTACHMENT_BIT
      = String -> ShowS
showString String
"VK_IMAGE_USAGE_TRANSIENT_ATTACHMENT_BIT"
    showsPrec Int
_ VkImageUsageBitmask a
VK_IMAGE_USAGE_INPUT_ATTACHMENT_BIT
      = String -> ShowS
showString String
"VK_IMAGE_USAGE_INPUT_ATTACHMENT_BIT"
    showsPrec Int
p (VkImageUsageBitmask VkFlags
x)
      = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
          (String -> ShowS
showString String
"VkImageUsageBitmask " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> VkFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 VkFlags
x)

instance Read (VkImageUsageBitmask a) where
    readPrec :: ReadPrec (VkImageUsageBitmask a)
readPrec
      = ReadPrec (VkImageUsageBitmask a)
-> ReadPrec (VkImageUsageBitmask a)
forall a. ReadPrec a -> ReadPrec a
parens
          ([(String, ReadPrec (VkImageUsageBitmask a))]
-> ReadPrec (VkImageUsageBitmask a)
forall a. [(String, ReadPrec a)] -> ReadPrec a
choose
             [(String
"VK_IMAGE_USAGE_TRANSFER_SRC_BIT",
               VkImageUsageBitmask a -> ReadPrec (VkImageUsageBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageUsageBitmask a
forall (a :: FlagType). VkImageUsageBitmask a
VK_IMAGE_USAGE_TRANSFER_SRC_BIT),
              (String
"VK_IMAGE_USAGE_TRANSFER_DST_BIT",
               VkImageUsageBitmask a -> ReadPrec (VkImageUsageBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageUsageBitmask a
forall (a :: FlagType). VkImageUsageBitmask a
VK_IMAGE_USAGE_TRANSFER_DST_BIT),
              (String
"VK_IMAGE_USAGE_SAMPLED_BIT", VkImageUsageBitmask a -> ReadPrec (VkImageUsageBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageUsageBitmask a
forall (a :: FlagType). VkImageUsageBitmask a
VK_IMAGE_USAGE_SAMPLED_BIT),
              (String
"VK_IMAGE_USAGE_STORAGE_BIT", VkImageUsageBitmask a -> ReadPrec (VkImageUsageBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageUsageBitmask a
forall (a :: FlagType). VkImageUsageBitmask a
VK_IMAGE_USAGE_STORAGE_BIT),
              (String
"VK_IMAGE_USAGE_COLOR_ATTACHMENT_BIT",
               VkImageUsageBitmask a -> ReadPrec (VkImageUsageBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageUsageBitmask a
forall (a :: FlagType). VkImageUsageBitmask a
VK_IMAGE_USAGE_COLOR_ATTACHMENT_BIT),
              (String
"VK_IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT",
               VkImageUsageBitmask a -> ReadPrec (VkImageUsageBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageUsageBitmask a
forall (a :: FlagType). VkImageUsageBitmask a
VK_IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT),
              (String
"VK_IMAGE_USAGE_TRANSIENT_ATTACHMENT_BIT",
               VkImageUsageBitmask a -> ReadPrec (VkImageUsageBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageUsageBitmask a
forall (a :: FlagType). VkImageUsageBitmask a
VK_IMAGE_USAGE_TRANSIENT_ATTACHMENT_BIT),
              (String
"VK_IMAGE_USAGE_INPUT_ATTACHMENT_BIT",
               VkImageUsageBitmask a -> ReadPrec (VkImageUsageBitmask a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageUsageBitmask a
forall (a :: FlagType). VkImageUsageBitmask a
VK_IMAGE_USAGE_INPUT_ATTACHMENT_BIT)]
             ReadPrec (VkImageUsageBitmask a)
-> ReadPrec (VkImageUsageBitmask a)
-> ReadPrec (VkImageUsageBitmask a)
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
             Int
-> ReadPrec (VkImageUsageBitmask a)
-> ReadPrec (VkImageUsageBitmask a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10
               (Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident String
"VkImageUsageBitmask") ReadPrec ()
-> ReadPrec (VkImageUsageBitmask a)
-> ReadPrec (VkImageUsageBitmask a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  (VkFlags -> VkImageUsageBitmask a
forall (a :: FlagType). VkFlags -> VkImageUsageBitmask a
VkImageUsageBitmask (VkFlags -> VkImageUsageBitmask a)
-> ReadPrec VkFlags -> ReadPrec (VkImageUsageBitmask a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec VkFlags -> ReadPrec VkFlags
forall a. ReadPrec a -> ReadPrec a
step ReadPrec VkFlags
forall a. Read a => ReadPrec a
readPrec)))

-- | Can be used as a source of transfer operations
--
--   bitpos = @0@
pattern VK_IMAGE_USAGE_TRANSFER_SRC_BIT :: VkImageUsageBitmask a

pattern $bVK_IMAGE_USAGE_TRANSFER_SRC_BIT :: forall (a :: FlagType). VkImageUsageBitmask a
$mVK_IMAGE_USAGE_TRANSFER_SRC_BIT :: forall {r} {a :: FlagType}.
VkImageUsageBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_USAGE_TRANSFER_SRC_BIT = VkImageUsageBitmask 1

-- | Can be used as a destination of transfer operations
--
--   bitpos = @1@
pattern VK_IMAGE_USAGE_TRANSFER_DST_BIT :: VkImageUsageBitmask a

pattern $bVK_IMAGE_USAGE_TRANSFER_DST_BIT :: forall (a :: FlagType). VkImageUsageBitmask a
$mVK_IMAGE_USAGE_TRANSFER_DST_BIT :: forall {r} {a :: FlagType}.
VkImageUsageBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_USAGE_TRANSFER_DST_BIT = VkImageUsageBitmask 2

-- | Can be sampled from (SAMPLED_IMAGE and COMBINED_IMAGE_SAMPLER descriptor types)
--
--   bitpos = @2@
pattern VK_IMAGE_USAGE_SAMPLED_BIT :: VkImageUsageBitmask a

pattern $bVK_IMAGE_USAGE_SAMPLED_BIT :: forall (a :: FlagType). VkImageUsageBitmask a
$mVK_IMAGE_USAGE_SAMPLED_BIT :: forall {r} {a :: FlagType}.
VkImageUsageBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_USAGE_SAMPLED_BIT = VkImageUsageBitmask 4

-- | Can be used as storage image (STORAGE_IMAGE descriptor type)
--
--   bitpos = @3@
pattern VK_IMAGE_USAGE_STORAGE_BIT :: VkImageUsageBitmask a

pattern $bVK_IMAGE_USAGE_STORAGE_BIT :: forall (a :: FlagType). VkImageUsageBitmask a
$mVK_IMAGE_USAGE_STORAGE_BIT :: forall {r} {a :: FlagType}.
VkImageUsageBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_USAGE_STORAGE_BIT = VkImageUsageBitmask 8

-- | Can be used as framebuffer color attachment
--
--   bitpos = @4@
pattern VK_IMAGE_USAGE_COLOR_ATTACHMENT_BIT ::
        VkImageUsageBitmask a

pattern $bVK_IMAGE_USAGE_COLOR_ATTACHMENT_BIT :: forall (a :: FlagType). VkImageUsageBitmask a
$mVK_IMAGE_USAGE_COLOR_ATTACHMENT_BIT :: forall {r} {a :: FlagType}.
VkImageUsageBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_USAGE_COLOR_ATTACHMENT_BIT =
        VkImageUsageBitmask 16

-- | Can be used as framebuffer depth/stencil attachment
--
--   bitpos = @5@
pattern VK_IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT ::
        VkImageUsageBitmask a

pattern $bVK_IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT :: forall (a :: FlagType). VkImageUsageBitmask a
$mVK_IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT :: forall {r} {a :: FlagType}.
VkImageUsageBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_USAGE_DEPTH_STENCIL_ATTACHMENT_BIT =
        VkImageUsageBitmask 32

-- | Image data not needed outside of rendering
--
--   bitpos = @6@
pattern VK_IMAGE_USAGE_TRANSIENT_ATTACHMENT_BIT ::
        VkImageUsageBitmask a

pattern $bVK_IMAGE_USAGE_TRANSIENT_ATTACHMENT_BIT :: forall (a :: FlagType). VkImageUsageBitmask a
$mVK_IMAGE_USAGE_TRANSIENT_ATTACHMENT_BIT :: forall {r} {a :: FlagType}.
VkImageUsageBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_USAGE_TRANSIENT_ATTACHMENT_BIT =
        VkImageUsageBitmask 64

-- | Can be used as framebuffer input attachment
--
--   bitpos = @7@
pattern VK_IMAGE_USAGE_INPUT_ATTACHMENT_BIT ::
        VkImageUsageBitmask a

pattern $bVK_IMAGE_USAGE_INPUT_ATTACHMENT_BIT :: forall (a :: FlagType). VkImageUsageBitmask a
$mVK_IMAGE_USAGE_INPUT_ATTACHMENT_BIT :: forall {r} {a :: FlagType}.
VkImageUsageBitmask a -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_USAGE_INPUT_ATTACHMENT_BIT =
        VkImageUsageBitmask 128

newtype VkImageViewCreateBitmask (a ::
                                    FlagType) = VkImageViewCreateBitmask VkFlags
                                                deriving (VkImageViewCreateBitmask a -> VkImageViewCreateBitmask a -> Bool
(VkImageViewCreateBitmask a -> VkImageViewCreateBitmask a -> Bool)
-> (VkImageViewCreateBitmask a
    -> VkImageViewCreateBitmask a -> Bool)
-> Eq (VkImageViewCreateBitmask a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (a :: FlagType).
VkImageViewCreateBitmask a -> VkImageViewCreateBitmask a -> Bool
/= :: VkImageViewCreateBitmask a -> VkImageViewCreateBitmask a -> Bool
$c/= :: forall (a :: FlagType).
VkImageViewCreateBitmask a -> VkImageViewCreateBitmask a -> Bool
== :: VkImageViewCreateBitmask a -> VkImageViewCreateBitmask a -> Bool
$c== :: forall (a :: FlagType).
VkImageViewCreateBitmask a -> VkImageViewCreateBitmask a -> Bool
Eq, Eq (VkImageViewCreateBitmask a)
Eq (VkImageViewCreateBitmask a)
-> (VkImageViewCreateBitmask a
    -> VkImageViewCreateBitmask a -> Ordering)
-> (VkImageViewCreateBitmask a
    -> VkImageViewCreateBitmask a -> Bool)
-> (VkImageViewCreateBitmask a
    -> VkImageViewCreateBitmask a -> Bool)
-> (VkImageViewCreateBitmask a
    -> VkImageViewCreateBitmask a -> Bool)
-> (VkImageViewCreateBitmask a
    -> VkImageViewCreateBitmask a -> Bool)
-> (VkImageViewCreateBitmask a
    -> VkImageViewCreateBitmask a -> VkImageViewCreateBitmask a)
-> (VkImageViewCreateBitmask a
    -> VkImageViewCreateBitmask a -> VkImageViewCreateBitmask a)
-> Ord (VkImageViewCreateBitmask a)
VkImageViewCreateBitmask a -> VkImageViewCreateBitmask a -> Bool
VkImageViewCreateBitmask a
-> VkImageViewCreateBitmask a -> Ordering
VkImageViewCreateBitmask a
-> VkImageViewCreateBitmask a -> VkImageViewCreateBitmask a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (a :: FlagType). Eq (VkImageViewCreateBitmask a)
forall (a :: FlagType).
VkImageViewCreateBitmask a -> VkImageViewCreateBitmask a -> Bool
forall (a :: FlagType).
VkImageViewCreateBitmask a
-> VkImageViewCreateBitmask a -> Ordering
forall (a :: FlagType).
VkImageViewCreateBitmask a
-> VkImageViewCreateBitmask a -> VkImageViewCreateBitmask a
min :: VkImageViewCreateBitmask a
-> VkImageViewCreateBitmask a -> VkImageViewCreateBitmask a
$cmin :: forall (a :: FlagType).
VkImageViewCreateBitmask a
-> VkImageViewCreateBitmask a -> VkImageViewCreateBitmask a
max :: VkImageViewCreateBitmask a
-> VkImageViewCreateBitmask a -> VkImageViewCreateBitmask a
$cmax :: forall (a :: FlagType).
VkImageViewCreateBitmask a
-> VkImageViewCreateBitmask a -> VkImageViewCreateBitmask a
>= :: VkImageViewCreateBitmask a -> VkImageViewCreateBitmask a -> Bool
$c>= :: forall (a :: FlagType).
VkImageViewCreateBitmask a -> VkImageViewCreateBitmask a -> Bool
> :: VkImageViewCreateBitmask a -> VkImageViewCreateBitmask a -> Bool
$c> :: forall (a :: FlagType).
VkImageViewCreateBitmask a -> VkImageViewCreateBitmask a -> Bool
<= :: VkImageViewCreateBitmask a -> VkImageViewCreateBitmask a -> Bool
$c<= :: forall (a :: FlagType).
VkImageViewCreateBitmask a -> VkImageViewCreateBitmask a -> Bool
< :: VkImageViewCreateBitmask a -> VkImageViewCreateBitmask a -> Bool
$c< :: forall (a :: FlagType).
VkImageViewCreateBitmask a -> VkImageViewCreateBitmask a -> Bool
compare :: VkImageViewCreateBitmask a
-> VkImageViewCreateBitmask a -> Ordering
$ccompare :: forall (a :: FlagType).
VkImageViewCreateBitmask a
-> VkImageViewCreateBitmask a -> Ordering
Ord, Ptr (VkImageViewCreateBitmask a) -> IO (VkImageViewCreateBitmask a)
Ptr (VkImageViewCreateBitmask a)
-> Int -> IO (VkImageViewCreateBitmask a)
Ptr (VkImageViewCreateBitmask a)
-> Int -> VkImageViewCreateBitmask a -> IO ()
Ptr (VkImageViewCreateBitmask a)
-> VkImageViewCreateBitmask a -> IO ()
VkImageViewCreateBitmask a -> Int
(VkImageViewCreateBitmask a -> Int)
-> (VkImageViewCreateBitmask a -> Int)
-> (Ptr (VkImageViewCreateBitmask a)
    -> Int -> IO (VkImageViewCreateBitmask a))
-> (Ptr (VkImageViewCreateBitmask a)
    -> Int -> VkImageViewCreateBitmask a -> IO ())
-> (forall b. Ptr b -> Int -> IO (VkImageViewCreateBitmask a))
-> (forall b. Ptr b -> Int -> VkImageViewCreateBitmask a -> IO ())
-> (Ptr (VkImageViewCreateBitmask a)
    -> IO (VkImageViewCreateBitmask a))
-> (Ptr (VkImageViewCreateBitmask a)
    -> VkImageViewCreateBitmask a -> IO ())
-> Storable (VkImageViewCreateBitmask a)
forall b. Ptr b -> Int -> IO (VkImageViewCreateBitmask a)
forall b. Ptr b -> Int -> VkImageViewCreateBitmask a -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
forall (a :: FlagType).
Ptr (VkImageViewCreateBitmask a) -> IO (VkImageViewCreateBitmask a)
forall (a :: FlagType).
Ptr (VkImageViewCreateBitmask a)
-> Int -> IO (VkImageViewCreateBitmask a)
forall (a :: FlagType).
Ptr (VkImageViewCreateBitmask a)
-> Int -> VkImageViewCreateBitmask a -> IO ()
forall (a :: FlagType).
Ptr (VkImageViewCreateBitmask a)
-> VkImageViewCreateBitmask a -> IO ()
forall (a :: FlagType). VkImageViewCreateBitmask a -> Int
forall (a :: FlagType) b.
Ptr b -> Int -> IO (VkImageViewCreateBitmask a)
forall (a :: FlagType) b.
Ptr b -> Int -> VkImageViewCreateBitmask a -> IO ()
poke :: Ptr (VkImageViewCreateBitmask a)
-> VkImageViewCreateBitmask a -> IO ()
$cpoke :: forall (a :: FlagType).
Ptr (VkImageViewCreateBitmask a)
-> VkImageViewCreateBitmask a -> IO ()
peek :: Ptr (VkImageViewCreateBitmask a) -> IO (VkImageViewCreateBitmask a)
$cpeek :: forall (a :: FlagType).
Ptr (VkImageViewCreateBitmask a) -> IO (VkImageViewCreateBitmask a)
pokeByteOff :: forall b. Ptr b -> Int -> VkImageViewCreateBitmask a -> IO ()
$cpokeByteOff :: forall (a :: FlagType) b.
Ptr b -> Int -> VkImageViewCreateBitmask a -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO (VkImageViewCreateBitmask a)
$cpeekByteOff :: forall (a :: FlagType) b.
Ptr b -> Int -> IO (VkImageViewCreateBitmask a)
pokeElemOff :: Ptr (VkImageViewCreateBitmask a)
-> Int -> VkImageViewCreateBitmask a -> IO ()
$cpokeElemOff :: forall (a :: FlagType).
Ptr (VkImageViewCreateBitmask a)
-> Int -> VkImageViewCreateBitmask a -> IO ()
peekElemOff :: Ptr (VkImageViewCreateBitmask a)
-> Int -> IO (VkImageViewCreateBitmask a)
$cpeekElemOff :: forall (a :: FlagType).
Ptr (VkImageViewCreateBitmask a)
-> Int -> IO (VkImageViewCreateBitmask a)
alignment :: VkImageViewCreateBitmask a -> Int
$calignment :: forall (a :: FlagType). VkImageViewCreateBitmask a -> Int
sizeOf :: VkImageViewCreateBitmask a -> Int
$csizeOf :: forall (a :: FlagType). VkImageViewCreateBitmask a -> Int
Storable)

type VkImageViewCreateFlags = VkImageViewCreateBitmask FlagMask

type VkImageViewCreateFlagBits = VkImageViewCreateBitmask FlagBit

pattern VkImageViewCreateFlagBits ::
        VkFlags -> VkImageViewCreateBitmask FlagBit

pattern $bVkImageViewCreateFlagBits :: VkFlags -> VkImageViewCreateBitmask FlagBit
$mVkImageViewCreateFlagBits :: forall {r}.
VkImageViewCreateBitmask FlagBit
-> (VkFlags -> r) -> (Void# -> r) -> r
VkImageViewCreateFlagBits n = VkImageViewCreateBitmask n

pattern VkImageViewCreateFlags ::
        VkFlags -> VkImageViewCreateBitmask FlagMask

pattern $bVkImageViewCreateFlags :: VkFlags -> VkImageViewCreateBitmask FlagMask
$mVkImageViewCreateFlags :: forall {r}.
VkImageViewCreateBitmask FlagMask
-> (VkFlags -> r) -> (Void# -> r) -> r
VkImageViewCreateFlags n = VkImageViewCreateBitmask n

deriving instance Bits (VkImageViewCreateBitmask FlagMask)

deriving instance FiniteBits (VkImageViewCreateBitmask FlagMask)

instance Show (VkImageViewCreateBitmask a) where
    showsPrec :: Int -> VkImageViewCreateBitmask a -> ShowS
showsPrec Int
p (VkImageViewCreateBitmask VkFlags
x)
      = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
          (String -> ShowS
showString String
"VkImageViewCreateBitmask " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> VkFlags -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 VkFlags
x)

instance Read (VkImageViewCreateBitmask a) where
    readPrec :: ReadPrec (VkImageViewCreateBitmask a)
readPrec
      = ReadPrec (VkImageViewCreateBitmask a)
-> ReadPrec (VkImageViewCreateBitmask a)
forall a. ReadPrec a -> ReadPrec a
parens
          ([(String, ReadPrec (VkImageViewCreateBitmask a))]
-> ReadPrec (VkImageViewCreateBitmask a)
forall a. [(String, ReadPrec a)] -> ReadPrec a
choose [] ReadPrec (VkImageViewCreateBitmask a)
-> ReadPrec (VkImageViewCreateBitmask a)
-> ReadPrec (VkImageViewCreateBitmask a)
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
             Int
-> ReadPrec (VkImageViewCreateBitmask a)
-> ReadPrec (VkImageViewCreateBitmask a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10
               (Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident String
"VkImageViewCreateBitmask") ReadPrec ()
-> ReadPrec (VkImageViewCreateBitmask a)
-> ReadPrec (VkImageViewCreateBitmask a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  (VkFlags -> VkImageViewCreateBitmask a
forall (a :: FlagType). VkFlags -> VkImageViewCreateBitmask a
VkImageViewCreateBitmask (VkFlags -> VkImageViewCreateBitmask a)
-> ReadPrec VkFlags -> ReadPrec (VkImageViewCreateBitmask a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec VkFlags -> ReadPrec VkFlags
forall a. ReadPrec a -> ReadPrec a
step ReadPrec VkFlags
forall a. Read a => ReadPrec a
readPrec)))

-- | type = @enum@
--
--   <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#VkImageViewType VkImageViewType registry at www.khronos.org>
newtype VkImageViewType = VkImageViewType Int32
                          deriving (VkImageViewType -> VkImageViewType -> Bool
(VkImageViewType -> VkImageViewType -> Bool)
-> (VkImageViewType -> VkImageViewType -> Bool)
-> Eq VkImageViewType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VkImageViewType -> VkImageViewType -> Bool
$c/= :: VkImageViewType -> VkImageViewType -> Bool
== :: VkImageViewType -> VkImageViewType -> Bool
$c== :: VkImageViewType -> VkImageViewType -> Bool
Eq, Eq VkImageViewType
Eq VkImageViewType
-> (VkImageViewType -> VkImageViewType -> Ordering)
-> (VkImageViewType -> VkImageViewType -> Bool)
-> (VkImageViewType -> VkImageViewType -> Bool)
-> (VkImageViewType -> VkImageViewType -> Bool)
-> (VkImageViewType -> VkImageViewType -> Bool)
-> (VkImageViewType -> VkImageViewType -> VkImageViewType)
-> (VkImageViewType -> VkImageViewType -> VkImageViewType)
-> Ord VkImageViewType
VkImageViewType -> VkImageViewType -> Bool
VkImageViewType -> VkImageViewType -> Ordering
VkImageViewType -> VkImageViewType -> VkImageViewType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VkImageViewType -> VkImageViewType -> VkImageViewType
$cmin :: VkImageViewType -> VkImageViewType -> VkImageViewType
max :: VkImageViewType -> VkImageViewType -> VkImageViewType
$cmax :: VkImageViewType -> VkImageViewType -> VkImageViewType
>= :: VkImageViewType -> VkImageViewType -> Bool
$c>= :: VkImageViewType -> VkImageViewType -> Bool
> :: VkImageViewType -> VkImageViewType -> Bool
$c> :: VkImageViewType -> VkImageViewType -> Bool
<= :: VkImageViewType -> VkImageViewType -> Bool
$c<= :: VkImageViewType -> VkImageViewType -> Bool
< :: VkImageViewType -> VkImageViewType -> Bool
$c< :: VkImageViewType -> VkImageViewType -> Bool
compare :: VkImageViewType -> VkImageViewType -> Ordering
$ccompare :: VkImageViewType -> VkImageViewType -> Ordering
Ord, Int -> VkImageViewType
VkImageViewType -> Int
VkImageViewType -> [VkImageViewType]
VkImageViewType -> VkImageViewType
VkImageViewType -> VkImageViewType -> [VkImageViewType]
VkImageViewType
-> VkImageViewType -> VkImageViewType -> [VkImageViewType]
(VkImageViewType -> VkImageViewType)
-> (VkImageViewType -> VkImageViewType)
-> (Int -> VkImageViewType)
-> (VkImageViewType -> Int)
-> (VkImageViewType -> [VkImageViewType])
-> (VkImageViewType -> VkImageViewType -> [VkImageViewType])
-> (VkImageViewType -> VkImageViewType -> [VkImageViewType])
-> (VkImageViewType
    -> VkImageViewType -> VkImageViewType -> [VkImageViewType])
-> Enum VkImageViewType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: VkImageViewType
-> VkImageViewType -> VkImageViewType -> [VkImageViewType]
$cenumFromThenTo :: VkImageViewType
-> VkImageViewType -> VkImageViewType -> [VkImageViewType]
enumFromTo :: VkImageViewType -> VkImageViewType -> [VkImageViewType]
$cenumFromTo :: VkImageViewType -> VkImageViewType -> [VkImageViewType]
enumFromThen :: VkImageViewType -> VkImageViewType -> [VkImageViewType]
$cenumFromThen :: VkImageViewType -> VkImageViewType -> [VkImageViewType]
enumFrom :: VkImageViewType -> [VkImageViewType]
$cenumFrom :: VkImageViewType -> [VkImageViewType]
fromEnum :: VkImageViewType -> Int
$cfromEnum :: VkImageViewType -> Int
toEnum :: Int -> VkImageViewType
$ctoEnum :: Int -> VkImageViewType
pred :: VkImageViewType -> VkImageViewType
$cpred :: VkImageViewType -> VkImageViewType
succ :: VkImageViewType -> VkImageViewType
$csucc :: VkImageViewType -> VkImageViewType
Enum, Ptr VkImageViewType -> IO VkImageViewType
Ptr VkImageViewType -> Int -> IO VkImageViewType
Ptr VkImageViewType -> Int -> VkImageViewType -> IO ()
Ptr VkImageViewType -> VkImageViewType -> IO ()
VkImageViewType -> Int
(VkImageViewType -> Int)
-> (VkImageViewType -> Int)
-> (Ptr VkImageViewType -> Int -> IO VkImageViewType)
-> (Ptr VkImageViewType -> Int -> VkImageViewType -> IO ())
-> (forall b. Ptr b -> Int -> IO VkImageViewType)
-> (forall b. Ptr b -> Int -> VkImageViewType -> IO ())
-> (Ptr VkImageViewType -> IO VkImageViewType)
-> (Ptr VkImageViewType -> VkImageViewType -> IO ())
-> Storable VkImageViewType
forall b. Ptr b -> Int -> IO VkImageViewType
forall b. Ptr b -> Int -> VkImageViewType -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr VkImageViewType -> VkImageViewType -> IO ()
$cpoke :: Ptr VkImageViewType -> VkImageViewType -> IO ()
peek :: Ptr VkImageViewType -> IO VkImageViewType
$cpeek :: Ptr VkImageViewType -> IO VkImageViewType
pokeByteOff :: forall b. Ptr b -> Int -> VkImageViewType -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> VkImageViewType -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO VkImageViewType
$cpeekByteOff :: forall b. Ptr b -> Int -> IO VkImageViewType
pokeElemOff :: Ptr VkImageViewType -> Int -> VkImageViewType -> IO ()
$cpokeElemOff :: Ptr VkImageViewType -> Int -> VkImageViewType -> IO ()
peekElemOff :: Ptr VkImageViewType -> Int -> IO VkImageViewType
$cpeekElemOff :: Ptr VkImageViewType -> Int -> IO VkImageViewType
alignment :: VkImageViewType -> Int
$calignment :: VkImageViewType -> Int
sizeOf :: VkImageViewType -> Int
$csizeOf :: VkImageViewType -> Int
Storable)

instance Show VkImageViewType where
    showsPrec :: Int -> VkImageViewType -> ShowS
showsPrec Int
_ VkImageViewType
VK_IMAGE_VIEW_TYPE_1D
      = String -> ShowS
showString String
"VK_IMAGE_VIEW_TYPE_1D"
    showsPrec Int
_ VkImageViewType
VK_IMAGE_VIEW_TYPE_2D
      = String -> ShowS
showString String
"VK_IMAGE_VIEW_TYPE_2D"
    showsPrec Int
_ VkImageViewType
VK_IMAGE_VIEW_TYPE_3D
      = String -> ShowS
showString String
"VK_IMAGE_VIEW_TYPE_3D"
    showsPrec Int
_ VkImageViewType
VK_IMAGE_VIEW_TYPE_CUBE
      = String -> ShowS
showString String
"VK_IMAGE_VIEW_TYPE_CUBE"
    showsPrec Int
_ VkImageViewType
VK_IMAGE_VIEW_TYPE_1D_ARRAY
      = String -> ShowS
showString String
"VK_IMAGE_VIEW_TYPE_1D_ARRAY"
    showsPrec Int
_ VkImageViewType
VK_IMAGE_VIEW_TYPE_2D_ARRAY
      = String -> ShowS
showString String
"VK_IMAGE_VIEW_TYPE_2D_ARRAY"
    showsPrec Int
_ VkImageViewType
VK_IMAGE_VIEW_TYPE_CUBE_ARRAY
      = String -> ShowS
showString String
"VK_IMAGE_VIEW_TYPE_CUBE_ARRAY"
    showsPrec Int
p (VkImageViewType Int32
x)
      = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
          (String -> ShowS
showString String
"VkImageViewType " 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
11 Int32
x)

instance Read VkImageViewType where
    readPrec :: ReadPrec VkImageViewType
readPrec
      = ReadPrec VkImageViewType -> ReadPrec VkImageViewType
forall a. ReadPrec a -> ReadPrec a
parens
          ([(String, ReadPrec VkImageViewType)] -> ReadPrec VkImageViewType
forall a. [(String, ReadPrec a)] -> ReadPrec a
choose
             [(String
"VK_IMAGE_VIEW_TYPE_1D", VkImageViewType -> ReadPrec VkImageViewType
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageViewType
VK_IMAGE_VIEW_TYPE_1D),
              (String
"VK_IMAGE_VIEW_TYPE_2D", VkImageViewType -> ReadPrec VkImageViewType
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageViewType
VK_IMAGE_VIEW_TYPE_2D),
              (String
"VK_IMAGE_VIEW_TYPE_3D", VkImageViewType -> ReadPrec VkImageViewType
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageViewType
VK_IMAGE_VIEW_TYPE_3D),
              (String
"VK_IMAGE_VIEW_TYPE_CUBE", VkImageViewType -> ReadPrec VkImageViewType
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageViewType
VK_IMAGE_VIEW_TYPE_CUBE),
              (String
"VK_IMAGE_VIEW_TYPE_1D_ARRAY", VkImageViewType -> ReadPrec VkImageViewType
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageViewType
VK_IMAGE_VIEW_TYPE_1D_ARRAY),
              (String
"VK_IMAGE_VIEW_TYPE_2D_ARRAY", VkImageViewType -> ReadPrec VkImageViewType
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageViewType
VK_IMAGE_VIEW_TYPE_2D_ARRAY),
              (String
"VK_IMAGE_VIEW_TYPE_CUBE_ARRAY",
               VkImageViewType -> ReadPrec VkImageViewType
forall (f :: * -> *) a. Applicative f => a -> f a
pure VkImageViewType
VK_IMAGE_VIEW_TYPE_CUBE_ARRAY)]
             ReadPrec VkImageViewType
-> ReadPrec VkImageViewType -> ReadPrec VkImageViewType
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
             Int -> ReadPrec VkImageViewType -> ReadPrec VkImageViewType
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10
               (Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident String
"VkImageViewType") ReadPrec () -> ReadPrec VkImageViewType -> ReadPrec VkImageViewType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  (Int32 -> VkImageViewType
VkImageViewType (Int32 -> VkImageViewType)
-> ReadPrec Int32 -> ReadPrec VkImageViewType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec Int32 -> ReadPrec Int32
forall a. ReadPrec a -> ReadPrec a
step ReadPrec Int32
forall a. Read a => ReadPrec a
readPrec)))

pattern VK_IMAGE_VIEW_TYPE_1D :: VkImageViewType

pattern $bVK_IMAGE_VIEW_TYPE_1D :: VkImageViewType
$mVK_IMAGE_VIEW_TYPE_1D :: forall {r}. VkImageViewType -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_VIEW_TYPE_1D = VkImageViewType 0

pattern VK_IMAGE_VIEW_TYPE_2D :: VkImageViewType

pattern $bVK_IMAGE_VIEW_TYPE_2D :: VkImageViewType
$mVK_IMAGE_VIEW_TYPE_2D :: forall {r}. VkImageViewType -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_VIEW_TYPE_2D = VkImageViewType 1

pattern VK_IMAGE_VIEW_TYPE_3D :: VkImageViewType

pattern $bVK_IMAGE_VIEW_TYPE_3D :: VkImageViewType
$mVK_IMAGE_VIEW_TYPE_3D :: forall {r}. VkImageViewType -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_VIEW_TYPE_3D = VkImageViewType 2

pattern VK_IMAGE_VIEW_TYPE_CUBE :: VkImageViewType

pattern $bVK_IMAGE_VIEW_TYPE_CUBE :: VkImageViewType
$mVK_IMAGE_VIEW_TYPE_CUBE :: forall {r}. VkImageViewType -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_VIEW_TYPE_CUBE = VkImageViewType 3

pattern VK_IMAGE_VIEW_TYPE_1D_ARRAY :: VkImageViewType

pattern $bVK_IMAGE_VIEW_TYPE_1D_ARRAY :: VkImageViewType
$mVK_IMAGE_VIEW_TYPE_1D_ARRAY :: forall {r}. VkImageViewType -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_VIEW_TYPE_1D_ARRAY = VkImageViewType 4

pattern VK_IMAGE_VIEW_TYPE_2D_ARRAY :: VkImageViewType

pattern $bVK_IMAGE_VIEW_TYPE_2D_ARRAY :: VkImageViewType
$mVK_IMAGE_VIEW_TYPE_2D_ARRAY :: forall {r}. VkImageViewType -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_VIEW_TYPE_2D_ARRAY = VkImageViewType 5

pattern VK_IMAGE_VIEW_TYPE_CUBE_ARRAY :: VkImageViewType

pattern $bVK_IMAGE_VIEW_TYPE_CUBE_ARRAY :: VkImageViewType
$mVK_IMAGE_VIEW_TYPE_CUBE_ARRAY :: forall {r}. VkImageViewType -> (Void# -> r) -> (Void# -> r) -> r
VK_IMAGE_VIEW_TYPE_CUBE_ARRAY = VkImageViewType 6