module Text.GLTF.Loader.Gltf
  ( -- * Data constructors
    Gltf(..),
    Asset(..),
    Image(..),
    MagFilter(..),
    MinFilter(..),
    Material(..),
    MaterialAlphaMode(..),
    Mesh(..),
    Node(..),
    MeshPrimitive(..),
    PbrMetallicRoughness(..),
    MeshPrimitiveMode(..),
    Sampler(..),
    SamplerWrap(..),
    Texture(..),
    TextureInfo(..),
    -- * Lenses
    -- ** Top-level Gltf Lenses
    _asset,
    _images,
    _materials,
    _meshes,
    _nodes,
    _samplers,
    _textures,
    -- ** Asset Lenses
    _assetVersion,
    _assetCopyright,
    _assetGenerator,
    _assetMinVersion,
    -- ** Image Lenses
    _imageData,
    _imageMimeType,
    _imageName,
    -- ** Material Lenses
    _materialAlphaCutoff,
    _materialAlphaMode,
    _materialDoubleSided,
    _materialEmissiveFactor,
    _materialName,
    _materialPbrMetallicRoughness,
    -- ** Mesh Lenses
    _meshPrimitives,
    _meshWeights,
    _meshName,
    -- ** Node Lenses
    _nodeChildren,
    _nodeMeshId,
    _nodeName,
    _nodeRotation,
    _nodeScale,
    _nodeTranslation,
    _nodeWeights,
    -- ** Sampler Lenses
    _samplerMagFilter,
    _samplerMinFilter,
    _samplerName,
    _samplerWrapS,
    _samplerWrapT,
    -- ** Texture Lenses
    _textureName,
    _textureSamplerId,
    _textureSourceId,
    -- ** MeshPrimitive Lenses
    _meshPrimitiveMaterial,
    _meshPrimitiveIndices,
    _meshPrimitiveMode,
    _meshPrimitiveNormals,
    _meshPrimitivePositions,
    -- ** PbrMetallicRoughness Lenses
    _pbrBaseColorFactor,
    _pbrBaseColorTexture,
    _pbrMetallicFactor,
    _pbrRoughnessFactor,
    -- ** TextureInfo Lenses
    _textureInfoId,
    _textureInfoTexCoord
  ) where

import Linear
import RIO

-- | The root data type for a glTF asset
data Gltf = Gltf
  { Gltf -> Asset
gltfAsset :: Asset,
    Gltf -> Vector Image
gltfImages :: Vector Image,
    Gltf -> Vector Material
gltfMaterials :: Vector Material,
    Gltf -> Vector Mesh
gltfMeshes :: Vector Mesh,
    Gltf -> Vector Node
gltfNodes :: Vector Node,
    Gltf -> Vector Sampler
gltfSamplers :: Vector Sampler,
    Gltf -> Vector Texture
gltfTextures :: Vector Texture
  } deriving (Gltf -> Gltf -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Gltf -> Gltf -> Bool
$c/= :: Gltf -> Gltf -> Bool
== :: Gltf -> Gltf -> Bool
$c== :: Gltf -> Gltf -> Bool
Eq, Int -> Gltf -> ShowS
[Gltf] -> ShowS
Gltf -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Gltf] -> ShowS
$cshowList :: [Gltf] -> ShowS
show :: Gltf -> String
$cshow :: Gltf -> String
showsPrec :: Int -> Gltf -> ShowS
$cshowsPrec :: Int -> Gltf -> ShowS
Show)

-- | Metadata about the glTF asset
data Asset = Asset
  { -- | The glTF version that this asset targets.
    Asset -> Text
assetVersion :: Text,
    -- | A copyright message suitable for display to credit the content creator.
    Asset -> Maybe Text
assetCopyright :: Maybe Text,
    -- | Tool that generated this glTF model.
    Asset -> Maybe Text
assetGenerator :: Maybe Text,
    -- | The minimum glTF version that this asset targets
    Asset -> Maybe Text
assetMinVersion :: Maybe Text
  } deriving (Asset -> Asset -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Asset -> Asset -> Bool
$c/= :: Asset -> Asset -> Bool
== :: Asset -> Asset -> Bool
$c== :: Asset -> Asset -> Bool
Eq, Int -> Asset -> ShowS
[Asset] -> ShowS
Asset -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Asset] -> ShowS
$cshowList :: [Asset] -> ShowS
show :: Asset -> String
$cshow :: Asset -> String
showsPrec :: Int -> Asset -> ShowS
$cshowsPrec :: Int -> Asset -> ShowS
Show)

-- | Image data used to create a texture.
data Image = Image
  { -- | The binary data of the image
    Image -> Maybe ByteString
imageData :: Maybe ByteString,
    -- | The image’s media type.
    Image -> Text
imageMimeType :: Text,
    -- | The user-defined name of this object.
    Image -> Maybe Text
imageName :: Maybe Text
  } deriving (Image -> Image -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Image -> Image -> Bool
$c/= :: Image -> Image -> Bool
== :: Image -> Image -> Bool
$c== :: Image -> Image -> Bool
Eq, Int -> Image -> ShowS
[Image] -> ShowS
Image -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Image] -> ShowS
$cshowList :: [Image] -> ShowS
show :: Image -> String
$cshow :: Image -> String
showsPrec :: Int -> Image -> ShowS
$cshowsPrec :: Int -> Image -> ShowS
Show)

