{-# language CPP #-}
module Vulkan.Core11.Enums.SamplerYcbcrRange  (SamplerYcbcrRange( SAMPLER_YCBCR_RANGE_ITU_FULL
                                                                , SAMPLER_YCBCR_RANGE_ITU_NARROW
                                                                , ..
                                                                )) where

import GHC.Read (choose)
import GHC.Read (expectP)
import GHC.Read (parens)
import GHC.Show (showParen)
import GHC.Show (showString)
import GHC.Show (showsPrec)
import Text.ParserCombinators.ReadPrec ((+++))
import Text.ParserCombinators.ReadPrec (prec)
import Text.ParserCombinators.ReadPrec (step)
import Foreign.Storable (Storable)
import Data.Int (Int32)
import GHC.Read (Read(readPrec))
import Text.Read.Lex (Lexeme(Ident))
import Vulkan.Zero (Zero)
-- | VkSamplerYcbcrRange - Range of encoded values in a color space
--
-- = Description
--
-- The formulae for these conversions is described in the
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#textures-sampler-YCbCr-conversion-rangeexpand Sampler Y′CBCR Range Expansion>
-- section of the
-- <https://www.khronos.org/registry/vulkan/specs/1.2-extensions/html/vkspec.html#textures Image Operations>
-- chapter.
--
-- No range modification takes place if @ycbcrModel@ is
-- 'Vulkan.Core11.Enums.SamplerYcbcrModelConversion.SAMPLER_YCBCR_MODEL_CONVERSION_RGB_IDENTITY';
-- the @ycbcrRange@ field of
-- 'Vulkan.Core11.Promoted_From_VK_KHR_sampler_ycbcr_conversion.SamplerYcbcrConversionCreateInfo'
-- is ignored in this case.
--
-- = See Also
--
-- 'Vulkan.Extensions.VK_ANDROID_external_memory_android_hardware_buffer.AndroidHardwareBufferFormatPropertiesANDROID',
-- 'Vulkan.Core11.Promoted_From_VK_KHR_sampler_ycbcr_conversion.SamplerYcbcrConversionCreateInfo'
newtype SamplerYcbcrRange = SamplerYcbcrRange Int32
  deriving newtype (SamplerYcbcrRange -> SamplerYcbcrRange -> Bool
(SamplerYcbcrRange -> SamplerYcbcrRange -> Bool)
-> (SamplerYcbcrRange -> SamplerYcbcrRange -> Bool)
-> Eq SamplerYcbcrRange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SamplerYcbcrRange -> SamplerYcbcrRange -> Bool
$c/= :: SamplerYcbcrRange -> SamplerYcbcrRange -> Bool
== :: SamplerYcbcrRange -> SamplerYcbcrRange -> Bool
$c== :: SamplerYcbcrRange -> SamplerYcbcrRange -> Bool
Eq, Eq SamplerYcbcrRange
Eq SamplerYcbcrRange =>
(SamplerYcbcrRange -> SamplerYcbcrRange -> Ordering)
-> (SamplerYcbcrRange -> SamplerYcbcrRange -> Bool)
-> (SamplerYcbcrRange -> SamplerYcbcrRange -> Bool)
-> (SamplerYcbcrRange -> SamplerYcbcrRange -> Bool)
-> (SamplerYcbcrRange -> SamplerYcbcrRange -> Bool)
-> (SamplerYcbcrRange -> SamplerYcbcrRange -> SamplerYcbcrRange)
-> (SamplerYcbcrRange -> SamplerYcbcrRange -> SamplerYcbcrRange)
-> Ord SamplerYcbcrRange
SamplerYcbcrRange -> SamplerYcbcrRange -> Bool
SamplerYcbcrRange -> SamplerYcbcrRange -> Ordering
SamplerYcbcrRange -> SamplerYcbcrRange -> SamplerYcbcrRange
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 :: SamplerYcbcrRange -> SamplerYcbcrRange -> SamplerYcbcrRange
$cmin :: SamplerYcbcrRange -> SamplerYcbcrRange -> SamplerYcbcrRange
max :: SamplerYcbcrRange -> SamplerYcbcrRange -> SamplerYcbcrRange
$cmax :: SamplerYcbcrRange -> SamplerYcbcrRange -> SamplerYcbcrRange
>= :: SamplerYcbcrRange -> SamplerYcbcrRange -> Bool
$c>= :: SamplerYcbcrRange -> SamplerYcbcrRange -> Bool
> :: SamplerYcbcrRange -> SamplerYcbcrRange -> Bool
$c> :: SamplerYcbcrRange -> SamplerYcbcrRange -> Bool
<= :: SamplerYcbcrRange -> SamplerYcbcrRange -> Bool
$c<= :: SamplerYcbcrRange -> SamplerYcbcrRange -> Bool
< :: SamplerYcbcrRange -> SamplerYcbcrRange -> Bool
$c< :: SamplerYcbcrRange -> SamplerYcbcrRange -> Bool
compare :: SamplerYcbcrRange -> SamplerYcbcrRange -> Ordering
$ccompare :: SamplerYcbcrRange -> SamplerYcbcrRange -> Ordering
$cp1Ord :: Eq SamplerYcbcrRange
Ord, Ptr b -> Int -> IO SamplerYcbcrRange
Ptr b -> Int -> SamplerYcbcrRange -> IO ()
Ptr SamplerYcbcrRange -> IO SamplerYcbcrRange
Ptr SamplerYcbcrRange -> Int -> IO SamplerYcbcrRange
Ptr SamplerYcbcrRange -> Int -> SamplerYcbcrRange -> IO ()
Ptr SamplerYcbcrRange -> SamplerYcbcrRange -> IO ()
SamplerYcbcrRange -> Int
(SamplerYcbcrRange -> Int)
-> (SamplerYcbcrRange -> Int)
-> (Ptr SamplerYcbcrRange -> Int -> IO SamplerYcbcrRange)
-> (Ptr SamplerYcbcrRange -> Int -> SamplerYcbcrRange -> IO ())
-> (forall b. Ptr b -> Int -> IO SamplerYcbcrRange)
-> (forall b. Ptr b -> Int -> SamplerYcbcrRange -> IO ())
-> (Ptr SamplerYcbcrRange -> IO SamplerYcbcrRange)
-> (Ptr SamplerYcbcrRange -> SamplerYcbcrRange -> IO ())
-> Storable SamplerYcbcrRange
forall b. Ptr b -> Int -> IO SamplerYcbcrRange
forall b. Ptr b -> Int -> SamplerYcbcrRange -> 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 SamplerYcbcrRange -> SamplerYcbcrRange -> IO ()
$cpoke :: Ptr SamplerYcbcrRange -> SamplerYcbcrRange -> IO ()
peek :: Ptr SamplerYcbcrRange -> IO SamplerYcbcrRange
$cpeek :: Ptr SamplerYcbcrRange -> IO SamplerYcbcrRange
pokeByteOff :: Ptr b -> Int -> SamplerYcbcrRange -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> SamplerYcbcrRange -> IO ()
peekByteOff :: Ptr b -> Int -> IO SamplerYcbcrRange
$cpeekByteOff :: forall b. Ptr b -> Int -> IO SamplerYcbcrRange
pokeElemOff :: Ptr SamplerYcbcrRange -> Int -> SamplerYcbcrRange -> IO ()
$cpokeElemOff :: Ptr SamplerYcbcrRange -> Int -> SamplerYcbcrRange -> IO ()
peekElemOff :: Ptr SamplerYcbcrRange -> Int -> IO SamplerYcbcrRange
$cpeekElemOff :: Ptr SamplerYcbcrRange -> Int -> IO SamplerYcbcrRange
alignment :: SamplerYcbcrRange -> Int
$calignment :: SamplerYcbcrRange -> Int
sizeOf :: SamplerYcbcrRange -> Int
$csizeOf :: SamplerYcbcrRange -> Int
Storable, SamplerYcbcrRange
SamplerYcbcrRange -> Zero SamplerYcbcrRange
forall a. a -> Zero a
zero :: SamplerYcbcrRange
$czero :: SamplerYcbcrRange
Zero)

-- | 'SAMPLER_YCBCR_RANGE_ITU_FULL' specifies that the full range of the
-- encoded values are valid and interpreted according to the ITU “full
-- range” quantization rules.
pattern $bSAMPLER_YCBCR_RANGE_ITU_FULL :: SamplerYcbcrRange
$mSAMPLER_YCBCR_RANGE_ITU_FULL :: forall r. SamplerYcbcrRange -> (Void# -> r) -> (Void# -> r) -> r
SAMPLER_YCBCR_RANGE_ITU_FULL = SamplerYcbcrRange 0
-- | 'SAMPLER_YCBCR_RANGE_ITU_NARROW' specifies that headroom and foot room
-- are reserved in the numerical range of encoded values, and the remaining
-- values are expanded according to the ITU “narrow range” quantization
-- rules.
pattern $bSAMPLER_YCBCR_RANGE_ITU_NARROW :: SamplerYcbcrRange
$mSAMPLER_YCBCR_RANGE_ITU_NARROW :: forall r. SamplerYcbcrRange -> (Void# -> r) -> (Void# -> r) -> r
SAMPLER_YCBCR_RANGE_ITU_NARROW = SamplerYcbcrRange 1
{-# complete SAMPLER_YCBCR_RANGE_ITU_FULL,
             SAMPLER_YCBCR_RANGE_ITU_NARROW :: SamplerYcbcrRange #-}

instance Show SamplerYcbcrRange where
  showsPrec :: Int -> SamplerYcbcrRange -> ShowS
showsPrec p :: Int
p = \case
    SAMPLER_YCBCR_RANGE_ITU_FULL -> String -> ShowS
showString "SAMPLER_YCBCR_RANGE_ITU_FULL"
    SAMPLER_YCBCR_RANGE_ITU_NARROW -> String -> ShowS
showString "SAMPLER_YCBCR_RANGE_ITU_NARROW"
    SamplerYcbcrRange x :: Int32
x -> Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 11) (String -> ShowS
showString "SamplerYcbcrRange " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 11 Int32
x)

instance Read SamplerYcbcrRange where
  readPrec :: ReadPrec SamplerYcbcrRange
readPrec = ReadPrec SamplerYcbcrRange -> ReadPrec SamplerYcbcrRange
forall a. ReadPrec a -> ReadPrec a
parens ([(String, ReadPrec SamplerYcbcrRange)]
-> ReadPrec SamplerYcbcrRange
forall a. [(String, ReadPrec a)] -> ReadPrec a
choose [("SAMPLER_YCBCR_RANGE_ITU_FULL", SamplerYcbcrRange -> ReadPrec SamplerYcbcrRange
forall (f :: * -> *) a. Applicative f => a -> f a
pure SamplerYcbcrRange
SAMPLER_YCBCR_RANGE_ITU_FULL)
                            , ("SAMPLER_YCBCR_RANGE_ITU_NARROW", SamplerYcbcrRange -> ReadPrec SamplerYcbcrRange
forall (f :: * -> *) a. Applicative f => a -> f a
pure SamplerYcbcrRange
SAMPLER_YCBCR_RANGE_ITU_NARROW)]
                     ReadPrec SamplerYcbcrRange
-> ReadPrec SamplerYcbcrRange -> ReadPrec SamplerYcbcrRange
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
                     Int -> ReadPrec SamplerYcbcrRange -> ReadPrec SamplerYcbcrRange
forall a. Int -> ReadPrec a -> ReadPrec a
prec 10 (do
                       Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident "SamplerYcbcrRange")
                       Int32
v <- ReadPrec Int32 -> ReadPrec Int32
forall a. ReadPrec a -> ReadPrec a
step ReadPrec Int32
forall a. Read a => ReadPrec a
readPrec
                       SamplerYcbcrRange -> ReadPrec SamplerYcbcrRange
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int32 -> SamplerYcbcrRange
SamplerYcbcrRange Int32
v)))