module Codec.GlTF.Sampler
  ( SamplerIx(..)
  , Sampler(..)

  , SamplerWrap(..)
  , pattern CLAMP_TO_EDGE
  , pattern MIRRORED_REPEAT
  , pattern REPEAT

  , SamplerMagFilter(..)
  , pattern MAG_NEAREST
  , pattern MAG_LINEAR

  , SamplerMinFilter(..)
  , pattern MIN_NEAREST
  , pattern MIN_LINEAR
  , pattern MIN_NEAREST_MIPMAP_NEAREST
  , pattern MIN_LINEAR_MIPMAP_NEAREST
  , pattern MIN_NEAREST_MIPMAP_LINEAR
  , pattern MIN_LINEAR_MIPMAP_LINEAR
  ) where

import Codec.GlTF.Prelude

newtype SamplerIx = SamplerIx { SamplerIx -> Int
unSamplerIx :: Int }
  deriving (SamplerIx -> SamplerIx -> Bool
(SamplerIx -> SamplerIx -> Bool)
-> (SamplerIx -> SamplerIx -> Bool) -> Eq SamplerIx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SamplerIx -> SamplerIx -> Bool
$c/= :: SamplerIx -> SamplerIx -> Bool
== :: SamplerIx -> SamplerIx -> Bool
$c== :: SamplerIx -> SamplerIx -> Bool
Eq, Eq SamplerIx
Eq SamplerIx
-> (SamplerIx -> SamplerIx -> Ordering)
-> (SamplerIx -> SamplerIx -> Bool)
-> (SamplerIx -> SamplerIx -> Bool)
-> (SamplerIx -> SamplerIx -> Bool)
-> (SamplerIx -> SamplerIx -> Bool)
-> (SamplerIx -> SamplerIx -> SamplerIx)
-> (SamplerIx -> SamplerIx -> SamplerIx)
-> Ord SamplerIx
SamplerIx -> SamplerIx -> Bool
SamplerIx -> SamplerIx -> Ordering
SamplerIx -> SamplerIx -> SamplerIx
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 :: SamplerIx -> SamplerIx -> SamplerIx
$cmin :: SamplerIx -> SamplerIx -> SamplerIx
max :: SamplerIx -> SamplerIx -> SamplerIx
$cmax :: SamplerIx -> SamplerIx -> SamplerIx
>= :: SamplerIx -> SamplerIx -> Bool
$c>= :: SamplerIx -> SamplerIx -> Bool
> :: SamplerIx -> SamplerIx -> Bool
$c> :: SamplerIx -> SamplerIx -> Bool
<= :: SamplerIx -> SamplerIx -> Bool
$c<= :: SamplerIx -> SamplerIx -> Bool
< :: SamplerIx -> SamplerIx -> Bool
$c< :: SamplerIx -> SamplerIx -> Bool
compare :: SamplerIx -> SamplerIx -> Ordering
$ccompare :: SamplerIx -> SamplerIx -> Ordering
$cp1Ord :: Eq SamplerIx
Ord, Int -> SamplerIx -> ShowS
[SamplerIx] -> ShowS
SamplerIx -> String
(Int -> SamplerIx -> ShowS)
-> (SamplerIx -> String)
-> ([SamplerIx] -> ShowS)
-> Show SamplerIx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SamplerIx] -> ShowS
$cshowList :: [SamplerIx] -> ShowS
show :: SamplerIx -> String
$cshow :: SamplerIx -> String
showsPrec :: Int -> SamplerIx -> ShowS
$cshowsPrec :: Int -> SamplerIx -> ShowS
Show, Value -> Parser [SamplerIx]
Value -> Parser SamplerIx
(Value -> Parser SamplerIx)
-> (Value -> Parser [SamplerIx]) -> FromJSON SamplerIx
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [SamplerIx]
$cparseJSONList :: Value -> Parser [SamplerIx]
parseJSON :: Value -> Parser SamplerIx
$cparseJSON :: Value -> Parser SamplerIx
FromJSON, [SamplerIx] -> Encoding
[SamplerIx] -> Value
SamplerIx -> Encoding
SamplerIx -> Value
(SamplerIx -> Value)
-> (SamplerIx -> Encoding)
-> ([SamplerIx] -> Value)
-> ([SamplerIx] -> Encoding)
-> ToJSON SamplerIx
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [SamplerIx] -> Encoding
$ctoEncodingList :: [SamplerIx] -> Encoding
toJSONList :: [SamplerIx] -> Value
$ctoJSONList :: [SamplerIx] -> Value
toEncoding :: SamplerIx -> Encoding
$ctoEncoding :: SamplerIx -> Encoding
toJSON :: SamplerIx -> Value
$ctoJSON :: SamplerIx -> Value
ToJSON, (forall x. SamplerIx -> Rep SamplerIx x)
-> (forall x. Rep SamplerIx x -> SamplerIx) -> Generic SamplerIx
forall x. Rep SamplerIx x -> SamplerIx
forall x. SamplerIx -> Rep SamplerIx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SamplerIx x -> SamplerIx
$cfrom :: forall x. SamplerIx -> Rep SamplerIx x
Generic)