-- | The material appearance of a primitive
data Material = Material
  { -- | Specifies the cutoff threshold when in MASK alpha mode.
    Material -> Float
materialAlphaCutoff :: Float,
    -- | The material’s alpha rendering mode enumeration specifying the interpretation of
    --   the alpha value of the base color.
    Material -> MaterialAlphaMode
materialAlphaMode :: MaterialAlphaMode,
    -- | Specifies whether the material is double sided.
    Material -> Bool
materialDoubleSided :: Bool,
    -- | The factors for the emissive color of the material.
    Material -> V3 Float
materialEmissiveFactor :: V3 Float,
    -- | The user-defined name of this object.
    Material -> Maybe Text
materialName :: Maybe Text,
    -- | Metallic roughness Physically Based Rendering (PBR) methodology parameter values.
    Material -> Maybe PbrMetallicRoughness
materialPbrMetallicRoughness :: Maybe PbrMetallicRoughness
  } deriving (Material -> Material -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Material -> Material -> Bool
$c/= :: Material -> Material -> Bool
== :: Material -> Material -> Bool
$c== :: Material -> Material -> Bool
Eq, Int -> Material -> ShowS
[Material] -> ShowS
Material -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Material] -> ShowS
$cshowList :: [Material] -> ShowS
show :: Material -> String
$cshow :: Material -> String
showsPrec :: Int -> Material -> ShowS
$cshowsPrec :: Int -> Material -> ShowS
Show)

-- | A set of primitives to be rendered
data Mesh = Mesh
  { -- | The user-defined name of this object.
    Mesh -> Maybe Text
meshName :: Maybe Text,
    -- | A Vector of primitives, each defining geometry to be rendered.
    Mesh -> Vector MeshPrimitive
meshPrimitives :: Vector MeshPrimitive,
    -- | A Vector of weights to be applied to the morph targets.
    Mesh -> Vector Float
meshWeights :: Vector Float
  } deriving (Mesh -> Mesh -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mesh -> Mesh -> Bool
$c/= :: Mesh -> Mesh -> Bool
== :: Mesh -> Mesh -> Bool
$c== :: Mesh -> Mesh -> Bool
Eq, Int -> Mesh -> ShowS
[Mesh] -> ShowS
Mesh -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mesh] -> ShowS
$cshowList :: [Mesh] -> ShowS
show :: Mesh -> String
$cshow :: Mesh -> String
showsPrec :: Int -> Mesh -> ShowS
$cshowsPrec :: Int -> Mesh -> ShowS
Show)

-- | A node in the node hierarchy
data Node = Node
  { -- | The indices of this Node's children
    Node -> Vector Int
nodeChildren :: Vector Int,
    -- | The index of the mesh in this node.
    Node -> Maybe Int
nodeMeshId :: Maybe Int,
    -- | The user-defined name of this object.
    Node -> Maybe Text
nodeName :: Maybe Text,
    -- | The node's unit quaternion rotation.
    Node -> Maybe (V4 Float)
nodeRotation :: Maybe (V4 Float),
    -- | The node's non-uniform scale
    Node -> Maybe (V3 Float)
nodeScale :: Maybe (V3 Float),
    -- | The node's translation along the x, y, and z axes.
    Node -> Maybe (V3 Float)
nodeTranslation :: Maybe (V3 Float),
    -- | The weights of the instantiated morph target.
    Node -> [Float]
nodeWeights :: [Float]
  } deriving (Node -> Node -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Node -> Node -> Bool
$c/= :: Node -> Node -> Bool
== :: Node -> Node -> Bool
$c== :: Node -> Node -> Bool
Eq, Int -> Node -> ShowS
[Node] -> ShowS
Node -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Node] -> ShowS
$cshowList :: [Node] -> ShowS
show :: Node -> String
$cshow :: Node -> String
showsPrec :: Int -> Node -> ShowS
$cshowsPrec :: Int -> Node -> ShowS
Show)

-- | Texture sampler properties for filtering and wrapping modes.
data Sampler = Sampler
  { -- | Magnification filter.
    Sampler -> Maybe MagFilter
samplerMagFilter :: Maybe MagFilter,
    -- | Minification filter.
    Sampler -> Maybe MinFilter
samplerMinFilter :: Maybe MinFilter,
    -- | The user-defined name of this object.
    Sampler -> Maybe Text
samplerName :: Maybe Text,
    -- | S (U) wrapping mode. All valid values correspond to WebGL enums.
    Sampler -> SamplerWrap
samplerWrapS :: SamplerWrap,
    -- | T (V) wrapping mode. All valid values correspond to WebGL enums.
    Sampler -> SamplerWrap
samplerWrapT :: SamplerWrap
  } deriving (Sampler -> Sampler -> Bool
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
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)

-- | A texture and its sampler.
data Texture = Texture
  { -- | The user-defined name of this object.
    Texture -> Maybe Text
textureName :: Maybe Text,
    -- | The index of the sampler used by this texture.
    Texture -> Maybe Int
textureSamplerId :: Maybe Int,
    -- | The index of the image used by this texture.
    Texture -> Maybe Int
textureSourceId :: Maybe Int
  } deriving (Texture -> Texture -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Texture -> Texture -> Bool
$c/= :: Texture -> Texture -> Bool
== :: Texture -> Texture -> Bool
$c== :: Texture -> Texture -> Bool
Eq, Int -> Texture -> ShowS
[Texture] -> ShowS
Texture -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Texture] -> ShowS
$cshowList :: [Texture] -> ShowS
show :: Texture -> String
$cshow :: Texture -> String
showsPrec :: Int -> Texture -> ShowS
$cshowsPrec :: Int -> Texture -> ShowS
Show)

-- | Geometry to be rendered with the given material
data MeshPrimitive = MeshPrimitive
  { -- | A Vector of vertex indices.
    MeshPrimitive -> Vector Word16
meshPrimitiveIndices :: Vector Word16,
    -- | The index of the material to apply to this primitive when rendering.
    MeshPrimitive -> Maybe Int
meshPrimitiveMaterial :: Maybe Int,
    -- | The topology type of primitives to render.
    MeshPrimitive -> MeshPrimitiveMode
meshPrimitiveMode :: MeshPrimitiveMode,
    -- | A Vector of vertex normals.
    MeshPrimitive -> Vector (V3 Float)
meshPrimitiveNormals :: Vector (V3 Float),
    -- | A Vector of vertex positions.
    MeshPrimitive -> Vector (V3 Float)
meshPrimitivePositions :: Vector (V3 Float),
    -- | A Vector of vertex texture coordinates
    MeshPrimitive -> Vector (V2 Float)
meshPrimitiveTexCoords :: Vector (V2 Float)
  } deriving (MeshPrimitive -> MeshPrimitive -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MeshPrimitive -> MeshPrimitive -> Bool
$c/= :: MeshPrimitive -> MeshPrimitive -> Bool
== :: MeshPrimitive -> MeshPrimitive -> Bool
$c== :: MeshPrimitive -> MeshPrimitive -> Bool
Eq, Int -> MeshPrimitive -> ShowS
[MeshPrimitive] -> ShowS
MeshPrimitive -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MeshPrimitive] -> ShowS
$cshowList :: [MeshPrimitive] -> ShowS
show :: MeshPrimitive -> String
$cshow :: MeshPrimitive -> String
showsPrec :: Int -> MeshPrimitive -> ShowS
$cshowsPrec :: Int -> MeshPrimitive -> ShowS
Show)

