Merge branch 'main' into feature/animations

gltf-loader.cabal

@@ -74,6 +74,7 @@ common shared
         -Widentities
         -Wincomplete-record-updates
         -Wincomplete-uni-patterns
+        -Wno-unrecognised-pragmas
         -Wpartial-fields
         -Wredundant-constraints
     build-depends:

src/Text/GLTF/Loader/Gltf.hs

@@ -21,6 +21,8 @@ module Text.GLTF.Loader.Gltf
     Scene (..),
     Texture (..),
     TextureInfo (..),
+    NormalTextureInfo (..),
+    OcclusionTextureInfo (..),
 
     -- * Lenses
 
@@ -164,8 +166,14 @@ data Material = Material
     materialDoubleSided :: Bool,
     -- | The factors for the emissive color of the material.
     materialEmissiveFactor :: V3 Float,
+    -- | The texture for the emissive color of the material.
+    materialEmissiveTexture :: Maybe TextureInfo,
     -- | The user-defined name of this object.
     materialName :: Maybe Text,
+    -- | The material's tangent space normal map texture
+    materialNormalTexture :: Maybe NormalTextureInfo,
+    -- | The material's ambient occlusion texture
+    materialOcclusionTexture :: Maybe OcclusionTextureInfo,
     -- | Metallic roughness Physically Based Rendering (PBR) methodology parameter values.
     materialPbrMetallicRoughness :: Maybe PbrMetallicRoughness
   }
@@ -248,6 +256,8 @@ data MeshPrimitive = MeshPrimitive
     meshPrimitiveNormals :: Vector (V3 Float),
     -- | A Vector of vertex positions.
     meshPrimitivePositions :: Vector (V3 Float),
+    -- | A Vector of vertex tangents
+    meshPrimitiveTangents :: Vector (V4 Float),
     -- | A Vector of vertex texture coordinates
     meshPrimitiveTexCoords :: Vector (V2 Float),
     -- | A Vector of vertex colors.
@@ -275,6 +285,8 @@ data PbrMetallicRoughness = PbrMetallicRoughness
     pbrBaseColorTexture :: Maybe TextureInfo,
     -- | The factor for the metalness of the material.
     pbrMetallicFactor :: Float,
+    -- | The combined metallic roughness texture of the material
+    pbrMetallicRoughnessTexture :: Maybe TextureInfo,
     -- | The factor for the roughness of the material.
     pbrRoughnessFactor :: Float
   }
@@ -349,6 +361,32 @@ data ChannelSamplerInterpolation
   | Step
   deriving (Eq, Show)
 
+-- | Reference to a normal map texture
+data NormalTextureInfo = NormalTextureInfo
+  { -- | The index of the texture.
+    normalTextureId :: 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).
+    normalTextureTexCoord :: Int,
+    -- | The scalar parameter applied to each normal vector of the normal
+    -- texture.
+    normalTextureScale :: Float
+  }
+  deriving (Eq, Show)
+
+data OcclusionTextureInfo = OcclusionTextureInfo
+  { -- | The index of the texture.
+    occlusionTextureId :: 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).
+    occlusionTextureTexCoord :: Int,
+    -- | A scalar multiplier controlling the amount of occlusion applied.
+    occlusionTextureStrength :: Float
+  }
+  deriving (Eq, Show)
+
 -- | Metadata about the glTF asset
 _asset :: Lens' Gltf Asset
 _asset = lens gltfAsset (\gltf asset -> gltf{gltfAsset = asset})

src/Text/GLTF/Loader/Internal/Adapter.hs

@@ -2,6 +2,7 @@
 module Text.GLTF.Loader.Internal.Adapter
   ( attributePosition,
     attributeNormal,
+    attributeTangent,
     attributeTexCoord,
     attributeColors,
     runAdapter,
@@ -56,6 +57,9 @@ attributePosition = "POSITION"
 attributeNormal :: Text
 attributeNormal = "NORMAL"
 
+attributeTangent :: Text
+attributeTangent = "TANGENT"
+
 attributeTexCoord :: Text
 attributeTexCoord = "TEXCOORD_0"
 
@@ -198,8 +202,13 @@ adaptMaterial Material.Material{..} =
       materialAlphaMode = adaptAlphaMode alphaMode,
       materialDoubleSided = doubleSided,
       materialEmissiveFactor = toV3 emissiveFactor,
+      materialEmissiveTexture = adaptTextureInfo <$> emissiveTexture,
       materialName = name,
-      materialPbrMetallicRoughness = adaptPbrMetallicRoughness <$> pbrMetallicRoughness
+      materialNormalTexture = adaptNormalTextureInfo <$> normalTexture,
+      materialOcclusionTexture = adaptOcclusionTextureInfo <$> occlusionTexture,
+      materialPbrMetallicRoughness =
+        adaptPbrMetallicRoughness
+          <$> pbrMetallicRoughness
     }
 
 adaptMesh :: Mesh.Mesh -> Adapter Mesh
