{-# language CPP #-}
module Vulkan.Core10.Enums.BlendFactor  (BlendFactor( BLEND_FACTOR_ZERO
                                                    , BLEND_FACTOR_ONE
                                                    , BLEND_FACTOR_SRC_COLOR
                                                    , BLEND_FACTOR_ONE_MINUS_SRC_COLOR
                                                    , BLEND_FACTOR_DST_COLOR
                                                    , BLEND_FACTOR_ONE_MINUS_DST_COLOR
                                                    , BLEND_FACTOR_SRC_ALPHA
                                                    , BLEND_FACTOR_ONE_MINUS_SRC_ALPHA
                                                    , BLEND_FACTOR_DST_ALPHA
                                                    , BLEND_FACTOR_ONE_MINUS_DST_ALPHA
                                                    , BLEND_FACTOR_CONSTANT_COLOR
                                                    , BLEND_FACTOR_ONE_MINUS_CONSTANT_COLOR
                                                    , BLEND_FACTOR_CONSTANT_ALPHA
                                                    , BLEND_FACTOR_ONE_MINUS_CONSTANT_ALPHA
                                                    , BLEND_FACTOR_SRC_ALPHA_SATURATE
                                                    , BLEND_FACTOR_SRC1_COLOR
                                                    , BLEND_FACTOR_ONE_MINUS_SRC1_COLOR
                                                    , BLEND_FACTOR_SRC1_ALPHA
                                                    , BLEND_FACTOR_ONE_MINUS_SRC1_ALPHA
                                                    , ..
                                                    )) 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)