-- | Alpha rendering mode of a material
data MaterialAlphaMode
  -- | The alpha value is used to composite the source and destination areas.
  = Blend
  -- | The rendered output is either fully opaque or fully transparent depending on the
  -- alpha value and the specified alphaCutoff value.
  | Mask
  -- |The alpha value is ignored, and the rendered output is fully opaque.
  | Opaque
  deriving (MaterialAlphaMode -> MaterialAlphaMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MaterialAlphaMode -> MaterialAlphaMode -> Bool
$c/= :: MaterialAlphaMode -> MaterialAlphaMode -> Bool
== :: MaterialAlphaMode -> MaterialAlphaMode -> Bool
$c== :: MaterialAlphaMode -> MaterialAlphaMode -> Bool
Eq, Int -> MaterialAlphaMode
MaterialAlphaMode -> Int
MaterialAlphaMode -> [MaterialAlphaMode]
MaterialAlphaMode -> MaterialAlphaMode
MaterialAlphaMode -> MaterialAlphaMode -> [MaterialAlphaMode]
MaterialAlphaMode
-> MaterialAlphaMode -> MaterialAlphaMode -> [MaterialAlphaMode]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MaterialAlphaMode
-> MaterialAlphaMode -> MaterialAlphaMode -> [MaterialAlphaMode]
$cenumFromThenTo :: MaterialAlphaMode
-> MaterialAlphaMode -> MaterialAlphaMode -> [MaterialAlphaMode]
enumFromTo :: MaterialAlphaMode -> MaterialAlphaMode -> [MaterialAlphaMode]
$cenumFromTo :: MaterialAlphaMode -> MaterialAlphaMode -> [MaterialAlphaMode]
enumFromThen :: MaterialAlphaMode -> MaterialAlphaMode -> [MaterialAlphaMode]
$cenumFromThen :: MaterialAlphaMode -> MaterialAlphaMode -> [MaterialAlphaMode]
enumFrom :: MaterialAlphaMode -> [MaterialAlphaMode]
$cenumFrom :: MaterialAlphaMode -> [MaterialAlphaMode]
fromEnum :: MaterialAlphaMode -> Int
$cfromEnum :: MaterialAlphaMode -> Int
toEnum :: Int -> MaterialAlphaMode
$ctoEnum :: Int -> MaterialAlphaMode
pred :: MaterialAlphaMode -> MaterialAlphaMode
$cpred :: MaterialAlphaMode -> MaterialAlphaMode
succ :: MaterialAlphaMode -> MaterialAlphaMode
$csucc :: MaterialAlphaMode -> MaterialAlphaMode
Enum, Int -> MaterialAlphaMode -> ShowS
[MaterialAlphaMode] -> ShowS
MaterialAlphaMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MaterialAlphaMode] -> ShowS
$cshowList :: [MaterialAlphaMode] -> ShowS
show :: MaterialAlphaMode -> String
$cshow :: MaterialAlphaMode -> String
showsPrec :: Int -> MaterialAlphaMode -> ShowS
$cshowsPrec :: Int -> MaterialAlphaMode -> ShowS
Show)

-- | A set of parameter values that are used to define the metallic-roughness material
-- model from Physically-Based Rendering (PBR) methodology.
data PbrMetallicRoughness = PbrMetallicRoughness
  { -- | The factors for the base color of the material.
    PbrMetallicRoughness -> V4 Float
pbrBaseColorFactor :: V4 Float,
    -- | The base color texture
    PbrMetallicRoughness -> Maybe TextureInfo
pbrBaseColorTexture :: Maybe TextureInfo,
    -- | The factor for the metalness of the material.
    PbrMetallicRoughness -> Float
pbrMetallicFactor :: Float,
    -- | The factor for the roughness of the material.
    PbrMetallicRoughness -> Float
pbrRoughnessFactor :: Float
  } deriving (PbrMetallicRoughness -> PbrMetallicRoughness -> Bool
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
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)

-- | Magnification filter.
data MagFilter = MagLinear | MagNearest
  deriving (Int -> MagFilter
MagFilter -> Int
MagFilter -> [MagFilter]
MagFilter -> MagFilter
MagFilter -> MagFilter -> [MagFilter]
MagFilter -> MagFilter -> MagFilter -> [MagFilter]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MagFilter -> MagFilter -> MagFilter -> [MagFilter]
$cenumFromThenTo :: MagFilter -> MagFilter -> MagFilter -> [MagFilter]
enumFromTo :: MagFilter -> MagFilter -> [MagFilter]
$cenumFromTo :: MagFilter -> MagFilter -> [MagFilter]
enumFromThen :: MagFilter -> MagFilter -> [MagFilter]
$cenumFromThen :: MagFilter -> MagFilter -> [MagFilter]
enumFrom :: MagFilter -> [MagFilter]
$cenumFrom :: MagFilter -> [MagFilter]
fromEnum :: MagFilter -> Int
$cfromEnum :: MagFilter -> Int
toEnum :: Int -> MagFilter
$ctoEnum :: Int -> MagFilter
pred :: MagFilter -> MagFilter
$cpred :: MagFilter -> MagFilter
succ :: MagFilter -> MagFilter
$csucc :: MagFilter -> MagFilter
Enum, MagFilter -> MagFilter -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MagFilter -> MagFilter -> Bool
$c/= :: MagFilter -> MagFilter -> Bool
== :: MagFilter -> MagFilter -> Bool
$c== :: MagFilter -> MagFilter -> Bool
Eq, Int -> MagFilter -> ShowS
[MagFilter] -> ShowS
MagFilter -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MagFilter] -> ShowS
$cshowList :: [MagFilter] -> ShowS
show :: MagFilter -> String
$cshow :: MagFilter -> String
showsPrec :: Int -> MagFilter -> ShowS
$cshowsPrec :: Int -> MagFilter -> ShowS
Show)