@@ -272,7 +281,10 @@ adaptPbrMetallicRoughness PbrMetallicRoughness.PbrMetallicRoughness{..} =
     { pbrBaseColorFactor = toV4 baseColorFactor,
       pbrBaseColorTexture = adaptTextureInfo <$> baseColorTexture,
       pbrMetallicFactor = metallicFactor,
-      pbrRoughnessFactor = roughnessFactor
+      pbrRoughnessFactor = roughnessFactor,
+      pbrMetallicRoughnessTexture =
+        adaptTextureInfo
+          <$> metallicRoughnessTexture
     }
 
 adaptMeshPrimitives :: Vector Mesh.MeshPrimitive -> Adapter (Vector MeshPrimitive)
@@ -298,13 +310,35 @@ adaptSamplerWrap Sampler.MIRRORED_REPEAT = MirroredRepeat
 adaptSamplerWrap Sampler.REPEAT = Repeat
 adaptSamplerWrap mode = error $ "Invalid SamplerWrap: " <> show mode
 
-adaptTextureInfo :: TextureInfo.TextureInfo a -> TextureInfo
+adaptTextureInfo :: TextureInfo.TextureInfo_ -> TextureInfo
 adaptTextureInfo TextureInfo.TextureInfo{..} =
   TextureInfo
     { textureId = index,
       textureTexCoord = texCoord
     }
 
+adaptNormalTextureInfo
+  :: TextureInfo.TextureInfo Material.MaterialNormal
+  -> NormalTextureInfo
+adaptNormalTextureInfo TextureInfo.TextureInfo{..} =
+  let Material.MaterialNormal{..} = subtype
+  in NormalTextureInfo
+      { normalTextureId = index,
+        normalTextureTexCoord = texCoord,
+        normalTextureScale = scale
+      }
+
+adaptOcclusionTextureInfo
+  :: TextureInfo.TextureInfo Material.MaterialOcclusion
+  -> OcclusionTextureInfo
+adaptOcclusionTextureInfo TextureInfo.TextureInfo{..} =
+  let Material.MaterialOcclusion{..} = subtype
+  in OcclusionTextureInfo
+      { occlusionTextureId = index,
+        occlusionTextureTexCoord = texCoord,
+        occlusionTextureStrength = strength
+      }
+
 adaptMeshPrimitive :: Mesh.MeshPrimitive -> Adapter MeshPrimitive
 adaptMeshPrimitive Mesh.MeshPrimitive{..} = do
   gltf <- getGltf