-- | The root object for a glTF Sampler.
data Sampler = Sampler
  { Sampler -> SamplerWrap
wrapS      :: SamplerWrap
  , Sampler -> SamplerWrap
wrapT      :: SamplerWrap
  , Sampler -> Maybe SamplerMagFilter
magFilter  :: Maybe SamplerMagFilter
  , Sampler -> Maybe SamplerMinFilter
minFilter  :: Maybe SamplerMinFilter
  , Sampler -> Maybe Text
name       :: Maybe Text
  , Sampler -> Maybe Object
extensions :: Maybe Object
  , Sampler -> Maybe Value
extras     :: Maybe Value
  } deriving (Sampler -> Sampler -> Bool
(Sampler -> Sampler -> Bool)
-> (Sampler -> Sampler -> Bool) -> Eq Sampler
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sampler -> Sampler -> Bool
$c/= :: Sampler -> Sampler -> Bool
== :: Sampler -> Sampler -> Bool
$c== :: Sampler -> Sampler -> Bool
Eq, Int -> Sampler -> ShowS
[Sampler] -> ShowS
Sampler -> String
(Int -> Sampler -> ShowS)
-> (Sampler -> String) -> ([Sampler] -> ShowS) -> Show Sampler
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sampler] -> ShowS
$cshowList :: [Sampler] -> ShowS
show :: Sampler -> String
$cshow :: Sampler -> String
showsPrec :: Int -> Sampler -> ShowS
$cshowsPrec :: Int -> Sampler -> ShowS
Show, (forall x. Sampler -> Rep Sampler x)
-> (forall x. Rep Sampler x -> Sampler) -> Generic Sampler
forall x. Rep Sampler x -> Sampler
forall x. Sampler -> Rep Sampler x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Sampler x -> Sampler
$cfrom :: forall x. Sampler -> Rep Sampler x
Generic)

instance FromJSON Sampler where
  parseJSON :: Value -> Parser Sampler
parseJSON = String -> (Object -> Parser Sampler) -> Value -> Parser Sampler
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Sampler" \Object
o -> do
    SamplerWrap
wrapS      <- Object
o Object -> Key -> Parser (Maybe SamplerWrap)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"wrapS" Parser (Maybe SamplerWrap) -> SamplerWrap -> Parser SamplerWrap
forall a. Parser (Maybe a) -> a -> Parser a
.!= SamplerWrap
REPEAT
    SamplerWrap
wrapT      <- Object
o Object -> Key -> Parser (Maybe SamplerWrap)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"wrapT" Parser (Maybe SamplerWrap) -> SamplerWrap -> Parser SamplerWrap
forall a. Parser (Maybe a) -> a -> Parser a
.!= SamplerWrap
REPEAT
    Maybe SamplerMagFilter
magFilter  <- Object
o Object -> Key -> Parser (Maybe SamplerMagFilter)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"magFilter"
    Maybe SamplerMinFilter
minFilter  <- Object
o Object -> Key -> Parser (Maybe SamplerMinFilter)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"minFilter"
    Maybe Text
name       <- Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name"
    Maybe Object
extensions <- Object
o Object -> Key -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"extensions"
    Maybe Value