-- | Minification Filter.
data MinFilter
  = MinNearest
  | MinLinear
  | MinNearestMipmapNearest
  | MinLinearMipmapNearest
  | MinNearestMipmapLinear
  | MinLinearMipmapLinear
  deriving (Int -> MinFilter
MinFilter -> Int
MinFilter -> [MinFilter]
MinFilter -> MinFilter
MinFilter -> MinFilter -> [MinFilter]
MinFilter -> MinFilter -> MinFilter -> [MinFilter]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MinFilter -> MinFilter -> MinFilter -> [MinFilter]
$cenumFromThenTo :: MinFilter -> MinFilter -> MinFilter -> [MinFilter]
enumFromTo :: MinFilter -> MinFilter -> [MinFilter]
$cenumFromTo :: MinFilter -> MinFilter -> [MinFilter]
enumFromThen :: MinFilter -> MinFilter -> [MinFilter]
$cenumFromThen :: MinFilter -> MinFilter -> [MinFilter]
enumFrom :: MinFilter -> [MinFilter]
$cenumFrom :: MinFilter -> [MinFilter]
fromEnum :: MinFilter -> Int
$cfromEnum :: MinFilter -> Int
toEnum :: Int -> MinFilter
$ctoEnum :: Int -> MinFilter
pred :: MinFilter -> MinFilter
$cpred :: MinFilter -> MinFilter
succ :: MinFilter -> MinFilter
$csucc :: MinFilter -> MinFilter
Enum, MinFilter -> MinFilter -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MinFilter -> MinFilter -> Bool
$c/= :: MinFilter -> MinFilter -> Bool
== :: MinFilter -> MinFilter -> Bool
$c== :: MinFilter -> MinFilter -> Bool
Eq, Int -> MinFilter -> ShowS
[MinFilter] -> ShowS
MinFilter -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MinFilter] -> ShowS
$cshowList :: [MinFilter] -> ShowS
show :: MinFilter -> String
$cshow :: MinFilter -> String
showsPrec :: Int -> MinFilter -> ShowS
$cshowsPrec :: Int -> MinFilter -> ShowS
Show)

-- | Sampler wrapping mode.  
data SamplerWrap
  = ClampToEdge
  | MirroredRepeat
  | Repeat
  deriving (Int -> SamplerWrap
SamplerWrap -> Int
SamplerWrap -> [SamplerWrap]
SamplerWrap -> SamplerWrap
SamplerWrap -> SamplerWrap -> [SamplerWrap]
SamplerWrap -> SamplerWrap -> SamplerWrap -> [SamplerWrap]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SamplerWrap -> SamplerWrap -> SamplerWrap -> [SamplerWrap]
$cenumFromThenTo :: SamplerWrap -> SamplerWrap -> SamplerWrap -> [SamplerWrap]
enumFromTo :: SamplerWrap -> SamplerWrap -> [SamplerWrap]
$cenumFromTo :: SamplerWrap -> SamplerWrap -> [SamplerWrap]
enumFromThen :: SamplerWrap -> SamplerWrap -> [SamplerWrap]
$cenumFromThen :: SamplerWrap -> SamplerWrap -> [SamplerWrap]
enumFrom :: SamplerWrap -> [SamplerWrap]
$cenumFrom :: SamplerWrap -> [SamplerWrap]
fromEnum :: SamplerWrap -> Int
$cfromEnum :: SamplerWrap -> Int
toEnum :: Int -> SamplerWrap
$ctoEnum :: Int -> SamplerWrap
pred :: SamplerWrap -> SamplerWrap
$cpred :: SamplerWrap -> SamplerWrap
succ :: SamplerWrap -> SamplerWrap
$csucc :: SamplerWrap -> SamplerWrap
Enum, SamplerWrap -> SamplerWrap -> Bool
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, Int -> SamplerWrap -> ShowS
[SamplerWrap] -> ShowS
SamplerWrap -> String
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)

-- | The topology type of primitives to render.
data MeshPrimitiveMode
  = Points
  | Lines
  | LineLoop
  | LineStrip
  | Triangles
  | TriangleStrip
  | TriangleFan
  deriving (MeshPrimitiveMode -> MeshPrimitiveMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MeshPrimitiveMode -> MeshPrimitiveMode -> Bool
$c/= :: MeshPrimitiveMode -> MeshPrimitiveMode -> Bool
== :: MeshPrimitiveMode -> MeshPrimitiveMode -> Bool
$c== :: MeshPrimitiveMode -> MeshPrimitiveMode -> Bool
Eq, Int -> MeshPrimitiveMode
MeshPrimitiveMode -> Int
MeshPrimitiveMode -> [MeshPrimitiveMode]
MeshPrimitiveMode -> MeshPrimitiveMode
MeshPrimitiveMode -> MeshPrimitiveMode -> [MeshPrimitiveMode]
MeshPrimitiveMode
-> MeshPrimitiveMode -> MeshPrimitiveMode -> [MeshPrimitiveMode]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MeshPrimitiveMode
-> MeshPrimitiveMode -> MeshPrimitiveMode -> [MeshPrimitiveMode]
$cenumFromThenTo :: MeshPrimitiveMode
-> MeshPrimitiveMode -> MeshPrimitiveMode -> [MeshPrimitiveMode]
enumFromTo :: MeshPrimitiveMode -> MeshPrimitiveMode -> [MeshPrimitiveMode]
$cenumFromTo :: MeshPrimitiveMode -> MeshPrimitiveMode -> [MeshPrimitiveMode]
enumFromThen :: MeshPrimitiveMode -> MeshPrimitiveMode -> [MeshPrimitiveMode]
$cenumFromThen :: MeshPrimitiveMode -> MeshPrimitiveMode -> [MeshPrimitiveMode]
enumFrom :: MeshPrimitiveMode -> [MeshPrimitiveMode]
$cenumFrom :: MeshPrimitiveMode -> [MeshPrimitiveMode]
fromEnum :: MeshPrimitiveMode -> Int
$cfromEnum :: MeshPrimitiveMode -> Int
toEnum :: Int -> MeshPrimitiveMode
$ctoEnum :: Int -> MeshPrimitiveMode
pred :: MeshPrimitiveMode -> MeshPrimitiveMode
$cpred :: MeshPrimitiveMode -> MeshPrimitiveMode
succ :: MeshPrimitiveMode -> MeshPrimitiveMode
$csucc :: MeshPrimitiveMode -> MeshPrimitiveMode
Enum, Int -> MeshPrimitiveMode -> ShowS
[MeshPrimitiveMode] -> ShowS
MeshPrimitiveMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MeshPrimitiveMode] -> ShowS
$cshowList :: [MeshPrimitiveMode] -> ShowS
show :: MeshPrimitiveMode -> String
$cshow :: MeshPrimitiveMode -> String
showsPrec :: Int -> MeshPrimitiveMode -> ShowS
$cshowsPrec :: Int -> MeshPrimitiveMode -> ShowS
Show)