-- | VkBlendFactor - Framebuffer blending factors
--
-- = Description
--
-- The semantics of each enum value is described in the table below:
--
-- +-----------------------------------------+---------------------+--------+
-- | 'BlendFactor'                           | RGB Blend Factors   | Alpha  |
-- |                                         | (Sr,Sg,Sb) or       | Blend  |
-- |                                         | (Dr,Dg,Db)          | Factor |
-- |                                         |                     | (Sa or |
-- |                                         |                     | Da)    |
-- +=========================================+=====================+========+
-- | 'BLEND_FACTOR_ZERO'                     | (0,0,0)             | 0      |
-- +-----------------------------------------+---------------------+--------+
-- | 'BLEND_FACTOR_ONE'                      | (1,1,1)             | 1      |
-- +-----------------------------------------+---------------------+--------+
-- | 'BLEND_FACTOR_SRC_COLOR'                | (Rs0,Gs0,Bs0)       | As0    |
-- +-----------------------------------------+---------------------+--------+
-- | 'BLEND_FACTOR_ONE_MINUS_SRC_COLOR'      | (1-Rs0,1-Gs0,1-Bs0) | 1-As0  |
-- +-----------------------------------------+---------------------+--------+
-- | 'BLEND_FACTOR_DST_COLOR'                | (Rd,Gd,Bd)          | Ad     |
-- +-----------------------------------------+---------------------+--------+
-- | 'BLEND_FACTOR_ONE_MINUS_DST_COLOR'      | (1-Rd,1-Gd,1-Bd)    | 1-Ad   |
-- +-----------------------------------------+---------------------+--------+
-- | 'BLEND_FACTOR_SRC_ALPHA'                | (As0,As0,As0)       | As0    |
-- +-----------------------------------------+---------------------+--------+
-- | 'BLEND_FACTOR_ONE_MINUS_SRC_ALPHA'      | (1-As0,1-As0,1-As0) | 1-As0  |
-- +-----------------------------------------+---------------------+--------+
-- | 'BLEND_FACTOR_DST_ALPHA'                | (Ad,Ad,Ad)          | Ad     |
-- +-----------------------------------------+---------------------+--------+
-- | 'BLEND_FACTOR_ONE_MINUS_DST_ALPHA'      | (1-Ad,1-Ad,1-Ad)    | 1-Ad   |
-- +-----------------------------------------+---------------------+--------+
-- | 'BLEND_FACTOR_CONSTANT_COLOR'           | (Rc,Gc,Bc)          | Ac     |
-- +-----------------------------------------+---------------------+--------+
-- | 'BLEND_FACTOR_ONE_MINUS_CONSTANT_COLOR' | (1-Rc,1-Gc,1-Bc)    | 1-Ac   |
-- +-----------------------------------------+---------------------+--------+
-- | 'BLEND_FACTOR_CONSTANT_ALPHA'           | (Ac,Ac,Ac)          | Ac     |
-- +-----------------------------------------+---------------------+--------+
-- | 'BLEND_FACTOR_ONE_MINUS_CONSTANT_ALPHA' | (1-Ac,1-Ac,1-Ac)    | 1-Ac   |
-- +-----------------------------------------+---------------------+--------+
-- | 'BLEND_FACTOR_SRC_ALPHA_SATURATE'       | (f,f,f); f =        | 1      |
-- |                                         | min(As0,1-Ad)       |        |
-- +-----------------------------------------+---------------------+--------+
-- | 'BLEND_FACTOR_SRC1_COLOR'               | (Rs1,Gs1,Bs1)       | As1    |
-- +-----------------------------------------+---------------------+--------+
-- | 'BLEND_FACTOR_ONE_MINUS_SRC1_COLOR'     | (1-Rs1,1-Gs1,1-Bs1) | 1-As1  |
-- +-----------------------------------------+---------------------+--------+
-- | 'BLEND_FACTOR_SRC1_ALPHA'               | (As1,As1,As1)       | As1    |
-- +-----------------------------------------+---------------------+--------+
-- | 'BLEND_FACTOR_ONE_MINUS_SRC1_ALPHA'     | (1-As1,1-As1,1-As1) | 1-As1  |
-- +-----------------------------------------+---------------------+--------+
--
-- Blend Factors
--
-- In this table, the following conventions are used:
--
-- -   Rs0,Gs0,Bs0 and As0 represent the first source color R, G, B, and A
--     components, respectively, for the fragment output location
--     corresponding to the color attachment being blended.
--
-- -   Rs1,Gs1,Bs1 and As1 represent the second source color R, G, B, and A
--     components, respectively, used in dual source blending modes, for
--     the fragment output location corresponding to the color attachment
--     being blended.
--
-- -   Rd,Gd,Bd and Ad represent the R, G, B, and A components of the
--     destination color. That is, the color currently in the corresponding
--     color attachment for this fragment\/sample.
--
-- -   Rc,Gc,Bc and Ac represent the blend constant R, G, B, and A
--     components, respectively.
--
-- = See Also
--
-- 'Vulkan.Core10.Pipeline.PipelineColorBlendAttachmentState'
newtype BlendFactor = BlendFactor Int32
  deriving newtype (BlendFactor -> BlendFactor -> Bool
(BlendFactor -> BlendFactor -> Bool)
-> (BlendFactor -> BlendFactor -> Bool) -> Eq BlendFactor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlendFactor -> BlendFactor -> Bool
$c/= :: BlendFactor -> BlendFactor -> Bool
== :: BlendFactor -> BlendFactor -> Bool
$c== :: BlendFactor -> BlendFactor -> Bool
Eq, Eq BlendFactor
Eq BlendFactor =>
(BlendFactor -> BlendFactor -> Ordering)
-> (BlendFactor -> BlendFactor -> Bool)
-> (BlendFactor -> BlendFactor -> Bool)
-> (BlendFactor -> BlendFactor -> Bool)
-> (BlendFactor -> BlendFactor -> Bool)
-> (BlendFactor -> BlendFactor -> BlendFactor)
-> (BlendFactor -> BlendFactor -> BlendFactor)
-> Ord BlendFactor
BlendFactor -> BlendFactor -> Bool
BlendFactor -> BlendFactor -> Ordering
BlendFactor -> BlendFactor -> BlendFactor
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 :: BlendFactor -> BlendFactor -> BlendFactor
$cmin :: BlendFactor -> BlendFactor -> BlendFactor
max :: BlendFactor -> BlendFactor -> BlendFactor
$cmax :: BlendFactor -> BlendFactor -> BlendFactor
>= :: BlendFactor -> BlendFactor -> Bool
$c>= :: BlendFactor -> BlendFactor -> Bool
> :: BlendFactor -> BlendFactor -> Bool
$c> :: BlendFactor -> BlendFactor -> Bool
<= :: BlendFactor -> BlendFactor -> Bool
$c<= :: BlendFactor -> BlendFactor -> Bool
< :: BlendFactor -> BlendFactor -> Bool
$c< :: BlendFactor -> BlendFactor -> Bool
compare :: BlendFactor -> BlendFactor -> Ordering
$ccompare :: BlendFactor -> BlendFactor -> Ordering
$cp1Ord :: Eq BlendFactor
Ord, Ptr b -> Int -> IO BlendFactor
Ptr b -> Int -> BlendFactor -> IO ()
Ptr BlendFactor -> IO BlendFactor
Ptr BlendFactor -> Int -> IO BlendFactor
Ptr BlendFactor -> Int -> BlendFactor -> IO ()
Ptr BlendFactor -> BlendFactor -> IO ()
BlendFactor -> Int
(BlendFactor -> Int)
-> (BlendFactor -> Int)
-> (Ptr BlendFactor -> Int -> IO BlendFactor)
-> (Ptr BlendFactor -> Int -> BlendFactor -> IO ())
-> (forall b. Ptr b -> Int -> IO BlendFactor)
-> (forall b. Ptr b -> Int -> BlendFactor -> IO ())
-> (Ptr BlendFactor -> IO BlendFactor)
-> (Ptr BlendFactor -> BlendFactor -> IO ())
-> Storable BlendFactor
forall b. Ptr b -> Int -> IO BlendFactor
forall b. Ptr b -> Int -> BlendFactor -> 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 BlendFactor -> BlendFactor -> IO ()
$cpoke :: Ptr BlendFactor -> BlendFactor -> IO ()
peek :: Ptr BlendFactor -> IO BlendFactor
$cpeek :: Ptr BlendFactor -> IO BlendFactor
pokeByteOff :: Ptr b -> Int -> BlendFactor -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> BlendFactor -> IO ()
peekByteOff :: Ptr b -> Int -> IO BlendFactor
$cpeekByteOff :: forall b. Ptr b -> Int -> IO BlendFactor
pokeElemOff :: Ptr BlendFactor -> Int -> BlendFactor -> IO ()
$cpokeElemOff :: Ptr BlendFactor -> Int -> BlendFactor -> IO ()
peekElemOff :: Ptr BlendFactor -> Int -> IO BlendFactor
$cpeekElemOff :: Ptr BlendFactor -> Int -> IO BlendFactor
alignment :: BlendFactor -> Int
$calignment :: BlendFactor -> Int
sizeOf :: BlendFactor -> Int
$csizeOf :: BlendFactor -> Int
Storable, BlendFactor
BlendFactor -> Zero BlendFactor
forall a. a -> Zero a
zero :: BlendFactor
$czero :: BlendFactor
Zero)

