module Text.GLTF.Loader.Gltf
(
Gltf(..),
Asset(..),
Image(..),
MagFilter(..),
MinFilter(..),
Material(..),
MaterialAlphaMode(..),
Mesh(..),
Node(..),
MeshPrimitive(..),
PbrMetallicRoughness(..),
MeshPrimitiveMode(..),
Sampler(..),
SamplerWrap(..),
Texture(..),
TextureInfo(..),
_asset,
_images,
_materials,
_meshes,
_nodes,
_samplers,
_textures,
_assetVersion,
_assetCopyright,
_assetGenerator,
_assetMinVersion,
_imageData,
_imageMimeType,
_imageName,
_materialAlphaCutoff,
_materialAlphaMode,
_materialDoubleSided,
_materialEmissiveFactor,
_materialName,
_materialPbrMetallicRoughness,
_meshPrimitives,
_meshWeights,
_meshName,
_nodeChildren,
_nodeMeshId,
_nodeName,
_nodeRotation,
_nodeScale,
_nodeTranslation,
_nodeWeights,
_samplerMagFilter,
_samplerMinFilter,
_samplerName,
_samplerWrapS,
_samplerWrapT,
_textureName,
_textureSamplerId,
_textureSourceId,
_meshPrimitiveMaterial,
_meshPrimitiveIndices,
_meshPrimitiveMode,
_meshPrimitiveNormals,
_meshPrimitivePositions,
_pbrBaseColorFactor,
_pbrBaseColorTexture,
_pbrMetallicFactor,
_pbrRoughnessFactor,
_textureInfoId,
_textureInfoTexCoord
) where
import Linear
import RIO
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)
data Asset = Asset
{
Asset -> Text
assetVersion :: Text,
Asset -> Maybe Text
assetCopyright :: Maybe Text,
Asset -> Maybe Text
assetGenerator :: Maybe Text,
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)
data Image = Image
{
Image -> Maybe ByteString
imageData :: Maybe ByteString,
Image -> Text
imageMimeType :: Text,
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)
data Material = Material
{
Material -> Float
materialAlphaCutoff :: Float,
Material -> MaterialAlphaMode
materialAlphaMode :: MaterialAlphaMode,
Material -> Bool
materialDoubleSided :: Bool,
Material -> V3 Float
materialEmissiveFactor :: V3 Float,
Material -> Maybe Text
materialName :: Maybe Text,
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)
data Mesh = Mesh
{
Mesh -> Maybe Text
meshName :: Maybe Text,
Mesh -> Vector MeshPrimitive
meshPrimitives :: Vector MeshPrimitive,
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)
data Node = Node
{
Node -> Vector Int
nodeChildren :: Vector Int,
Node -> Maybe Int
nodeMeshId :: Maybe Int,
Node -> Maybe Text
nodeName :: Maybe Text,
Node -> Maybe (V4 Float)
nodeRotation :: Maybe (V4 Float),
Node -> Maybe (V3 Float)
nodeScale :: Maybe (V3 Float),
Node -> Maybe (V3 Float)
nodeTranslation :: Maybe (V3 Float),
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)
data Sampler = Sampler
{
Sampler -> Maybe MagFilter
samplerMagFilter :: Maybe MagFilter,
Sampler -> Maybe MinFilter
samplerMinFilter :: Maybe MinFilter,
Sampler -> Maybe Text
samplerName :: Maybe Text,
Sampler -> SamplerWrap
samplerWrapS :: SamplerWrap,
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)
data Texture = Texture
{
Texture -> Maybe Text
textureName :: Maybe Text,
Texture -> Maybe Int
textureSamplerId :: Maybe Int,
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)
data MeshPrimitive = MeshPrimitive
{
MeshPrimitive -> Vector Word16
meshPrimitiveIndices :: Vector Word16,
MeshPrimitive -> Maybe Int
meshPrimitiveMaterial :: Maybe Int,
MeshPrimitive -> MeshPrimitiveMode
meshPrimitiveMode :: MeshPrimitiveMode,
MeshPrimitive -> Vector (V3 Float)
meshPrimitiveNormals :: Vector (V3 Float),
MeshPrimitive -> Vector (V3 Float)
meshPrimitivePositions :: Vector (V3 Float),
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)
data MaterialAlphaMode
= Blend
| Mask
| 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)
data PbrMetallicRoughness = PbrMetallicRoughness
{
PbrMetallicRoughness -> V4 Float
pbrBaseColorFactor :: V4 Float,
PbrMetallicRoughness -> Maybe TextureInfo
pbrBaseColorTexture :: Maybe TextureInfo,
PbrMetallicRoughness -> Float
pbrMetallicFactor :: Float,
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)
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)
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)
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)
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)
data TextureInfo = TextureInfo
{
TextureInfo -> Int
textureId :: Int,
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)
_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 })
_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 })
_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 })
_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 })
_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 })
_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 })
_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 })
_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' })
_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' })
_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' })
_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' })
_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' })
_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 })
_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 })
_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 })
_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 })
_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 })
_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 })
_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 })
_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 })
_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 })
_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 })
_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 })
_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 })
_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 })
_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' })
_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' })
_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' })
_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' })
_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' })
_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 })
_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' })
_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 })
_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 })
_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 })
_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 })
_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 })
_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 })
_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 })
_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 })
_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 })
_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 })
_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 })
_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 })
_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 })
_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 })
_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 })
_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 })
_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' })
_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 })