extras     <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"extras"
    pure Sampler :: SamplerWrap
-> SamplerWrap
-> Maybe SamplerMagFilter
-> Maybe SamplerMinFilter
-> Maybe Text
-> Maybe Object
-> Maybe Value
-> Sampler
Sampler{Maybe Text
Maybe Value
Maybe Object
Maybe SamplerMinFilter
Maybe SamplerMagFilter
SamplerWrap
extras :: Maybe Value
extensions :: Maybe Object
name :: Maybe Text
minFilter :: Maybe SamplerMinFilter
magFilter :: Maybe SamplerMagFilter
wrapT :: SamplerWrap
wrapS :: SamplerWrap
$sel:extras:Sampler :: Maybe Value
$sel:extensions:Sampler :: Maybe Object
$sel:name:Sampler :: Maybe Text
$sel:minFilter:Sampler :: Maybe SamplerMinFilter
$sel:magFilter:Sampler :: Maybe SamplerMagFilter
$sel:wrapT:Sampler :: SamplerWrap
$sel:wrapS:Sampler :: SamplerWrap
..}

instance ToJSON Sampler where
  toJSON :: Sampler -> Value
toJSON = Sampler -> Value
forall a. (Generic a, GToJSON' Value Zero (Rep a)) => a -> Value
gToJSON

-- | Wrapping mode.
--
-- All valid values correspond to WebGL enums.
newtype SamplerWrap = SamplerWrap { SamplerWrap -> Int
unSamplerWrap :: Int }
  deriving (SamplerWrap -> SamplerWrap -> Bool
(SamplerWrap -> SamplerWrap -> Bool)
-> (SamplerWrap -> SamplerWrap -> Bool) -> Eq SamplerWrap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SamplerWrap -> SamplerWrap -> Bool
$c/= :: SamplerWrap -> SamplerWrap -> Bool
== :: SamplerWrap -> SamplerWrap -> Bool
$c== :: SamplerWrap -> SamplerWrap -> Bool
Eq, Eq SamplerWrap
Eq SamplerWrap
-> (SamplerWrap -> SamplerWrap -> Ordering)
-> (SamplerWrap -> SamplerWrap -> Bool)
-> (SamplerWrap -> SamplerWrap -> Bool)
-> (SamplerWrap -> SamplerWrap -> Bool)
-> (SamplerWrap -> SamplerWrap -> Bool)
-> (SamplerWrap -> SamplerWrap -> SamplerWrap)
-> (SamplerWrap -> SamplerWrap -> SamplerWrap)
-> Ord SamplerWrap
SamplerWrap -> SamplerWrap -> Bool
SamplerWrap -> SamplerWrap -> Ordering
SamplerWrap -> SamplerWrap -> SamplerWrap
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 :: SamplerWrap -> SamplerWrap -> SamplerWrap
$cmin :: SamplerWrap -> SamplerWrap -> SamplerWrap
max :: SamplerWrap -> SamplerWrap -> SamplerWrap
$cmax :: SamplerWrap -> SamplerWrap -> SamplerWrap
>= :: SamplerWrap -> SamplerWrap -> Bool
$c>= :: SamplerWrap -> SamplerWrap -> Bool
> :: SamplerWrap -> SamplerWrap -> Bool
$c> :: SamplerWrap -> SamplerWrap -> Bool
<= :: SamplerWrap -> SamplerWrap -> Bool
$c<= :: SamplerWrap -> SamplerWrap -> Bool
< :: SamplerWrap -> SamplerWrap -> Bool
$c< :: SamplerWrap -> SamplerWrap -> Bool
compare :: SamplerWrap -> SamplerWrap -> Ordering
$ccompare :: SamplerWrap -> SamplerWrap -> Ordering
$cp1Ord :: Eq SamplerWrap
Ord, Int -> SamplerWrap -> ShowS
[SamplerWrap] -> ShowS
SamplerWrap -> String
(Int -> SamplerWrap -> ShowS)
-> (SamplerWrap -> String)
-> ([SamplerWrap] -> ShowS)
-> Show SamplerWrap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SamplerWrap] -> ShowS
$cshowList :: [SamplerWrap] -> ShowS
show :: SamplerWrap -> String
$cshow :: SamplerWrap -> String
showsPrec :: Int -> SamplerWrap -> ShowS
$cshowsPrec :: Int -> SamplerWrap -> ShowS
Show, Value -> Parser [SamplerWrap]
Value -> Parser SamplerWrap
(Value -> Parser SamplerWrap)
-> (Value -> Parser [SamplerWrap]) -> FromJSON SamplerWrap
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [SamplerWrap]
$cparseJSONList :: Value -> Parser [SamplerWrap]
parseJSON :: Value -> Parser SamplerWrap
$cparseJSON :: Value -> Parser SamplerWrap
FromJSON, [SamplerWrap] -> Encoding
[SamplerWrap] -> Value
SamplerWrap -> Encoding
SamplerWrap -> Value
(SamplerWrap -> Value)
-> (SamplerWrap -> Encoding)
-> ([SamplerWrap] -> Value)
-> ([SamplerWrap] -> Encoding)
-> ToJSON SamplerWrap
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [SamplerWrap] -> Encoding
$ctoEncodingList :: [SamplerWrap] -> Encoding
toJSONList :: [SamplerWrap] -> Value
$ctoJSONList :: [SamplerWrap] -> Value
toEncoding :: SamplerWrap -> Encoding
$ctoEncoding :: SamplerWrap -> Encoding
toJSON :: SamplerWrap -> Value
$ctoJSON :: SamplerWrap -> Value
ToJSON, (forall x. SamplerWrap -> Rep SamplerWrap x)
-> (forall x. Rep SamplerWrap x -> SamplerWrap)
-> Generic SamplerWrap
forall x. Rep SamplerWrap x -> SamplerWrap
forall x. SamplerWrap -> Rep SamplerWrap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SamplerWrap x -> SamplerWrap
$cfrom :: forall x. SamplerWrap -> Rep SamplerWrap x
Generic)