@@ -317,13 +351,15 @@ adaptMeshPrimitive Mesh.MeshPrimitive{..} = do
         meshPrimitiveMode = adaptMeshPrimitiveMode mode,
         meshPrimitiveNormals = maybe mempty (vertexNormals gltf buffers') normals,
         meshPrimitivePositions = maybe mempty (vertexPositions gltf buffers') positions,
+        meshPrimitiveTangents = maybe mempty (vertexTangents gltf buffers') tangents,
         meshPrimitiveTexCoords = maybe mempty (vertexTexCoords gltf buffers') texCoords,
         meshPrimitiveColors =
           maybe mempty (fmap (mapV4 toRatio) . vertexColors gltf buffers') colors
       }
   where
     positions = attributes HashMap.!? attributePosition
     normals = attributes HashMap.!? attributeNormal
+    tangents = attributes HashMap.!? attributeTangent
     texCoords = attributes HashMap.!? attributeTexCoord
     colors = attributes HashMap.!? attributeColors
     toRatio w = fromIntegral w / fromIntegral (maxBound :: Word16)

src/Text/GLTF/Loader/Internal/BufferAccessor.hs

@@ -16,6 +16,7 @@ module Text.GLTF.Loader.Internal.BufferAccessor
     vertexPositions,
     vertexNormals,
     vertexTexCoords,
+    vertexTangents,
     vertexColors,
     imageDataRaw,
   ) where
@@ -143,6 +144,10 @@ vertexPositions = readBufferWithGet getPositions
 vertexNormals :: GlTF -> Vector GltfBuffer -> AccessorIx -> Vector (V3 Float)
 vertexNormals = readBufferWithGet getNormals
 
+-- | Decode vertex tangents
+vertexTangents :: GlTF -> Vector GltfBuffer -> AccessorIx -> Vector (V4 Float)
+vertexTangents = readBufferWithGet getTangents
+
 -- | Decode texture coordinates. Note that we only use the first one.
 vertexTexCoords :: GlTF -> Vector GltfBuffer -> AccessorIx -> Vector (V2 Float)
 vertexTexCoords = readBufferWithGet getTexCoords

src/Text/GLTF/Loader/Internal/Decoders.hs

@@ -1,9 +1,12 @@
+{-# HLINT ignore "Use <$>" #-}
+
 module Text.GLTF.Loader.Internal.Decoders
   ( -- * GLTF Property-specific Type decoders
     getIndices,
     getIndices32,
     getPositions,
     getNormals,
+    getTangents,
     getTexCoords,
     getColors,
 
@@ -47,6 +50,10 @@ getPositions = getVec3 getFloat
 getNormals :: Get (Vector (V3 Float))
 getNormals = getVec3 getFloat
 
+-- | Vertex tangents binary decoder
+getTangents :: Get (Vector (V4 Float))
+getTangents = getVec4 getFloat
+
 -- | Texture coordinates binary decoder
 getTexCoords :: Get (Vector (V2 Float))
 getTexCoords = getVec2 getFloat
@@ -71,32 +78,49 @@ getVec3 getter = getVector $ V3 <$> getter <*> getter <*> getter
 getVec4 :: Get a -> Get (Vector (V4 a))
 getVec4 getter = getVector $ V4 <$> getter <*> getter <*> getter <*> getter
 
+-- The `getMat*` functions below use a style not recognized by Fourmolu
+{- FOURMOLU_DISABLE -}
+
 -- | 2x2 Matrix binary decoder
 getMat2 :: Get a -> Get (Vector (M22 a))
 getMat2 getter =
-  getVector
-    $ V2
-    <$> (V2 <$> getter <*> getter)
-    <*> (V2 <$> getter <*> getter)
+  getVector $ do {
+    m11 <- getter; m12 <- getter;
+    m21 <- getter; m22 <- getter;
+    return $ V2
+      (V2 m11 m21)
+      (V2 m12 m22)
+  }
 
 -- | 3x3 Matrix binary decoder
 getMat3 :: Get a -> Get (Vector (M33 a))
 getMat3 getter =
-  getVector
-    $ V3
-    <$> (V3 <$> getter <*> getter <*> getter)
-    <*> (V3 <$> getter <*> getter <*> getter)
-    <*> (V3 <$> getter <*> getter <*> getter)
+  getVector $ do {
+    m11 <- getter; m12 <- getter; m13 <- getter;
+    m21 <- getter; m22 <- getter; m23 <- getter;
+    m31 <- getter; m32 <- getter; m33 <- getter;
+    return $ V3
+      (V3 m11 m21 m31)
+      (V3 m12 m22 m32)
+      (V3 m13 m23 m33)
+  }
 
 -- | 4x4 Matrix binary decoder
 getMat4 :: Get a -> Get (Vector (M44 a))
 getMat4 getter =
-  getVector
-    $ V4
-    <$> (V4 <$> getter <*> getter <*> getter <*> getter)
-    <*> (V4 <$> getter <*> getter <*> getter <*> getter)
-    <*> (V4 <$> getter <*> getter <*> getter <*> getter)
-    <*> (V4 <$> getter <*> getter <*> getter <*> getter)
+  getVector $ do {
+    m11 <- getter; m12 <- getter; m13 <- getter; m14 <- getter;
+    m21 <- getter; m22 <- getter; m23 <- getter; m24 <- getter;
+    m31 <- getter; m32 <- getter; m33 <- getter; m34 <- getter;
+    m41 <- getter; m42 <- getter; m43 <- getter; m44 <- getter;
+    return $ V4
+      (V4 m11 m21 m31 m41)
+      (V4 m12 m22 m32 m42)
+      (V4 m13 m23 m33 m43)
+      (V4 m14 m24 m34 m44)
+  }
+
+{- FOURMOLU_DISABLE -}
 
 -- | Quaternion binary decoder
 getQuaternion :: Get a -> Get (Vector (Quaternion a))

test/Text/GLTF/Loader/Internal/AdapterSpec.hs

@@ -106,15 +106,15 @@ spec = do
           Image.Image
             { uri = Nothing,
               mimeType = Just "text/jpg",
-              bufferView = Just $ BufferView.BufferViewIx 4,
+              bufferView = Just $ BufferView.BufferViewIx 6,
               name = Just "Image",
               extensions = Nothing,
               extras = Nothing
             }
 
     it "Adapts a BufferView image" $ do
       env' <- env
-      let image = ImageBufferView (BufferView.BufferViewIx 5)
+      let image = ImageBufferView (BufferView.BufferViewIx 6)
 
       runReader (adaptImage image codecImage) env'
         `shouldBe` Image
@@ -277,7 +277,7 @@ spec = do
               { Mesh.attributes =
                   HashMap.insert
                     attributeColors
-                    (Accessor.AccessorIx 4)
+                    (Accessor.AccessorIx 5)
                     (Mesh.attributes mkCodecMeshPrimitive)
               }
           loaderMeshPrimitive' = loaderMeshPrimitive & _meshPrimitiveColors .~ [0, 0.2, 0.6, 1]
@@ -347,7 +347,10 @@ loaderMaterial =
       materialAlphaMode = Opaque,
       materialDoubleSided = True,
       materialEmissiveFactor = V3 1.0 2.0 3.0,
+      materialEmissiveTexture = Just loaderEmissiveTexture,
       materialName = Just "Material",
+      materialNormalTexture = Just loaderNormalTexture,
+      materialOcclusionTexture = Just loaderOcclusionTexture,
       materialPbrMetallicRoughness = Just loaderPbrMetallicRoughness
     }
 
@@ -402,6 +405,7 @@ loaderPbrMetallicRoughness =
     { pbrBaseColorFactor = V4 1.0 2.0 3.0 4.0,
       pbrBaseColorTexture = Just loaderBaseColorTexture,
       pbrMetallicFactor = 1.0,
+      pbrMetallicRoughnessTexture = Just loaderMetallicRoughnessTexture,
       pbrRoughnessFactor = 2.0
     }
 
@@ -413,6 +417,7 @@ loaderMeshPrimitive =
       meshPrimitiveMode = Triangles,
       meshPrimitiveNormals = fmap (\x -> V3 x x x) [5 .. 8],
       meshPrimitivePositions = fmap (\x -> V3 x x x) [1 .. 4],
+      meshPrimitiveTangents = fmap (\x -> V4 x x x x) [13 .. 16],
       meshPrimitiveTexCoords = fmap (\x -> V2 x x) [9 .. 12],
       meshPrimitiveColors = []
     }
@@ -423,3 +428,33 @@ loaderBaseColorTexture =
     { textureId = 15,
       textureTexCoord = 10
     }
+
+loaderMetallicRoughnessTexture :: TextureInfo
+loaderMetallicRoughnessTexture =
+  TextureInfo
+    { textureId = 16,
+      textureTexCoord = 11
+    }
+
+loaderEmissiveTexture :: TextureInfo
+loaderEmissiveTexture =
+  TextureInfo
+    { textureId = 17,
+      textureTexCoord = 12
+    }
+
+loaderNormalTexture :: NormalTextureInfo
+loaderNormalTexture =
+  NormalTextureInfo
+    { normalTextureId = 18,
+      normalTextureTexCoord = 13,
+      normalTextureScale = 1
+    }
+
+loaderOcclusionTexture :: OcclusionTextureInfo
+loaderOcclusionTexture =
+  OcclusionTextureInfo
+    { occlusionTextureId = 19,
+      occlusionTextureTexCoord = 14,
+      occlusionTextureStrength = 2
+    }

test/Text/GLTF/Loader/Internal/BufferAccessorSpec.hs

@@ -98,7 +98,7 @@ spec = do
               }
 
       images <- loadImages gltf' basePath
-      images `shouldBe` [ImageBufferView (BufferView.BufferViewIx 5)]
+      images `shouldBe` [ImageBufferView (BufferView.BufferViewIx 6)]
 
     it "Returns NoImage when no data specificed" $ do
       let gltf' =