-- | Reference to a texture.
data TextureInfo = TextureInfo
  { -- | The index of the texture.
    TextureInfo -> Int
textureId :: Int,
    -- | This integer value is used to construct a string in the format
    -- TEXCOORD_<set_index> which is a reference to a key in mesh.primitives.attributes
    -- (e.g. a value of 0 corresponds to TEXCOORD_0).
    TextureInfo -> Int
textureTexCoord :: Int
  } deriving (TextureInfo -> TextureInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextureInfo -> TextureInfo -> Bool
$c/= :: TextureInfo -> TextureInfo -> Bool
== :: TextureInfo -> TextureInfo -> Bool
$c== :: TextureInfo -> TextureInfo -> Bool
Eq, Int -> TextureInfo -> ShowS
[TextureInfo] -> ShowS
TextureInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextureInfo] -> ShowS
$cshowList :: [TextureInfo] -> ShowS
show :: TextureInfo -> String
$cshow :: TextureInfo -> String
showsPrec :: Int -> TextureInfo -> ShowS
$cshowsPrec :: Int -> TextureInfo -> ShowS
Show)

-- | Metadata about the glTF asset
_asset :: Lens' Gltf Asset
_asset :: Lens' Gltf Asset
_asset = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Gltf -> Asset
gltfAsset (\Gltf
gltf Asset
asset -> Gltf
gltf { gltfAsset :: Asset
gltfAsset = Asset
asset })

-- | A Vector of Images. An Image defines data used to create a texture.
_images :: Lens' Gltf (Vector Image)
_images :: Lens' Gltf (Vector Image)
_images = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Gltf -> Vector Image
gltfImages (\Gltf
gltf Vector Image
images -> Gltf
gltf { gltfImages :: Vector Image
gltfImages = Vector Image
images })

-- | A Vector of Materials. A Material defines the appearance of a primitive.
_materials :: Lens' Gltf (Vector Material)
_materials :: Lens' Gltf (Vector Material)
_materials = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Gltf -> Vector Material
gltfMaterials (\Gltf
gltf Vector Material
mats -> Gltf
gltf { gltfMaterials :: Vector Material
gltfMaterials = Vector Material
mats })

-- | A Vector of Meshes. A Mesh is a set of primitives to be rendered.
_meshes :: Lens' Gltf (Vector Mesh)
_meshes :: Lens' Gltf (Vector Mesh)
_meshes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Gltf -> Vector Mesh
gltfMeshes (\Gltf
gltf Vector Mesh
meshes -> Gltf
gltf { gltfMeshes :: Vector Mesh
gltfMeshes = Vector Mesh
meshes })

-- | A Vector of Nodes in the hierarchy.
_nodes :: Lens' Gltf (Vector Node)
_nodes :: Lens' Gltf (Vector Node)
_nodes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Gltf -> Vector Node
gltfNodes (\Gltf
gltf Vector Node
nodes -> Gltf
gltf { gltfNodes :: Vector Node
gltfNodes = Vector Node
nodes })

-- | A Vector of Texture Samplers. Texture Sampler defines properties for filtering and
-- wrapping modes.
_samplers :: Lens' Gltf (Vector Sampler)
_samplers :: Lens' Gltf (Vector Sampler)
_samplers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Gltf -> Vector Sampler
gltfSamplers (\Gltf
gltf Vector Sampler
samplers -> Gltf
gltf { gltfSamplers :: Vector Sampler
gltfSamplers = Vector Sampler
samplers })

-- | A texture and its sampler.
_textures :: Lens' Gltf (Vector Texture)
_textures :: Lens' Gltf (Vector Texture)
_textures = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Gltf -> Vector Texture
gltfTextures (\Gltf
gltf Vector Texture
texs -> Gltf
gltf { gltfTextures :: Vector Texture
gltfTextures = Vector Texture
texs })