-- No documentation found for Nested "VkBlendFactor" "VK_BLEND_FACTOR_ZERO"
pattern $bBLEND_FACTOR_ZERO :: BlendFactor
$mBLEND_FACTOR_ZERO :: forall r. BlendFactor -> (Void# -> r) -> (Void# -> r) -> r
BLEND_FACTOR_ZERO = BlendFactor 0
-- No documentation found for Nested "VkBlendFactor" "VK_BLEND_FACTOR_ONE"
pattern $bBLEND_FACTOR_ONE :: BlendFactor
$mBLEND_FACTOR_ONE :: forall r. BlendFactor -> (Void# -> r) -> (Void# -> r) -> r
BLEND_FACTOR_ONE = BlendFactor 1
-- No documentation found for Nested "VkBlendFactor" "VK_BLEND_FACTOR_SRC_COLOR"
pattern $bBLEND_FACTOR_SRC_COLOR :: BlendFactor
$mBLEND_FACTOR_SRC_COLOR :: forall r. BlendFactor -> (Void# -> r) -> (Void# -> r) -> r
BLEND_FACTOR_SRC_COLOR = BlendFactor 2
-- No documentation found for Nested "VkBlendFactor" "VK_BLEND_FACTOR_ONE_MINUS_SRC_COLOR"
pattern $bBLEND_FACTOR_ONE_MINUS_SRC_COLOR :: BlendFactor
$mBLEND_FACTOR_ONE_MINUS_SRC_COLOR :: forall r. BlendFactor -> (Void# -> r) -> (Void# -> r) -> r
BLEND_FACTOR_ONE_MINUS_SRC_COLOR = BlendFactor 3
-- No documentation found for Nested "VkBlendFactor" "VK_BLEND_FACTOR_DST_COLOR"
pattern $bBLEND_FACTOR_DST_COLOR :: BlendFactor
$mBLEND_FACTOR_DST_COLOR :: forall r. BlendFactor -> (Void# -> r) -> (Void# -> r) -> r
BLEND_FACTOR_DST_COLOR = BlendFactor 4
-- No documentation found for Nested "VkBlendFactor" "VK_BLEND_FACTOR_ONE_MINUS_DST_COLOR"
pattern $bBLEND_FACTOR_ONE_MINUS_DST_COLOR :: BlendFactor
$mBLEND_FACTOR_ONE_MINUS_DST_COLOR :: forall r. BlendFactor -> (Void# -> r) -> (Void# -> r) -> r
BLEND_FACTOR_ONE_MINUS_DST_COLOR = BlendFactor 5
-- No documentation found for Nested "VkBlendFactor" "VK_BLEND_FACTOR_SRC_ALPHA"
pattern $bBLEND_FACTOR_SRC_ALPHA :: BlendFactor
$mBLEND_FACTOR_SRC_ALPHA :: forall r. BlendFactor -> (Void# -> r) -> (Void# -> r) -> r
BLEND_FACTOR_SRC_ALPHA = BlendFactor 6
-- No documentation found for Nested "VkBlendFactor" "VK_BLEND_FACTOR_ONE_MINUS_SRC_ALPHA"
pattern $bBLEND_FACTOR_ONE_MINUS_SRC_ALPHA :: BlendFactor
$mBLEND_FACTOR_ONE_MINUS_SRC_ALPHA :: forall r. BlendFactor -> (Void# -> r) -> (Void# -> r) -> r
BLEND_FACTOR_ONE_MINUS_SRC_ALPHA = BlendFactor 7
-- No documentation found for Nested "VkBlendFactor" "VK_BLEND_FACTOR_DST_ALPHA"
pattern $bBLEND_FACTOR_DST_ALPHA :: BlendFactor
$mBLEND_FACTOR_DST_ALPHA :: forall r. BlendFactor -> (Void# -> r) -> (Void# -> r) -> r
BLEND_FACTOR_DST_ALPHA = BlendFactor 8
-- No documentation found for Nested "VkBlendFactor" "VK_BLEND_FACTOR_ONE_MINUS_DST_ALPHA"
pattern $bBLEND_FACTOR_ONE_MINUS_DST_ALPHA :: BlendFactor
$mBLEND_FACTOR_ONE_MINUS_DST_ALPHA :: forall r. BlendFactor -> (Void# -> r) -> (Void# -> r) -> r
BLEND_FACTOR_ONE_MINUS_DST_ALPHA = BlendFactor 9
-- No documentation found for Nested "VkBlendFactor" "VK_BLEND_FACTOR_CONSTANT_COLOR"
pattern $bBLEND_FACTOR_CONSTANT_COLOR :: BlendFactor
$mBLEND_FACTOR_CONSTANT_COLOR :: forall r. BlendFactor -> (Void# -> r) -> (Void# -> r) -> r
BLEND_FACTOR_CONSTANT_COLOR = BlendFactor 10
-- No documentation found for Nested "VkBlendFactor" "VK_BLEND_FACTOR_ONE_MINUS_CONSTANT_COLOR"
pattern $bBLEND_FACTOR_ONE_MINUS_CONSTANT_COLOR :: BlendFactor
$mBLEND_FACTOR_ONE_MINUS_CONSTANT_COLOR :: forall r. BlendFactor -> (Void# -> r) -> (Void# -> r) -> r
BLEND_FACTOR_ONE_MINUS_CONSTANT_COLOR = BlendFactor 11
-- No documentation found for Nested "VkBlendFactor" "VK_BLEND_FACTOR_CONSTANT_ALPHA"
pattern $bBLEND_FACTOR_CONSTANT_ALPHA :: BlendFactor
$mBLEND_FACTOR_CONSTANT_ALPHA :: forall r. BlendFactor -> (Void# -> r) -> (Void# -> r) -> r
BLEND_FACTOR_CONSTANT_ALPHA = BlendFactor 12
-- No documentation found for Nested "VkBlendFactor" "VK_BLEND_FACTOR_ONE_MINUS_CONSTANT_ALPHA"
pattern $bBLEND_FACTOR_ONE_MINUS_CONSTANT_ALPHA :: BlendFactor
$mBLEND_FACTOR_ONE_MINUS_CONSTANT_ALPHA :: forall r. BlendFactor -> (Void# -> r) -> (Void# -> r) -> r
BLEND_FACTOR_ONE_MINUS_CONSTANT_ALPHA = BlendFactor 13
-- No documentation found for Nested "VkBlendFactor" "VK_BLEND_FACTOR_SRC_ALPHA_SATURATE"
pattern $bBLEND_FACTOR_SRC_ALPHA_SATURATE :: BlendFactor
$mBLEND_FACTOR_SRC_ALPHA_SATURATE :: forall r. BlendFactor -> (Void# -> r) -> (Void# -> r) -> r
BLEND_FACTOR_SRC_ALPHA_SATURATE = BlendFactor 14
-- No documentation found for Nested "VkBlendFactor" "VK_BLEND_FACTOR_SRC1_COLOR"
pattern $bBLEND_FACTOR_SRC1_COLOR :: BlendFactor
$mBLEND_FACTOR_SRC1_COLOR :: forall r. BlendFactor -> (Void# -> r) -> (Void# -> r) -> r
BLEND_FACTOR_SRC1_COLOR = BlendFactor 15
-- No documentation found for Nested "VkBlendFactor" "VK_BLEND_FACTOR_ONE_MINUS_SRC1_COLOR"
pattern $bBLEND_FACTOR_ONE_MINUS_SRC1_COLOR :: BlendFactor
$mBLEND_FACTOR_ONE_MINUS_SRC1_COLOR :: forall r. BlendFactor -> (Void# -> r) -> (Void# -> r) -> r
BLEND_FACTOR_ONE_MINUS_SRC1_COLOR = BlendFactor 16
-- No documentation found for Nested "VkBlendFactor" "VK_BLEND_FACTOR_SRC1_ALPHA"
pattern $bBLEND_FACTOR_SRC1_ALPHA :: BlendFactor
$mBLEND_FACTOR_SRC1_ALPHA :: forall r. BlendFactor -> (Void# -> r) -> (Void# -> r) -> r
BLEND_FACTOR_SRC1_ALPHA = BlendFactor 17
-- No documentation found for Nested "VkBlendFactor" "VK_BLEND_FACTOR_ONE_MINUS_SRC1_ALPHA"
pattern $bBLEND_FACTOR_ONE_MINUS_SRC1_ALPHA :: BlendFactor
$mBLEND_FACTOR_ONE_MINUS_SRC1_ALPHA :: forall r. BlendFactor -> (Void# -> r) -> (Void# -> r) -> r
BLEND_FACTOR_ONE_MINUS_SRC1_ALPHA = BlendFactor 18
{-# complete BLEND_FACTOR_ZERO,
             BLEND_FACTOR_ONE,
             BLEND_FACTOR_SRC_COLOR,
             BLEND_FACTOR_ONE_MINUS_SRC_COLOR,
             BLEND_FACTOR_DST_COLOR,
             BLEND_FACTOR_ONE_MINUS_DST_COLOR,
             BLEND_FACTOR_SRC_ALPHA,
             BLEND_FACTOR_ONE_MINUS_SRC_ALPHA,
             BLEND_FACTOR_DST_ALPHA,
             BLEND_FACTOR_ONE_MINUS_DST_ALPHA,
             BLEND_FACTOR_CONSTANT_COLOR,
             BLEND_FACTOR_ONE_MINUS_CONSTANT_COLOR,
             BLEND_FACTOR_CONSTANT_ALPHA,
             BLEND_FACTOR_ONE_MINUS_CONSTANT_ALPHA,
             BLEND_FACTOR_SRC_ALPHA_SATURATE,
             BLEND_FACTOR_SRC1_COLOR,
             BLEND_FACTOR_ONE_MINUS_SRC1_COLOR,
             BLEND_FACTOR_SRC1_ALPHA,
             BLEND_FACTOR_ONE_MINUS_SRC1_ALPHA :: BlendFactor #-}

instance Show BlendFactor where
  showsPrec :: Int -> BlendFactor -> ShowS
showsPrec p :: Int
p = \case
    BLEND_FACTOR_ZERO -> String -> ShowS
showString "BLEND_FACTOR_ZERO"
    BLEND_FACTOR_ONE -> String -> ShowS
showString "BLEND_FACTOR_ONE"
    BLEND_FACTOR_SRC_COLOR -> String -> ShowS
showString "BLEND_FACTOR_SRC_COLOR"
    BLEND_FACTOR_ONE_MINUS_SRC_COLOR -> String -> ShowS
showString "BLEND_FACTOR_ONE_MINUS_SRC_COLOR"
    BLEND_FACTOR_DST_COLOR -> String -> ShowS
showString "BLEND_FACTOR_DST_COLOR"
    BLEND_FACTOR_ONE_MINUS_DST_COLOR -> String -> ShowS
showString "BLEND_FACTOR_ONE_MINUS_DST_COLOR"
    BLEND_FACTOR_SRC_ALPHA -> String -> ShowS
showString "BLEND_FACTOR_SRC_ALPHA"
    BLEND_FACTOR_ONE_MINUS_SRC_ALPHA -> String -> ShowS
showString "BLEND_FACTOR_ONE_MINUS_SRC_ALPHA"
    BLEND_FACTOR_DST_ALPHA -> String -> ShowS
showString "BLEND_FACTOR_DST_ALPHA"
    BLEND_FACTOR_ONE_MINUS_DST_ALPHA -> String -> ShowS
showString "BLEND_FACTOR_ONE_MINUS_DST_ALPHA"
    BLEND_FACTOR_CONSTANT_COLOR -> String -> ShowS
showString "BLEND_FACTOR_CONSTANT_COLOR"
    BLEND_FACTOR_ONE_MINUS_CONSTANT_COLOR -> String -> ShowS
showString "BLEND_FACTOR_ONE_MINUS_CONSTANT_COLOR"
    BLEND_FACTOR_CONSTANT_ALPHA -> String -> ShowS
showString "BLEND_FACTOR_CONSTANT_ALPHA"
    BLEND_FACTOR_ONE_MINUS_CONSTANT_ALPHA -> String -> ShowS
showString "BLEND_FACTOR_ONE_MINUS_CONSTANT_ALPHA"
    BLEND_FACTOR_SRC_ALPHA_SATURATE -> String -> ShowS
showString "BLEND_FACTOR_SRC_ALPHA_SATURATE"
    BLEND_FACTOR_SRC1_COLOR -> String -> ShowS
showString "BLEND_FACTOR_SRC1_COLOR"
    BLEND_FACTOR_ONE_MINUS_SRC1_COLOR -> String -> ShowS
showString "BLEND_FACTOR_ONE_MINUS_SRC1_COLOR"
    BLEND_FACTOR_SRC1_ALPHA -> String -> ShowS
showString "BLEND_FACTOR_SRC1_ALPHA"
    BLEND_FACTOR_ONE_MINUS_SRC1_ALPHA -> String -> ShowS
showString "BLEND_FACTOR_ONE_MINUS_SRC1_ALPHA"
    BlendFactor x :: Int32
x -> Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 11) (String -> ShowS
showString "BlendFactor " 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 BlendFactor where
  readPrec :: ReadPrec BlendFactor
readPrec = ReadPrec BlendFactor -> ReadPrec BlendFactor
forall a. ReadPrec a -> ReadPrec a
parens ([(String, ReadPrec BlendFactor)] -> ReadPrec BlendFactor
forall a. [(String, ReadPrec a)] -> ReadPrec a
choose [("BLEND_FACTOR_ZERO", BlendFactor -> ReadPrec BlendFactor
forall (f :: * -> *) a. Applicative f => a -> f a
pure BlendFactor
BLEND_FACTOR_ZERO)
                            , ("BLEND_FACTOR_ONE", BlendFactor -> ReadPrec BlendFactor
forall (f :: * -> *) a. Applicative f => a -> f a
pure BlendFactor
BLEND_FACTOR_ONE)
                            , ("BLEND_FACTOR_SRC_COLOR", BlendFactor -> ReadPrec BlendFactor
forall (f :: * -> *) a. Applicative f => a -> f a
pure BlendFactor
BLEND_FACTOR_SRC_COLOR)
                            , ("BLEND_FACTOR_ONE_MINUS_SRC_COLOR", BlendFactor -> ReadPrec BlendFactor
forall (f :: * -> *) a. Applicative f => a -> f a
pure BlendFactor
BLEND_FACTOR_ONE_MINUS_SRC_COLOR)
                            , ("BLEND_FACTOR_DST_COLOR", BlendFactor -> ReadPrec BlendFactor
forall (f :: * -> *) a. Applicative f => a -> f a
pure BlendFactor
BLEND_FACTOR_DST_COLOR)
                            , ("BLEND_FACTOR_ONE_MINUS_DST_COLOR", BlendFactor -> ReadPrec BlendFactor
forall (f :: * -> *) a. Applicative f => a -> f a
pure BlendFactor
BLEND_FACTOR_ONE_MINUS_DST_COLOR)
                            , ("BLEND_FACTOR_SRC_ALPHA", BlendFactor -> ReadPrec BlendFactor
forall (f :: * -> *) a. Applicative f => a -> f a
pure BlendFactor
BLEND_FACTOR_SRC_ALPHA)
                            , ("BLEND_FACTOR_ONE_MINUS_SRC_ALPHA", BlendFactor -> ReadPrec BlendFactor
forall (f :: * -> *) a. Applicative f => a -> f a
pure BlendFactor
BLEND_FACTOR_ONE_MINUS_SRC_ALPHA)
                            , ("BLEND_FACTOR_DST_ALPHA", BlendFactor -> ReadPrec BlendFactor
forall (f :: * -> *) a. Applicative f => a -> f a
pure BlendFactor
BLEND_FACTOR_DST_ALPHA)
                            , ("BLEND_FACTOR_ONE_MINUS_DST_ALPHA", BlendFactor -> ReadPrec BlendFactor
forall (f :: * -> *) a. Applicative f => a -> f a
pure BlendFactor
BLEND_FACTOR_ONE_MINUS_DST_ALPHA)
                            , ("BLEND_FACTOR_CONSTANT_COLOR", BlendFactor -> ReadPrec BlendFactor
forall (f :: * -> *) a. Applicative f => a -> f a
pure BlendFactor
BLEND_FACTOR_CONSTANT_COLOR)
                            , ("BLEND_FACTOR_ONE_MINUS_CONSTANT_COLOR", BlendFactor -> ReadPrec BlendFactor
forall (f :: * -> *) a. Applicative f => a -> f a
pure BlendFactor
BLEND_FACTOR_ONE_MINUS_CONSTANT_COLOR)
                            , ("BLEND_FACTOR_CONSTANT_ALPHA", BlendFactor -> ReadPrec BlendFactor
forall (f :: * -> *) a. Applicative f => a -> f a
pure BlendFactor
BLEND_FACTOR_CONSTANT_ALPHA)
                            , ("BLEND_FACTOR_ONE_MINUS_CONSTANT_ALPHA", BlendFactor -> ReadPrec BlendFactor
forall (f :: * -> *) a. Applicative f => a -> f a
pure BlendFactor
BLEND_FACTOR_ONE_MINUS_CONSTANT_ALPHA)
                            , ("BLEND_FACTOR_SRC_ALPHA_SATURATE", BlendFactor -> ReadPrec BlendFactor
forall (f :: * -> *) a. Applicative f => a -> f a
pure BlendFactor
BLEND_FACTOR_SRC_ALPHA_SATURATE)
                            , ("BLEND_FACTOR_SRC1_COLOR", BlendFactor -> ReadPrec BlendFactor
forall (f :: * -> *) a. Applicative f => a -> f a
pure BlendFactor
BLEND_FACTOR_SRC1_COLOR)
                            , ("BLEND_FACTOR_ONE_MINUS_SRC1_COLOR", BlendFactor -> ReadPrec BlendFactor
forall (f :: * -> *) a. Applicative f => a -> f a
pure BlendFactor
BLEND_FACTOR_ONE_MINUS_SRC1_COLOR)
                            , ("BLEND_FACTOR_SRC1_ALPHA", BlendFactor -> ReadPrec BlendFactor
forall (f :: * -> *) a. Applicative f => a -> f a
pure BlendFactor
BLEND_FACTOR_SRC1_ALPHA)
                            , ("BLEND_FACTOR_ONE_MINUS_SRC1_ALPHA", BlendFactor -> ReadPrec BlendFactor
forall (f :: * -> *) a. Applicative f => a -> f a
pure BlendFactor
BLEND_FACTOR_ONE_MINUS_SRC1_ALPHA)]
                     ReadPrec BlendFactor
-> ReadPrec BlendFactor -> ReadPrec BlendFactor
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
                     Int -> ReadPrec BlendFactor -> ReadPrec BlendFactor
forall a. Int -> ReadPrec a -> ReadPrec a
prec 10 (do
                       Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Ident "BlendFactor")
                       Int32
v <- ReadPrec Int32 -> ReadPrec Int32
forall a. ReadPrec a -> ReadPrec a
step ReadPrec Int32
forall a. Read a => ReadPrec a
readPrec
                       BlendFactor -> ReadPrec BlendFactor
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int32 -> BlendFactor
BlendFactor Int32
v)))