module Codec.GlTF.PbrMetallicRoughness
  ( PbrMetallicRoughness(..)
  ) where

import Codec.GlTF.Prelude

import Codec.GlTF.TextureInfo (TextureInfo_)

-- | A set of parameter values that are used to define the metallic-roughness
-- material model from Physically-Based Rendering (PBR) methodology.
data PbrMetallicRoughness = PbrMetallicRoughness
  { PbrMetallicRoughness -> (Float, Float, Float, Float)
baseColorFactor          :: (Float, Float, Float, Float)
  , PbrMetallicRoughness -> Float
metallicFactor           :: Float
  , PbrMetallicRoughness -> Float
roughnessFactor          :: Float
  , PbrMetallicRoughness -> Maybe TextureInfo_
metallicRoughnessTexture :: Maybe TextureInfo_
  , PbrMetallicRoughness -> Maybe TextureInfo_
baseColorTexture         :: Maybe TextureInfo_
  , PbrMetallicRoughness -> Maybe Object
extensions               :: Maybe Object
  , PbrMetallicRoughness -> Maybe Value
extras                   :: Maybe Value
  } deriving (PbrMetallicRoughness -> PbrMetallicRoughness -> Bool
(PbrMetallicRoughness -> PbrMetallicRoughness -> Bool)
-> (PbrMetallicRoughness -> PbrMetallicRoughness -> Bool)
-> Eq PbrMetallicRoughness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PbrMetallicRoughness -> PbrMetallicRoughness -> Bool
$c/= :: PbrMetallicRoughness -> PbrMetallicRoughness -> Bool
== :: PbrMetallicRoughness -> PbrMetallicRoughness -> Bool
$c== :: PbrMetallicRoughness -> PbrMetallicRoughness -> Bool
Eq, Int -> PbrMetallicRoughness -> ShowS
[PbrMetallicRoughness] -> ShowS
PbrMetallicRoughness -> String
(Int -> PbrMetallicRoughness -> ShowS)
-> (PbrMetallicRoughness -> String)
-> ([PbrMetallicRoughness] -> ShowS)
-> Show PbrMetallicRoughness
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PbrMetallicRoughness] -> ShowS
$cshowList :: [PbrMetallicRoughness] -> ShowS
show :: PbrMetallicRoughness -> String
$cshow :: PbrMetallicRoughness -> String
showsPrec :: Int -> PbrMetallicRoughness -> ShowS
$cshowsPrec :: Int -> PbrMetallicRoughness -> ShowS
Show, (forall x. PbrMetallicRoughness -> Rep PbrMetallicRoughness x)
-> (forall x. Rep PbrMetallicRoughness x -> PbrMetallicRoughness)
-> Generic PbrMetallicRoughness
forall x. Rep PbrMetallicRoughness x -> PbrMetallicRoughness
forall x. PbrMetallicRoughness -> Rep PbrMetallicRoughness x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PbrMetallicRoughness x -> PbrMetallicRoughness
$cfrom :: forall x. PbrMetallicRoughness -> Rep PbrMetallicRoughness x
Generic)

instance FromJSON PbrMetallicRoughness where
  parseJSON :: Value -> Parser PbrMetallicRoughness
parseJSON = String
-> (Object -> Parser PbrMetallicRoughness)
-> Value
-> Parser PbrMetallicRoughness
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PbrMetallicRoughness" \Object
o -> do
    (Float, Float, Float, Float)
baseColorFactor          <- Object
o Object -> Key -> Parser (Maybe (Float, Float, Float, Float))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"baseColorFactor" Parser (Maybe (Float, Float, Float, Float))
-> (Float, Float, Float, Float)
-> Parser (Float, Float, Float, Float)
forall a. Parser (Maybe a) -> a -> Parser a
.!= (Float
1.0, Float
1.0, Float
1.0, Float
1.0)
    Float
metallicFactor           <- Object
o Object -> Key -> Parser (Maybe Float)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"metallicFactor"  Parser (Maybe Float) -> Float -> Parser Float
forall a. Parser (Maybe a) -> a -> Parser a
.!= Float
1.0
    Float
roughnessFactor          <- Object
o Object -> Key -> Parser (Maybe Float)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"roughnessFactor" Parser (Maybe Float) -> Float -> Parser Float
forall a. Parser (Maybe a) -> a -> Parser a
.!= Float
1.0

    Maybe TextureInfo_
metallicRoughnessTexture <- Object
o Object -> Key -> Parser (Maybe TextureInfo_)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"metallicRoughnessTexture"
    Maybe TextureInfo_
baseColorTexture         <- Object
o Object -> Key -> Parser (Maybe TextureInfo_)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"baseColorTexture"

    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 PbrMetallicRoughness :: (Float, Float, Float, Float)
-> Float
-> Float
-> Maybe TextureInfo_
-> Maybe TextureInfo_
-> Maybe Object
-> Maybe Value
-> PbrMetallicRoughness
PbrMetallicRoughness{Float
Maybe Value
Maybe Object
Maybe TextureInfo_
(Float, Float, Float, Float)
extras :: Maybe Value
extensions :: Maybe Object
baseColorTexture :: Maybe TextureInfo_
metallicRoughnessTexture :: Maybe TextureInfo_
roughnessFactor :: Float
metallicFactor :: Float
baseColorFactor :: (Float, Float, Float, Float)
$sel:extras:PbrMetallicRoughness :: Maybe Value
$sel:extensions:PbrMetallicRoughness :: Maybe Object
$sel:baseColorTexture:PbrMetallicRoughness :: Maybe TextureInfo_
$sel:metallicRoughnessTexture:PbrMetallicRoughness :: Maybe TextureInfo_
$sel:roughnessFactor:PbrMetallicRoughness :: Float
$sel:metallicFactor:PbrMetallicRoughness :: Float
$sel:baseColorFactor:PbrMetallicRoughness :: (Float, Float, Float, Float)
..}

instance ToJSON PbrMetallicRoughness