pattern CLAMP_TO_EDGE :: SamplerWrap
pattern $bCLAMP_TO_EDGE :: SamplerWrap
$mCLAMP_TO_EDGE :: forall r. SamplerWrap -> (Void# -> r) -> (Void# -> r) -> r
CLAMP_TO_EDGE = SamplerWrap 33071

pattern MIRRORED_REPEAT :: SamplerWrap
pattern $bMIRRORED_REPEAT :: SamplerWrap
$mMIRRORED_REPEAT :: forall r. SamplerWrap -> (Void# -> r) -> (Void# -> r) -> r
MIRRORED_REPEAT = SamplerWrap 33648

pattern REPEAT :: SamplerWrap
pattern $bREPEAT :: SamplerWrap
$mREPEAT :: forall r. SamplerWrap -> (Void# -> r) -> (Void# -> r) -> r
REPEAT = SamplerWrap 10497

-- | Magnification filter.
--
-- Valid values correspond to WebGL enums.
newtype SamplerMagFilter = SamplerMagFilter { SamplerMagFilter -> Int
unSamplerMagFilter :: Int }
  deriving (SamplerMagFilter -> SamplerMagFilter -> Bool
(SamplerMagFilter -> SamplerMagFilter -> Bool)
-> (SamplerMagFilter -> SamplerMagFilter -> Bool)
-> Eq SamplerMagFilter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SamplerMagFilter -> SamplerMagFilter -> Bool
$c/= :: SamplerMagFilter -> SamplerMagFilter -> Bool
== :: SamplerMagFilter -> SamplerMagFilter -> Bool
$c== :: SamplerMagFilter -> SamplerMagFilter -> Bool
Eq, Eq SamplerMagFilter
Eq SamplerMagFilter
-> (SamplerMagFilter -> SamplerMagFilter -> Ordering)
-> (SamplerMagFilter -> SamplerMagFilter -> Bool)
-> (SamplerMagFilter -> SamplerMagFilter -> Bool)
-> (SamplerMagFilter -> SamplerMagFilter -> Bool)
-> (SamplerMagFilter -> SamplerMagFilter -> Bool)
-> (SamplerMagFilter -> SamplerMagFilter -> SamplerMagFilter)
-> (SamplerMagFilter -> SamplerMagFilter -> SamplerMagFilter)
-> Ord SamplerMagFilter
SamplerMagFilter -> SamplerMagFilter -> Bool
SamplerMagFilter -> SamplerMagFilter -> Ordering
SamplerMagFilter -> SamplerMagFilter -> SamplerMagFilter
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 :: SamplerMagFilter -> SamplerMagFilter -> SamplerMagFilter
$cmin :: SamplerMagFilter -> SamplerMagFilter -> SamplerMagFilter
max :: SamplerMagFilter -> SamplerMagFilter -> SamplerMagFilter
$cmax :: SamplerMagFilter -> SamplerMagFilter -> SamplerMagFilter
>= :: SamplerMagFilter -> SamplerMagFilter -> Bool
$c>= :: SamplerMagFilter -> SamplerMagFilter -> Bool
> :: SamplerMagFilter -> SamplerMagFilter -> Bool
$c> :: SamplerMagFilter -> SamplerMagFilter -> Bool
<= :: SamplerMagFilter -> SamplerMagFilter -> Bool
$c<= :: SamplerMagFilter -> SamplerMagFilter -> Bool
< :: SamplerMagFilter -> SamplerMagFilter -> Bool
$c< :: SamplerMagFilter -> SamplerMagFilter -> Bool
compare :: SamplerMagFilter -> SamplerMagFilter -> Ordering
$ccompare :: SamplerMagFilter -> SamplerMagFilter -> Ordering
$cp1Ord :: Eq SamplerMagFilter
Ord, Int -> SamplerMagFilter -> ShowS
[SamplerMagFilter] -> ShowS
SamplerMagFilter -> String
(Int -> SamplerMagFilter -> ShowS)
-> (SamplerMagFilter -> String)
-> ([SamplerMagFilter] -> ShowS)
-> Show SamplerMagFilter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SamplerMagFilter] -> ShowS
$cshowList :: [SamplerMagFilter] -> ShowS
show :: SamplerMagFilter -> String
$cshow :: SamplerMagFilter -> String
showsPrec :: Int -> SamplerMagFilter -> ShowS
$cshowsPrec :: Int -> SamplerMagFilter -> ShowS
Show, Value -> Parser [SamplerMagFilter]
Value -> Parser SamplerMagFilter
(Value -> Parser SamplerMagFilter)
-> (Value -> Parser [SamplerMagFilter])
-> FromJSON SamplerMagFilter
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [SamplerMagFilter]
$cparseJSONList :: Value -> Parser [SamplerMagFilter]
parseJSON :: Value -> Parser SamplerMagFilter
$cparseJSON :: Value -> Parser SamplerMagFilter
FromJSON, [SamplerMagFilter] -> Encoding
[SamplerMagFilter] -> Value
SamplerMagFilter -> Encoding
SamplerMagFilter -> Value
(SamplerMagFilter -> Value)
-> (SamplerMagFilter -> Encoding)
-> ([SamplerMagFilter] -> Value)
-> ([SamplerMagFilter] -> Encoding)
-> ToJSON SamplerMagFilter
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [SamplerMagFilter] -> Encoding
$ctoEncodingList :: [SamplerMagFilter] -> Encoding
toJSONList :: [SamplerMagFilter] -> Value
$ctoJSONList :: [SamplerMagFilter] -> Value
toEncoding :: SamplerMagFilter -> Encoding
$ctoEncoding :: SamplerMagFilter -> Encoding
toJSON :: SamplerMagFilter -> Value
$ctoJSON :: SamplerMagFilter -> Value
ToJSON, (forall x. SamplerMagFilter -> Rep SamplerMagFilter x)
-> (forall x. Rep SamplerMagFilter x -> SamplerMagFilter)
-> Generic SamplerMagFilter
forall x. Rep SamplerMagFilter x -> SamplerMagFilter
forall x. SamplerMagFilter -> Rep SamplerMagFilter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SamplerMagFilter x -> SamplerMagFilter
$cfrom :: forall x. SamplerMagFilter -> Rep SamplerMagFilter x
Generic)

pattern MAG_NEAREST :: SamplerMagFilter
pattern $bMAG_NEAREST :: SamplerMagFilter
$mMAG_NEAREST :: forall r. SamplerMagFilter -> (Void# -> r) -> (Void# -> r) -> r
MAG_NEAREST = SamplerMagFilter 9728

pattern MAG_LINEAR :: SamplerMagFilter
pattern $bMAG_LINEAR :: SamplerMagFilter
$mMAG_LINEAR :: forall r. SamplerMagFilter -> (Void# -> r) -> (Void# -> r) -> r
MAG_LINEAR = SamplerMagFilter 9729

-- | Minification filter.
--
-- All valid values correspond to WebGL enums.
newtype SamplerMinFilter = SamplerMinFilter { SamplerMinFilter -> Int
unSamplerMinFilter :: Int }
  deriving (SamplerMinFilter -> SamplerMinFilter -> Bool
(SamplerMinFilter -> SamplerMinFilter -> Bool)
-> (SamplerMinFilter -> SamplerMinFilter -> Bool)
-> Eq SamplerMinFilter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SamplerMinFilter -> SamplerMinFilter -> Bool
$c/= :: SamplerMinFilter -> SamplerMinFilter -> Bool
== :: SamplerMinFilter -> SamplerMinFilter -> Bool
$c== :: SamplerMinFilter -> SamplerMinFilter -> Bool
Eq, Eq SamplerMinFilter
Eq SamplerMinFilter
-> (SamplerMinFilter -> SamplerMinFilter -> Ordering)
-> (SamplerMinFilter -> SamplerMinFilter -> Bool)
-> (SamplerMinFilter -> SamplerMinFilter -> Bool)
-> (SamplerMinFilter -> SamplerMinFilter -> Bool)
-> (SamplerMinFilter -> SamplerMinFilter -> Bool)
-> (SamplerMinFilter -> SamplerMinFilter -> SamplerMinFilter)
-> (SamplerMinFilter -> SamplerMinFilter -> SamplerMinFilter)
-> Ord SamplerMinFilter
SamplerMinFilter -> SamplerMinFilter -> Bool
SamplerMinFilter -> SamplerMinFilter -> Ordering
SamplerMinFilter -> SamplerMinFilter -> SamplerMinFilter
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 :: SamplerMinFilter -> SamplerMinFilter -> SamplerMinFilter
$cmin :: SamplerMinFilter -> SamplerMinFilter -> SamplerMinFilter
max :: SamplerMinFilter -> SamplerMinFilter -> SamplerMinFilter
$cmax :: SamplerMinFilter -> SamplerMinFilter -> SamplerMinFilter
>= :: SamplerMinFilter -> SamplerMinFilter -> Bool
$c>= :: SamplerMinFilter -> SamplerMinFilter -> Bool
> :: SamplerMinFilter -> SamplerMinFilter -> Bool
$c> :: SamplerMinFilter -> SamplerMinFilter -> Bool
<= :: SamplerMinFilter -> SamplerMinFilter -> Bool
$c<= :: SamplerMinFilter -> SamplerMinFilter -> Bool
< :: SamplerMinFilter -> SamplerMinFilter -> Bool
$c< :: SamplerMinFilter -> SamplerMinFilter -> Bool
compare :: SamplerMinFilter -> SamplerMinFilter -> Ordering
$ccompare :: SamplerMinFilter -> SamplerMinFilter -> Ordering
$cp1Ord :: Eq SamplerMinFilter
Ord, Int -> SamplerMinFilter -> ShowS
[SamplerMinFilter] -> ShowS
SamplerMinFilter -> String
(Int -> SamplerMinFilter -> ShowS)
-> (SamplerMinFilter -> String)
-> ([SamplerMinFilter] -> ShowS)
-> Show SamplerMinFilter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SamplerMinFilter] -> ShowS
$cshowList :: [SamplerMinFilter] -> ShowS
show :: SamplerMinFilter -> String
$cshow :: SamplerMinFilter -> String
showsPrec :: Int -> SamplerMinFilter -> ShowS
$cshowsPrec :: Int -> SamplerMinFilter -> ShowS
Show, Value -> Parser [SamplerMinFilter]
Value -> Parser SamplerMinFilter
(Value -> Parser SamplerMinFilter)
-> (Value -> Parser [SamplerMinFilter])
-> FromJSON SamplerMinFilter
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [SamplerMinFilter]
$cparseJSONList :: Value -> Parser [SamplerMinFilter]
parseJSON :: Value -> Parser SamplerMinFilter
$cparseJSON :: Value -> Parser SamplerMinFilter
FromJSON, [SamplerMinFilter] -> Encoding
[SamplerMinFilter] -> Value
SamplerMinFilter -> Encoding
SamplerMinFilter -> Value
(SamplerMinFilter -> Value)
-> (SamplerMinFilter -> Encoding)
-> ([SamplerMinFilter] -> Value)
-> ([SamplerMinFilter] -> Encoding)
-> ToJSON SamplerMinFilter
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [SamplerMinFilter] -> Encoding
$ctoEncodingList :: [SamplerMinFilter] -> Encoding
toJSONList :: [SamplerMinFilter] -> Value
$ctoJSONList :: [SamplerMinFilter] -> Value
toEncoding :: SamplerMinFilter -> Encoding
$ctoEncoding :: SamplerMinFilter -> Encoding
toJSON :: SamplerMinFilter -> Value
$ctoJSON :: SamplerMinFilter -> Value
ToJSON, (forall x. SamplerMinFilter -> Rep SamplerMinFilter x)
-> (forall x. Rep SamplerMinFilter x -> SamplerMinFilter)
-> Generic SamplerMinFilter
forall x. Rep SamplerMinFilter x -> SamplerMinFilter
forall x. SamplerMinFilter -> Rep SamplerMinFilter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SamplerMinFilter x -> SamplerMinFilter
$cfrom :: forall x. SamplerMinFilter -> Rep SamplerMinFilter x
Generic)

pattern MIN_NEAREST :: SamplerMinFilter
pattern $bMIN_NEAREST :: SamplerMinFilter
$mMIN_NEAREST :: forall r. SamplerMinFilter -> (Void# -> r) -> (Void# -> r) -> r
MIN_NEAREST = SamplerMinFilter 9728

pattern MIN_LINEAR :: SamplerMinFilter
pattern $bMIN_LINEAR :: SamplerMinFilter
$mMIN_LINEAR :: forall r. SamplerMinFilter -> (Void# -> r) -> (Void# -> r) -> r
MIN_LINEAR = SamplerMinFilter 9729

pattern MIN_NEAREST_MIPMAP_NEAREST :: SamplerMinFilter
pattern $bMIN_NEAREST_MIPMAP_NEAREST :: SamplerMinFilter
$mMIN_NEAREST_MIPMAP_NEAREST :: forall r. SamplerMinFilter -> (Void# -> r) -> (Void# -> r) -> r
MIN_NEAREST_MIPMAP_NEAREST = SamplerMinFilter 9984

pattern MIN_LINEAR_MIPMAP_NEAREST :: SamplerMinFilter
pattern $bMIN_LINEAR_MIPMAP_NEAREST :: SamplerMinFilter
$mMIN_LINEAR_MIPMAP_NEAREST :: forall r. SamplerMinFilter -> (Void# -> r) -> (Void# -> r) -> r
MIN_LINEAR_MIPMAP_NEAREST = SamplerMinFilter 9985

pattern MIN_NEAREST_MIPMAP_LINEAR :: SamplerMinFilter
pattern $bMIN_NEAREST_MIPMAP_LINEAR :: SamplerMinFilter
$mMIN_NEAREST_MIPMAP_LINEAR :: forall r. SamplerMinFilter -> (Void# -> r) -> (Void# -> r) -> r
MIN_NEAREST_MIPMAP_LINEAR = SamplerMinFilter 9986

pattern MIN_LINEAR_MIPMAP_LINEAR :: SamplerMinFilter
pattern $bMIN_LINEAR_MIPMAP_LINEAR :: SamplerMinFilter
$mMIN_LINEAR_MIPMAP_LINEAR :: forall r. SamplerMinFilter -> (Void# -> r) -> (Void# -> r) -> r
MIN_LINEAR_MIPMAP_LINEAR = SamplerMinFilter 9987