{-# language CPP #-}
module Vulkan.Core10.Enums.ColorComponentFlagBits  ( ColorComponentFlagBits( COLOR_COMPONENT_R_BIT
                                                                           , COLOR_COMPONENT_G_BIT
                                                                           , COLOR_COMPONENT_B_BIT
                                                                           , COLOR_COMPONENT_A_BIT
                                                                           , ..
                                                                           )
                                                   , ColorComponentFlags
                                                   ) where

import GHC.Read (choose)
import GHC.Read (expectP)
import GHC.Read (parens)
import GHC.Show (showParen)
import GHC.Show (showString)
import Numeric (showHex)
import Text.ParserCombinators.ReadPrec ((+++))
import Text.ParserCombinators.ReadPrec (prec)
import Text.ParserCombinators.ReadPrec (step)
import Data.Bits (Bits)
import Foreign.Storable (Storable)
import GHC.Read (Read(readPrec))
import Text.Read.Lex (Lexeme(Ident))
import Vulkan.Core10.FundamentalTypes (Flags)
import Vulkan.Zero (Zero)
-- | VkColorComponentFlagBits - Bitmask controlling which components are
-- written to the framebuffer
--
-- = Description
--
-- The color write mask operation is applied regardless of whether blending
-- is enabled.
--
-- = See Also
--
-- 'ColorComponentFlags'
newtype ColorComponentFlagBits = ColorComponentFlagBits Flags
  deriving newtype (ColorComponentFlagBits -> ColorComponentFlagBits -> Bool
(ColorComponentFlagBits -> ColorComponentFlagBits -> Bool)
-> (ColorComponentFlagBits -> ColorComponentFlagBits -> Bool)
-> Eq ColorComponentFlagBits
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColorComponentFlagBits -> ColorComponentFlagBits -> Bool
$c/= :: ColorComponentFlagBits -> ColorComponentFlagBits -> Bool
== :: ColorComponentFlagBits -> ColorComponentFlagBits -> Bool
$c== :: ColorComponentFlagBits -> ColorComponentFlagBits -> Bool
Eq, Eq ColorComponentFlagBits
Eq ColorComponentFlagBits =>
(ColorComponentFlagBits -> ColorComponentFlagBits -> Ordering)
-> (ColorComponentFlagBits -> ColorComponentFlagBits -> Bool)
-> (ColorComponentFlagBits -> ColorComponentFlagBits -> Bool)
-> (ColorComponentFlagBits -> ColorComponentFlagBits -> Bool)
-> (ColorComponentFlagBits -> ColorComponentFlagBits -> Bool)
-> (ColorComponentFlagBits
    -> ColorComponentFlagBits -> ColorComponentFlagBits)
-> (ColorComponentFlagBits
    -> ColorComponentFlagBits -> ColorComponentFlagBits)
-> Ord ColorComponentFlagBits
ColorComponentFlagBits -> ColorComponentFlagBits -> Bool
ColorComponentFlagBits -> ColorComponentFlagBits -> Ordering
ColorComponentFlagBits
-> ColorComponentFlagBits -> ColorComponentFlagBits
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 :: ColorComponentFlagBits
-> ColorComponentFlagBits -> ColorComponentFlagBits
$cmin :: ColorComponentFlagBits
-> ColorComponentFlagBits -> ColorComponentFlagBits
max :: ColorComponentFlagBits
-> ColorComponentFlagBits -> ColorComponentFlagBits
$cmax :: ColorComponentFlagBits
-> ColorComponentFlagBits -> ColorComponentFlagBits
>= :: ColorComponentFlagBits -> ColorComponentFlagBits -> Bool
$c>= :: ColorComponentFlagBits -> ColorComponentFlagBits -> Bool
> :: ColorComponentFlagBits -> ColorComponentFlagBits -> Bool
$c> :: ColorComponentFlagBits -> ColorComponentFlagBits -> Bool
<= :: ColorComponentFlagBits -> ColorComponentFlagBits -> Bool
$c<= :: ColorComponentFlagBits -> ColorComponentFlagBits -> Bool
< :: ColorComponentFlagBits -> ColorComponentFlagBits -> Bool
$c< :: ColorComponentFlagBits -> ColorComponentFlagBits -> Bool
compare :: ColorComponentFlagBits -> ColorComponentFlagBits -> Ordering
$ccompare :: ColorComponentFlagBits -> ColorComponentFlagBits -> Ordering
$cp1Ord :: Eq ColorComponentFlagBits
Ord, Ptr b -> Int -> IO ColorComponentFlagBits
Ptr b -> Int -> ColorComponentFlagBits -> IO ()
Ptr ColorComponentFlagBits -> IO ColorComponentFlagBits
Ptr ColorComponentFlagBits -> Int -> IO ColorComponentFlagBits
Ptr ColorComponentFlagBits
-> Int -> ColorComponentFlagBits -> IO ()
Ptr ColorComponentFlagBits -> ColorComponentFlagBits -> IO ()
ColorComponentFlagBits -> Int
(ColorComponentFlagBits -> Int)
-> (ColorComponentFlagBits -> Int)
-> (Ptr ColorComponentFlagBits -> Int -> IO ColorComponentFlagBits)
-> (Ptr ColorComponentFlagBits
    -> Int -> ColorComponentFlagBits -> IO ())
-> (forall b. Ptr b -> Int -> IO ColorComponentFlagBits)
-> (forall b. Ptr b -> Int -> ColorComponentFlagBits -> IO ())
-> (Ptr ColorComponentFlagBits -> IO ColorComponentFlagBits)
-> (Ptr ColorComponentFlagBits -> ColorComponentFlagBits -> IO ())
-> Storable ColorComponentFlagBits
forall b. Ptr b -> Int -> IO ColorComponentFlagBits
forall b. Ptr b -> Int -> ColorComponentFlagBits -> 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 ColorComponentFlagBits -> ColorComponentFlagBits -> IO ()
$cpoke :: Ptr ColorComponentFlagBits -> ColorComponentFlagBits -> IO ()
peek :: Ptr ColorComponentFlagBits -> IO ColorComponentFlagBits
$cpeek :: Ptr ColorComponentFlagBits -> IO ColorComponentFlagBits
pokeByteOff :: Ptr b -> Int -> ColorComponentFlagBits -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> ColorComponentFlagBits -> IO ()
peekByteOff :: Ptr b -> Int -> IO ColorComponentFlagBits
$cpeekByteOff :: forall b. Ptr b -> Int -> IO ColorComponentFlagBits
pokeElemOff :: Ptr ColorComponentFlagBits
-> Int -> ColorComponentFlagBits -> IO ()
$cpokeElemOff :: Ptr ColorComponentFlagBits
-> Int -> ColorComponentFlagBits -> IO ()
peekElemOff :: Ptr ColorComponentFlagBits -> Int -> IO ColorComponentFlagBits
$cpeekElemOff :: Ptr ColorComponentFlagBits -> Int -> IO ColorComponentFlagBits
alignment :: ColorComponentFlagBits -> Int
$calignment :: ColorComponentFlagBits -> Int
sizeOf :: ColorComponentFlagBits -> Int
$csizeOf :: ColorComponentFlagBits -> Int
Storable, ColorComponentFlagBits
ColorComponentFlagBits -> Zero ColorComponentFlagBits
forall a. a -> Zero a
zero :: ColorComponentFlagBits
$czero :: ColorComponentFlagBits
Zero, Eq ColorComponentFlagBits
ColorComponentFlagBits
Eq ColorComponentFlagBits =>
(ColorComponentFlagBits
 -> ColorComponentFlagBits -> ColorComponentFlagBits)
-> (ColorComponentFlagBits
    -> ColorComponentFlagBits -> ColorComponentFlagBits)
-> (ColorComponentFlagBits
    -> ColorComponentFlagBits -> ColorComponentFlagBits)
-> (ColorComponentFlagBits -> ColorComponentFlagBits)
-> (ColorComponentFlagBits -> Int -> ColorComponentFlagBits)
-> (ColorComponentFlagBits -> Int -> ColorComponentFlagBits)
-> ColorComponentFlagBits
-> (Int -> ColorComponentFlagBits)
-> (ColorComponentFlagBits -> Int -> ColorComponentFlagBits)
-> (ColorComponentFlagBits -> Int -> ColorComponentFlagBits)
-> (ColorComponentFlagBits -> Int -> ColorComponentFlagBits)
-> (ColorComponentFlagBits -> Int -> Bool)
-> (ColorComponentFlagBits -> Maybe Int)
-> (ColorComponentFlagBits -> Int)
-> (ColorComponentFlagBits -> Bool)
-> (ColorComponentFlagBits -> Int -> ColorComponentFlagBits)
-> (ColorComponentFlagBits -> Int -> ColorComponentFlagBits)
-> (ColorComponentFlagBits -> Int -> ColorComponentFlagBits)
-> (ColorComponentFlagBits -> Int -> ColorComponentFlagBits)
-> (ColorComponentFlagBits -> Int -> ColorComponentFlagBits)
-> (ColorComponentFlagBits -> Int -> ColorComponentFlagBits)
-> (ColorComponentFlagBits -> Int)
-> Bits ColorComponentFlagBits
Int -> ColorComponentFlagBits
ColorComponentFlagBits -> Bool
ColorComponentFlagBits -> Int
ColorComponentFlagBits -> Maybe Int
ColorComponentFlagBits -> ColorComponentFlagBits
ColorComponentFlagBits -> Int -> Bool
ColorComponentFlagBits -> Int -> ColorComponentFlagBits
ColorComponentFlagBits
-> ColorComponentFlagBits -> ColorComponentFlagBits
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: ColorComponentFlagBits -> Int
$cpopCount :: ColorComponentFlagBits -> Int
rotateR :: ColorComponentFlagBits -> Int -> ColorComponentFlagBits
$crotateR :: ColorComponentFlagBits -> Int -> ColorComponentFlagBits
rotateL :: ColorComponentFlagBits -> Int -> ColorComponentFlagBits
$crotateL :: ColorComponentFlagBits -> Int -> ColorComponentFlagBits
unsafeShiftR :: ColorComponentFlagBits -> Int -> ColorComponentFlagBits
$cunsafeShiftR :: ColorComponentFlagBits -> Int -> ColorComponentFlagBits
shiftR :: ColorComponentFlagBits -> Int -> ColorComponentFlagBits
$cshiftR :: ColorComponentFlagBits -> Int -> ColorComponentFlagBits
unsafeShiftL :: ColorComponentFlagBits -> Int -> ColorComponentFlagBits
$cunsafeShiftL :: ColorComponentFlagBits -> Int -> ColorComponentFlagBits
shiftL :: ColorComponentFlagBits -> Int -> ColorComponentFlagBits
$cshiftL :: ColorComponentFlagBits -> Int -> ColorComponentFlagBits
isSigned :: ColorComponentFlagBits -> Bool
$cisSigned :: ColorComponentFlagBits -> Bool
bitSize :: ColorComponentFlagBits -> Int
$cbitSize :: ColorComponentFlagBits -> Int
bitSizeMaybe :: ColorComponentFlagBits -> Maybe Int
$cbitSizeMaybe :: ColorComponentFlagBits -> Maybe Int
testBit :: ColorComponentFlagBits -> Int -> Bool
$ctestBit :: ColorComponentFlagBits -> Int -> Bool
complementBit :: ColorComponentFlagBits -> Int -> ColorComponentFlagBits
$ccomplementBit :: ColorComponentFlagBits -> Int -> ColorComponentFlagBits
clearBit :: ColorComponentFlagBits -> Int -> ColorComponentFlagBits
$cclearBit :: ColorComponentFlagBits -> Int -> ColorComponentFlagBits
setBit :: ColorComponentFlagBits -> Int -> ColorComponentFlagBits
$csetBit :: ColorComponentFlagBits -> Int -> ColorComponentFlagBits
bit :: Int -> ColorComponentFlagBits
$cbit :: Int -> ColorComponentFlagBits
zeroBits :: ColorComponentFlagBits
$czeroBits :: ColorComponentFlagBits
rotate :: ColorComponentFlagBits -> Int -> ColorComponentFlagBits
$crotate :: ColorComponentFlagBits -> Int -> ColorComponentFlagBits
shift :: ColorComponentFlagBits -> Int -> ColorComponentFlagBits
$cshift :: ColorComponentFlagBits -> Int -> ColorComponentFlagBits
complement :: ColorComponentFlagBits -> ColorComponentFlagBits
$ccomplement :: ColorComponentFlagBits -> ColorComponentFlagBits
xor :: ColorComponentFlagBits
-> ColorComponentFlagBits -> ColorComponentFlagBits
$cxor :: ColorComponentFlagBits
-> ColorComponentFlagBits -> ColorComponentFlagBits
.|. :: ColorComponentFlagBits
-> ColorComponentFlagBits -> ColorComponentFlagBits
$c.|. :: ColorComponentFlagBits
-> ColorComponentFlagBits -> ColorComponentFlagBits
.&. :: ColorComponentFlagBits
-> ColorComponentFlagBits -> ColorComponentFlagBits
$c.&. :: ColorComponentFlagBits
-> ColorComponentFlagBits -> ColorComponentFlagBits
$cp1Bits :: Eq ColorComponentFlagBits
Bits)

-- | 'COLOR_COMPONENT_R_BIT' specifies that the R value is written to the
-- color attachment for the appropriate sample. Otherwise, the value in
-- memory is unmodified.
pattern $bCOLOR_COMPONENT_R_BIT :: ColorComponentFlagBits
$mCOLOR_COMPONENT_R_BIT :: forall r.
ColorComponentFlagBits -> (Void# -> r) -> (Void# -> r) -> r
COLOR_COMPONENT_R_BIT = ColorComponentFlagBits 0x00000001
-- | 'COLOR_COMPONENT_G_BIT' specifies that the G value is written to the
-- color attachment for the appropriate sample. Otherwise, the value in
-- memory is unmodified.
pattern $bCOLOR_COMPONENT_G_BIT :: ColorComponentFlagBits
$mCOLOR_COMPONENT_G_BIT :: forall r.
ColorComponentFlagBits -> (Void# -> r) -> (Void# -> r) -> r
COLOR_COMPONENT_G_BIT = ColorComponentFlagBits 0x00000002
-- | 'COLOR_COMPONENT_B_BIT' specifies that the B value is written to the
-- color attachment for the appropriate sample. Otherwise, the value in
-- memory is unmodified.
pattern $bCOLOR_COMPONENT_B_BIT :: ColorComponentFlagBits
$mCOLOR_COMPONENT_B_BIT :: forall r.
ColorComponentFlagBits -> (Void# -> r) -> (Void# -> r) -> r
COLOR_COMPONENT_B_BIT = ColorComponentFlagBits 0x00000004
-- | 'COLOR_COMPONENT_A_BIT' specifies that the A value is written to the
-- color attachment for the appropriate sample. Otherwise, the value in
-- memory is unmodified.
pattern $bCOLOR_COMPONENT_A_BIT :: ColorComponentFlagBits
$mCOLOR_COMPONENT_A_BIT :: forall r.
ColorComponentFlagBits -> (Void# -> r) -> (Void# -> r) -> r
COLOR_COMPONENT_A_BIT = ColorComponentFlagBits 0x00000008

type ColorComponentFlags = ColorComponentFlagBits

instance Show ColorComponentFlagBits where
  showsPrec :: Int -> ColorComponentFlagBits -> ShowS
showsPrec p :: Int
p = \case
    COLOR_COMPONENT_R_BIT -> String -> ShowS
showString "COLOR_COMPONENT_R_BIT"
    COLOR_COMPONENT_G_BIT -> String -> ShowS
showString "COLOR_COMPONENT_G_BIT"
    COLOR_COMPONENT_B_BIT -> String -> ShowS
showString "COLOR_COMPONENT_B_BIT"
    COLOR_COMPONENT_A_BIT -> String -> ShowS
showString "COLOR_COMPONENT_A_BIT"
    ColorComponentFlagBits x :: Flags
x -> Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 11) (String -> ShowS
showString "ColorComponentFlagBits 0x" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flags -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex Flags
x)

instance Read ColorComponentFlagBits where
  readPrec :: ReadPrec ColorComponentFlagBits
readPrec = ReadPrec ColorComponentFlagBits -> ReadPrec ColorComponentFlagBits
forall a. ReadPrec a -> ReadPrec a
parens ([(String, ReadPrec ColorComponentFlagBits)]
-> ReadPrec ColorComponentFlagBits
forall a. [(String, ReadPrec a)] -> ReadPrec a
choose [("COLOR_COMPONENT_R_BIT", ColorComponentFlagBits -> ReadPrec ColorComponentFlagBits
forall (f :: * -> *) a. Applicative f => a -> f a
pure ColorComponentFlagBits
COLOR_COMPONENT_R_BIT)
                            , ("COLOR_COMPONENT_G_BIT", ColorComponentFlagBits -> ReadPrec ColorComponentFlagBits
forall (f :: * -> *) a. Applicative f => a -> f a
pure ColorComponentFlagBits
COLOR_COMPONENT_G_BIT)
                            , ("COLOR_COMPONENT_B_BIT", ColorComponentFlagBits -> ReadPrec ColorComponentFlagBits
forall (f :: * -> *) a. Applicative f => a -> f a
pure ColorComponentFlagBits
COLOR_COMPONENT_B_BIT)
                            , ("COLOR_COMPONENT_A_BIT", ColorComponentFlagBits -> ReadPrec ColorComponentFlagBits
forall (f :: * -> *) a. Applicative f => a -> f a
pure ColorComponentFlagBits
COLOR_COMPONENT_A_BIT)]
                     ReadPrec ColorComponentFlagBits
-> ReadPrec ColorComponentFlagBits
-> ReadPrec ColorComponentFlagBits
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
                     Int
-> ReadPrec ColorComponentFlagBits
-> ReadPrec ColorComponentFlagBits
forall a. Int -> ReadPrec a -> ReadPrec a
prec 10 (do
                       Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident "ColorComponentFlagBits")
                       Flags
v <- ReadPrec Flags -> ReadPrec Flags
forall a. ReadPrec a -> ReadPrec a
step ReadPrec Flags
forall a. Read a => ReadPrec a
readPrec
                       ColorComponentFlagBits -> ReadPrec ColorComponentFlagBits
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Flags -> ColorComponentFlagBits
ColorComponentFlagBits Flags
v)))