-- | The glTF version that this asset targets.
_assetVersion :: Lens' Asset Text
_assetVersion :: Lens' Asset Text
_assetVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Asset -> Text
assetVersion (\Asset
asset Text
version' -> Asset
asset { assetVersion :: Text
assetVersion = Text
version' })

-- | A copyright message suitable for display to credit the content creator.
_assetCopyright :: Lens' Asset (Maybe Text)
_assetCopyright :: Lens' Asset (Maybe Text)
_assetCopyright = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  Asset -> Maybe Text
assetCopyright
  (\Asset
asset Maybe Text
copyright' -> Asset
asset { assetCopyright :: Maybe Text
assetCopyright = Maybe Text
copyright' })

-- | Tool that generated this glTF model.
_assetGenerator :: Lens' Asset (Maybe Text)
_assetGenerator :: Lens' Asset (Maybe Text)
_assetGenerator = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  Asset -> Maybe Text
assetGenerator
  (\Asset
asset Maybe Text
generator' -> Asset
asset { assetGenerator :: Maybe Text
assetGenerator = Maybe Text
generator' })

-- | The minimum glTF version that this asset targets
_assetMinVersion :: Lens' Asset (Maybe Text)
_assetMinVersion :: Lens' Asset (Maybe Text)
_assetMinVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  Asset -> Maybe Text
assetMinVersion
  (\Asset
asset Maybe Text
minVersion' -> Asset
asset { assetMinVersion :: Maybe Text
assetMinVersion = Maybe Text
minVersion' })

-- | The binary data of the image
_imageData :: Lens' Image (Maybe ByteString)
_imageData :: Lens' Image (Maybe ByteString)
_imageData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Image -> Maybe ByteString
imageData (\Image
img Maybe ByteString
data' -> Image
img { imageData :: Maybe ByteString
imageData = Maybe ByteString
data' })

-- | The image’s media type.
_imageMimeType :: Lens' Image Text
_imageMimeType :: Lens' Image Text
_imageMimeType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Image -> Text
imageMimeType (\Image
img Text
mime -> Image
img { imageMimeType :: Text
imageMimeType = Text
mime })

-- | The user-defined name of this object.
_imageName :: Lens' Image (Maybe Text)
_imageName :: Lens' Image (Maybe Text)
_imageName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Image -> Maybe Text
imageName (\Image
img Maybe Text
name -> Image
img { imageName :: Maybe Text
imageName = Maybe Text
name })

-- | Specifies the cutoff threshold when in MASK alpha mode.
_materialAlphaCutoff :: Lens' Material Float
_materialAlphaCutoff :: Lens' Material Float
_materialAlphaCutoff = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  Material -> Float
materialAlphaCutoff
  (\Material
material Float
alphaCutoff -> Material
material { materialAlphaCutoff :: Float
materialAlphaCutoff = Float
alphaCutoff })

-- | The material's alpha rendering mode enumeration specifying the interpretation of
--   the alpha value of the base color.
_materialAlphaMode :: Lens' Material MaterialAlphaMode
_materialAlphaMode :: Lens' Material MaterialAlphaMode
_materialAlphaMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  Material -> MaterialAlphaMode
materialAlphaMode
  (\Material
material MaterialAlphaMode
mode -> Material
material { materialAlphaMode :: MaterialAlphaMode
materialAlphaMode = MaterialAlphaMode
mode })

-- | Specifies whether the material is double sided.
_materialDoubleSided :: Lens' Material Bool
_materialDoubleSided :: Lens' Material Bool
_materialDoubleSided = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  Material -> Bool
materialDoubleSided
  (\Material
material Bool
doubleSided -> Material
material { materialDoubleSided :: Bool
materialDoubleSided = Bool
doubleSided })

-- | The factors for the emissive color of the material.
_materialEmissiveFactor :: Lens' Material (V3 Float)
_materialEmissiveFactor :: Lens' Material (V3 Float)
_materialEmissiveFactor = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  Material -> V3 Float
materialEmissiveFactor
  (\Material
material V3 Float
emissiveFactor -> Material
material { materialEmissiveFactor :: V3 Float
materialEmissiveFactor = V3 Float
emissiveFactor })

-- | The user-defined name of this object.
_materialName :: Lens' Material (Maybe Text)
_materialName :: Lens' Material (Maybe Text)
_materialName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  Material -> Maybe Text
materialName
  (\Material
material Maybe Text
name -> Material
material { materialName :: Maybe Text
materialName = Maybe Text
name })

-- | Metallic roughness Physically Based Rendering (PBR) methodology parameter values.
_materialPbrMetallicRoughness :: Lens' Material (Maybe PbrMetallicRoughness)
_materialPbrMetallicRoughness :: Lens' Material (Maybe PbrMetallicRoughness)
_materialPbrMetallicRoughness = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  Material -> Maybe PbrMetallicRoughness
materialPbrMetallicRoughness
  (\Material
material Maybe PbrMetallicRoughness
roughness -> Material
material { materialPbrMetallicRoughness :: Maybe PbrMetallicRoughness
materialPbrMetallicRoughness = Maybe PbrMetallicRoughness
roughness })

-- | The user-defined name of this object.
_meshName :: Lens' Mesh (Maybe Text)
_meshName :: Lens' Mesh (Maybe Text)
_meshName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Mesh -> Maybe Text
meshName (\Mesh
mesh Maybe Text
name -> Mesh
mesh { meshName :: Maybe Text
meshName = Maybe Text
name })

-- | A Vector of primitives, each defining geometry to be rendered.
_meshPrimitives :: Lens' Mesh (Vector MeshPrimitive)
_meshPrimitives :: Lens' Mesh (Vector MeshPrimitive)
_meshPrimitives = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  Mesh -> Vector MeshPrimitive
meshPrimitives
  (\Mesh
mesh Vector MeshPrimitive
primitives -> Mesh
mesh { meshPrimitives :: Vector MeshPrimitive
meshPrimitives = Vector MeshPrimitive
primitives })

-- | A Vector of weights to be applied to the morph targets.
_meshWeights :: Lens' Mesh (Vector Float)
_meshWeights :: Lens' Mesh (Vector Float)
_meshWeights = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Mesh -> Vector Float
meshWeights (\Mesh
mesh Vector Float
weights -> Mesh
mesh { meshWeights :: Vector Float
meshWeights = Vector Float
weights })

-- | The indices of this node's children.
_nodeChildren :: Lens' Node (Vector Int)
_nodeChildren :: Lens' Node (Vector Int)
_nodeChildren = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Node -> Vector Int
nodeChildren (\Node
node Vector Int
children -> Node
node { nodeChildren :: Vector Int
nodeChildren = Vector Int
children })

-- | The index of the mesh in this node.
_nodeMeshId :: Lens' Node (Maybe Int)
_nodeMeshId :: Lens' Node (Maybe Int)
_nodeMeshId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Node -> Maybe Int
nodeMeshId (\Node
node Maybe Int
meshId -> Node
node { nodeMeshId :: Maybe Int
nodeMeshId = Maybe Int
meshId })

-- | The user-defined name of this object.
_nodeName :: Lens' Node (Maybe Text)
_nodeName :: Lens' Node (Maybe Text)
_nodeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Node -> Maybe Text
nodeName (\Node
node Maybe Text
name' -> Node
node { nodeName :: Maybe Text
nodeName = Maybe Text
name' })

-- | The node's unit quaternion rotation.
_nodeRotation :: Lens' Node (Maybe (V4 Float))
_nodeRotation :: Lens' Node (Maybe (V4 Float))
_nodeRotation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Node -> Maybe (V4 Float)
nodeRotation (\Node
node Maybe (V4 Float)
rotation' -> Node
node { nodeRotation :: Maybe (V4 Float)
nodeRotation = Maybe (V4 Float)
rotation' })

-- | The node's non-uniform scale
_nodeScale :: Lens' Node (Maybe (V3 Float))
_nodeScale :: Lens' Node (Maybe (V3 Float))
_nodeScale = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Node -> Maybe (V3 Float)
nodeScale (\Node
node Maybe (V3 Float)
scale' -> Node
node { nodeScale :: Maybe (V3 Float)
nodeScale = Maybe (V3 Float)
scale' })

-- | The node's translation along the x, y, and z axes.
_nodeTranslation :: Lens' Node (Maybe (V3 Float))
_nodeTranslation :: Lens' Node (Maybe (V3 Float))
_nodeTranslation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  Node -> Maybe (V3 Float)
nodeTranslation
  (\Node
node Maybe (V3 Float)
translation' -> Node
node { nodeTranslation :: Maybe (V3 Float)
nodeTranslation = Maybe (V3 Float)
translation' })

-- | The weights of the instantiated morph target.
_nodeWeights :: Lens' Node [Float]
_nodeWeights :: Lens' Node [Float]
_nodeWeights = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Node -> [Float]
nodeWeights (\Node
node [Float]
weights' -> Node
node { nodeWeights :: [Float]
nodeWeights = [Float]
weights' })

-- | Magnification filter.
_samplerMagFilter :: Lens' Sampler (Maybe MagFilter)
_samplerMagFilter :: Lens' Sampler (Maybe MagFilter)
_samplerMagFilter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  Sampler -> Maybe MagFilter
samplerMagFilter
  (\Sampler
sampler Maybe MagFilter
mag -> Sampler
sampler { samplerMagFilter :: Maybe MagFilter
samplerMagFilter = Maybe MagFilter
mag })

-- | Minification filter.
_samplerMinFilter :: Lens' Sampler (Maybe MinFilter)
_samplerMinFilter :: Lens' Sampler (Maybe MinFilter)
_samplerMinFilter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  Sampler -> Maybe MinFilter
samplerMinFilter
  (\Sampler
sampler Maybe MinFilter
min' -> Sampler
sampler { samplerMinFilter :: Maybe MinFilter
samplerMinFilter = Maybe MinFilter
min' })

-- | The user-defined name of this object.
_samplerName :: Lens' Sampler (Maybe Text)
_samplerName :: Lens' Sampler (Maybe Text)
_samplerName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  Sampler -> Maybe Text
samplerName
  (\Sampler
sampler Maybe Text
name -> Sampler
sampler { samplerName :: Maybe Text
samplerName = Maybe Text
name })

-- | S (U) wrapping mode.
_samplerWrapS :: Lens' Sampler SamplerWrap
_samplerWrapS :: Lens' Sampler SamplerWrap
_samplerWrapS = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  Sampler -> SamplerWrap
samplerWrapS
  (\Sampler
sampler SamplerWrap
wrapS -> Sampler
sampler { samplerWrapS :: SamplerWrap
samplerWrapS = SamplerWrap
wrapS })

-- | T (V) wrapping mode.
_samplerWrapT :: Lens' Sampler SamplerWrap
_samplerWrapT :: Lens' Sampler SamplerWrap
_samplerWrapT = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  Sampler -> SamplerWrap
samplerWrapT
  (\Sampler
sampler SamplerWrap
wrapT -> Sampler
sampler { samplerWrapT :: SamplerWrap
samplerWrapT = SamplerWrap
wrapT })

-- | The user-defined name of this object.
_textureName :: Lens' Texture (Maybe Text)
_textureName :: Lens' Texture (Maybe Text)
_textureName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Texture -> Maybe Text
textureName (\Texture
tex Maybe Text
name -> Texture
tex { textureName :: Maybe Text
textureName = Maybe Text
name })

-- | The index of the sampler used by this texture.
_textureSamplerId :: Lens' Texture (Maybe Int)
_textureSamplerId :: Lens' Texture (Maybe Int)
_textureSamplerId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  Texture -> Maybe Int
textureSamplerId
  (\Texture
tex Maybe Int
sampler -> Texture
tex { textureSamplerId :: Maybe Int
textureSamplerId = Maybe Int
sampler })

-- | The index of the image used by this texture.
_textureSourceId :: Lens' Texture (Maybe Int)
_textureSourceId :: Lens' Texture (Maybe Int)
_textureSourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  Texture -> Maybe Int
textureSourceId
  (\Texture
tex Maybe Int
source -> Texture
tex { textureSourceId :: Maybe Int
textureSourceId = Maybe Int
source })

-- | A Vector of vertex indices.
_meshPrimitiveIndices :: Lens' MeshPrimitive (Vector Word16)
_meshPrimitiveIndices :: Lens' MeshPrimitive (Vector Word16)
_meshPrimitiveIndices = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  MeshPrimitive -> Vector Word16
meshPrimitiveIndices
  (\MeshPrimitive
primitive' Vector Word16
indices -> MeshPrimitive
primitive' { meshPrimitiveIndices :: Vector Word16
meshPrimitiveIndices = Vector Word16
indices })

-- | The index of the material to apply to this primitive when rendering.
_meshPrimitiveMaterial :: Lens' MeshPrimitive (Maybe Int)
_meshPrimitiveMaterial :: Lens' MeshPrimitive (Maybe Int)
_meshPrimitiveMaterial = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  MeshPrimitive -> Maybe Int
meshPrimitiveMaterial
  (\MeshPrimitive
primitive' Maybe Int
material -> MeshPrimitive
primitive' { meshPrimitiveMaterial :: Maybe Int
meshPrimitiveMaterial = Maybe Int
material })

-- | The topology type of primitives to render.
_meshPrimitiveMode :: Lens' MeshPrimitive MeshPrimitiveMode
_meshPrimitiveMode :: Lens' MeshPrimitive MeshPrimitiveMode
_meshPrimitiveMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  MeshPrimitive -> MeshPrimitiveMode
meshPrimitiveMode
  (\MeshPrimitive
primitive' MeshPrimitiveMode
mode -> MeshPrimitive
primitive' { meshPrimitiveMode :: MeshPrimitiveMode
meshPrimitiveMode = MeshPrimitiveMode
mode })

-- | A Vector of vertex normals.
_meshPrimitiveNormals :: Lens' MeshPrimitive (Vector (V3 Float))
_meshPrimitiveNormals :: Lens' MeshPrimitive (Vector (V3 Float))
_meshPrimitiveNormals = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  MeshPrimitive -> Vector (V3 Float)
meshPrimitiveNormals
  (\MeshPrimitive
primitive' Vector (V3 Float)
normals -> MeshPrimitive
primitive' { meshPrimitiveNormals :: Vector (V3 Float)
meshPrimitiveNormals = Vector (V3 Float)
normals })

-- | A Vector of vertex positions.
_meshPrimitivePositions :: Lens' MeshPrimitive (Vector (V3 Float))
_meshPrimitivePositions :: Lens' MeshPrimitive (Vector (V3 Float))
_meshPrimitivePositions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  MeshPrimitive -> Vector (V3 Float)
meshPrimitivePositions
  (\MeshPrimitive
primitive' Vector (V3 Float)
positions -> MeshPrimitive
primitive' { meshPrimitivePositions :: Vector (V3 Float)
meshPrimitivePositions = Vector (V3 Float)
positions })

-- | A Vector of vertex texture coordinates
_meshPrimitiveTexCoords :: Lens' MeshPrimitive (Vector (V2 Float))
_meshPrimitiveTexCoords :: Lens' MeshPrimitive (Vector (V2 Float))
_meshPrimitiveTexCoords = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  MeshPrimitive -> Vector (V2 Float)
meshPrimitiveTexCoords
  (\MeshPrimitive
primitive' Vector (V2 Float)
coords -> MeshPrimitive
primitive' { meshPrimitiveTexCoords :: Vector (V2 Float)
meshPrimitiveTexCoords = Vector (V2 Float)
coords })

-- | The factors for the base color of the material.
_pbrBaseColorFactor :: Lens' PbrMetallicRoughness (V4 Float)
_pbrBaseColorFactor :: Lens' PbrMetallicRoughness (V4 Float)
_pbrBaseColorFactor = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  PbrMetallicRoughness -> V4 Float
pbrBaseColorFactor
  (\PbrMetallicRoughness
pbr V4 Float
baseColor -> PbrMetallicRoughness
pbr { pbrBaseColorFactor :: V4 Float
pbrBaseColorFactor = V4 Float
baseColor })

-- | The base color texture
_pbrBaseColorTexture :: Lens' PbrMetallicRoughness (Maybe TextureInfo)
_pbrBaseColorTexture :: Lens' PbrMetallicRoughness (Maybe TextureInfo)
_pbrBaseColorTexture = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  PbrMetallicRoughness -> Maybe TextureInfo
pbrBaseColorTexture
  (\PbrMetallicRoughness
pbr Maybe TextureInfo
texture -> PbrMetallicRoughness
pbr { pbrBaseColorTexture :: Maybe TextureInfo
pbrBaseColorTexture = Maybe TextureInfo
texture })

-- | The factor for the metalness of the material.
_pbrMetallicFactor :: Lens' PbrMetallicRoughness Float
_pbrMetallicFactor :: Lens' PbrMetallicRoughness Float
_pbrMetallicFactor = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  PbrMetallicRoughness -> Float
pbrMetallicFactor
  (\PbrMetallicRoughness
pbr Float
metallicFactor -> PbrMetallicRoughness
pbr { pbrMetallicFactor :: Float
pbrMetallicFactor = Float
metallicFactor })

-- | The factor for the roughness of the material.
_pbrRoughnessFactor :: Lens' PbrMetallicRoughness Float
_pbrRoughnessFactor :: Lens' PbrMetallicRoughness Float
_pbrRoughnessFactor = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  PbrMetallicRoughness -> Float
pbrRoughnessFactor
  (\PbrMetallicRoughness
pbr Float
roughnessFactor -> PbrMetallicRoughness
pbr { pbrRoughnessFactor :: Float
pbrRoughnessFactor = Float
roughnessFactor })

-- | The index of the texture.
_textureInfoId :: Lens' TextureInfo Int
_textureInfoId :: Lens' TextureInfo Int
_textureInfoId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  TextureInfo -> Int
textureId
  (\TextureInfo
texInfo Int
id' -> TextureInfo
texInfo { textureId :: Int
textureId = Int
id' })

-- | This integer value is used to construct a string in the format
-- TEXCOORD_<set_index> which is a reference to a key in mesh.primitives.attributes
-- (e.g. a value of 0 corresponds to TEXCOORD_0).
_textureInfoTexCoord :: Lens' TextureInfo Int
_textureInfoTexCoord :: Lens' TextureInfo Int
_textureInfoTexCoord = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  TextureInfo -> Int
textureTexCoord
  (\TextureInfo
texInfo Int
coord -> TextureInfo
texInfo { textureTexCoord :: Int
textureTexCoord = Int
coord })