gltf-loader-0.3.0.0: test/Text/GLTF/Loader/Internal/AdapterSpec.hs
module Text.GLTF.Loader.Internal.AdapterSpec (spec) where
import Text.GLTF.Loader.Gltf
import Text.GLTF.Loader.Internal.Adapter
import Text.GLTF.Loader.Internal.BufferAccessor
import Text.GLTF.Loader.Internal.MonadAdapter
import Text.GLTF.Loader.Test.MkGltf
import Linear
import RIO
import Test.Hspec
import qualified Codec.GlTF.BufferView as BufferView
import qualified Codec.GlTF.Image as Image
import qualified Codec.GlTF.Material as Material
import qualified Codec.GlTF.Mesh as Mesh
import qualified Codec.GlTF.Node as Node
import qualified Codec.GlTF.Texture as Texture
import qualified Codec.GlTF.URI as URI
spec :: Spec
spec = do
let codecGltf = mkCodecGltf
codecMeshPrimitive = mkCodecMeshPrimitive
describe "runAdapter" $ do
it "Runs a basic GlTF adapter" $ do
buffers' <- buffers
images' <- images
runAdapter codecGltf buffers' images' `shouldBe` loaderGltf
describe "adaptGltf" $ do
it "Adapts a basic GlTF" $ do
env' <- env
runReader adaptGltf env' `shouldBe` loaderGltf
describe "adaptAsset" $ do
let codecAsset = mkCodecAsset
it "Adapts a basic asset" $
adaptAsset codecAsset `shouldBe` loaderAsset
describe "adaptMeshes" $ do
let codecMesh = mkCodecMesh
codecMesh' = mkCodecMesh { Mesh.weights = Just [3.1] }
it "Adapts a list of nodes" $ do
env' <- env
let meshes = Just [codecMesh, codecMesh']
adaptedMeshes = [loaderMesh, set _meshWeights [3.1] loaderMesh]
runReader (adaptMeshes meshes) env' `shouldBe` adaptedMeshes
it "Adapts empty meshes" $ do
env' <- env
runReader (adaptMeshes (Just [])) env' `shouldBe` []
runReader (adaptMeshes Nothing) env' `shouldBe` []
describe "adaptMaterials" $ do
let materials = Just [mkCodecMaterial]
it "Adapts a list of materials" $ do
adaptMaterials Nothing `shouldBe` []
adaptMaterials materials `shouldBe` [loaderMaterial]
it "Ignores PBR metallic roughness when not specified" $ do
let materials' = Just
[mkCodecMaterial { Material.pbrMetallicRoughness = Nothing }]
adaptedMaterial = set _materialPbrMetallicRoughness Nothing loaderMaterial
adaptMaterials materials' `shouldBe` [adaptedMaterial]
describe "adaptNodes" $ do
let codecNode = mkCodecNode
codecNode' = codecNode { Node.rotation = Nothing }
it "Adapts a list of nodes" $ do
let nodes = Just [codecNode, codecNode']
adaptNodes nodes `shouldBe` [loaderNode, set _nodeRotation Nothing loaderNode]
it "Adapts empty nodes" $ do
adaptNodes (Just []) `shouldBe` []
adaptNodes Nothing `shouldBe` []
describe "adaptImage" $ do
let codecImage = Image.Image
{ uri = Nothing,
mimeType = Just "text/jpg",
bufferView = Just $ BufferView.BufferViewIx 4,
name = Just "Image",
extensions = Nothing,
extras = Nothing
}
it "Adapts a BufferView image" $ do
env' <- env
let image = ImageBufferView (BufferView.BufferViewIx 4)
runReader (adaptImage image codecImage) env' `shouldBe`
Image
{ imageData = Just "imageData",
imageMimeType = "text/jpg",
imageName = Just "Image"
}
it "Adapts a URI image" $ do
env' <- env
let image = ImageData "imageData"
codecImage' = codecImage
{ Image.uri = Just $ URI.URI "",
Image.bufferView = Nothing
}
runReader (adaptImage image codecImage') env' `shouldBe`
Image
{ imageData = Just "imageData",
imageMimeType = "text/jpg",
imageName = Just "Image"
}
it "Fails when mimeType is Nothing" $ do
env' <- env
let image = ImageData "imageData"
codecImage' = codecImage { Image.mimeType = Nothing }
-- evaluate (error "") `shouldThrow` anyErrorCall
evaluate (runReader (adaptImage image codecImage') env') `shouldThrow` anyErrorCall
describe "adaptMesh" $ do
let codecMesh = mkCodecMesh
codecMesh' = mkCodecMesh { Mesh.weights = Nothing }
codecMesh'' = mkCodecMesh { Mesh.weights = Just [] }
it "Adapts a basic mesh" $ do
env' <- env
runReader (adaptMesh codecMesh) env' `shouldBe` loaderMesh
it "Adapts empty weights" $ do
env' <- env
let meshEmptyWeight = set _meshWeights [] loaderMesh
runReader (adaptMesh codecMesh') env' `shouldBe` meshEmptyWeight
runReader (adaptMesh codecMesh'') env' `shouldBe` meshEmptyWeight
describe "adaptNode" $ do
it "Adapts a basic node" $ do
adaptNode mkCodecNode `shouldBe` loaderNode
it "Adapts empty weights" $ do
let nodeEmptyWeight = set _nodeWeights [] loaderNode
codecNodeEmpty = mkCodecNode { Node.weights = Nothing }
codecNodeNothing = mkCodecNode { Node.weights = Just [] }
adaptNode codecNodeNothing `shouldBe` nodeEmptyWeight
adaptNode codecNodeEmpty `shouldBe` nodeEmptyWeight
it "Adapts empty children" $ do
let nodeEmptyChildren = set _nodeChildren [] loaderNode
codecNodeNothing = mkCodecNode { Node.children = Nothing }
codecNodeEmpty = mkCodecNode { Node.children = Just [] }
adaptNode codecNodeNothing `shouldBe` nodeEmptyChildren
adaptNode codecNodeEmpty `shouldBe` nodeEmptyChildren
describe "adaptTexture" $ do
it "Adapts simple textures" $ do
adaptTexture mkCodecTexture `shouldBe` loaderTexture
it "Returns Nothing fields unchanged" $ do
let texture = mkCodecTexture
{ Texture.sampler = Nothing,
Texture.source = Nothing
}
expectedResult = loaderTexture
& _textureSamplerId .~ Nothing
& _textureSourceId .~ Nothing
adaptTexture texture `shouldBe` expectedResult
describe "adaptAlphaMode" $ do
it "Adapts all expected modes" $ do
adaptAlphaMode Material.BLEND `shouldBe` Blend
adaptAlphaMode Material.MASK `shouldBe` Mask
adaptAlphaMode Material.OPAQUE `shouldBe` Opaque
evaluate (adaptAlphaMode $ Material.MaterialAlphaMode "???")
`shouldThrow` anyErrorCall
describe "adaptMeshPrimitives" $ do
let codecMeshPrimitive' = mkCodecMeshPrimitive
{ Mesh.mode = Mesh.MeshPrimitiveMode 0 }
it "adapts a list of primitives" $ do
env' <- env
let primitives = [codecMeshPrimitive, codecMeshPrimitive']
expectedResult
= [ loaderMeshPrimitive,
set _meshPrimitiveMode Points loaderMeshPrimitive
]
runReader (adaptMeshPrimitives primitives) env' `shouldBe` expectedResult
describe "adaptMeshPrimitive" $ do
it "adapts a basic primitive" $ do
env' <- env
runReader (adaptMeshPrimitive codecMeshPrimitive) env' `shouldBe` loaderMeshPrimitive
it "ignores indices when unspecified" $ do
env' <- env
let codecMeshPrimitive' = mkCodecMeshPrimitive
{ Mesh.indices = Nothing }
loaderMeshPrimitive' = loaderMeshPrimitive & _meshPrimitiveIndices .~ []
runReader (adaptMeshPrimitive codecMeshPrimitive') env' `shouldBe` loaderMeshPrimitive'
it "ignores material when unspecified" $ do
env' <- env
let codecMeshPrimitive' = mkCodecMeshPrimitive
{ Mesh.material = Nothing }
loaderMeshPrimitive' = loaderMeshPrimitive & _meshPrimitiveMaterial .~ Nothing
runReader (adaptMeshPrimitive codecMeshPrimitive') env'
`shouldBe` loaderMeshPrimitive'
describe "adaptMeshPrimitiveMode" $
it "Adapts all expected modes" $ do
adaptMeshPrimitiveMode Mesh.POINTS `shouldBe` Points
adaptMeshPrimitiveMode Mesh.LINES `shouldBe` Lines
adaptMeshPrimitiveMode Mesh.LINE_LOOP `shouldBe` LineLoop
adaptMeshPrimitiveMode Mesh.LINE_STRIP `shouldBe` LineStrip
adaptMeshPrimitiveMode Mesh.TRIANGLES `shouldBe` Triangles
adaptMeshPrimitiveMode Mesh.TRIANGLE_STRIP `shouldBe` TriangleStrip
adaptMeshPrimitiveMode Mesh.TRIANGLE_FAN `shouldBe` TriangleFan
evaluate (adaptMeshPrimitiveMode $ Mesh.MeshPrimitiveMode 7)
`shouldThrow` anyErrorCall
buffers :: MonadUnliftIO io => io (Vector GltfBuffer)
buffers = loadBuffers mkCodecGltf Nothing basePath
where basePath = "."
images :: MonadUnliftIO io => io (Vector GltfImageData)
images = loadImages mkCodecGltf basePath
where basePath = "."
env :: MonadUnliftIO io => io AdaptEnv
env = AdaptEnv mkCodecGltf <$> buffers <*> images
loaderGltf :: Gltf
loaderGltf = Gltf
{ gltfAsset = loaderAsset,
gltfImages = [loaderImage],
gltfMaterials = [loaderMaterial],
gltfMeshes = [loaderMesh],
gltfNodes = [loaderNode],
gltfSamplers = [loaderSampler],
gltfTextures = [loaderTexture]
}
loaderAsset :: Asset
loaderAsset = Asset
{ assetVersion = "version",
assetCopyright = Just "copyright",
assetGenerator = Just "generator",
assetMinVersion = Just "minVersion"
}
loaderImage :: Image
loaderImage = Image
{ imageData = Just "imagePayload",
imageMimeType = "image/png",
imageName = Just "Image"
}
loaderMaterial :: Material
loaderMaterial = Material
{ materialAlphaCutoff = 1.0,
materialAlphaMode = Opaque,
materialDoubleSided = True,
materialEmissiveFactor = V3 1.0 2.0 3.0,
materialName = Just "Material",
materialPbrMetallicRoughness = Just loaderPbrMetallicRoughness
}
loaderMesh :: Mesh
loaderMesh = Mesh
{ meshPrimitives = [loaderMeshPrimitive],
meshWeights = [1.2],
meshName = Just "mesh"
}
loaderNode :: Node
loaderNode = Node
{ nodeChildren = [1],
nodeMeshId = Just 5,
nodeName = Just "node",
nodeRotation = Just $ V4 1 2 3 4,
nodeScale = Just $ V3 5 6 7,
nodeTranslation = Just $ V3 8 9 10,
nodeWeights = [11, 12, 13]
}
loaderSampler :: Sampler
loaderSampler = Sampler
{ samplerMagFilter = Just MagLinear,
samplerMinFilter = Just MinLinear,
samplerName = Just "Sampler",
samplerWrapS = ClampToEdge,
samplerWrapT = Repeat
}
loaderTexture :: Texture
loaderTexture = Texture
{ textureName = Just "Texture",
textureSamplerId = Just 0,
textureSourceId = Just 0
}
loaderPbrMetallicRoughness :: PbrMetallicRoughness
loaderPbrMetallicRoughness = PbrMetallicRoughness
{ pbrBaseColorFactor = V4 1.0 2.0 3.0 4.0,
pbrBaseColorTexture = Just loaderBaseColorTexture,
pbrMetallicFactor = 1.0,
pbrRoughnessFactor = 2.0
}
loaderMeshPrimitive :: MeshPrimitive
loaderMeshPrimitive = MeshPrimitive
{ meshPrimitiveIndices = [1..4],
meshPrimitiveMaterial = Just 1,
meshPrimitiveMode = Triangles,
meshPrimitiveNormals = fmap (\x -> V3 x x x) [5..8],
meshPrimitivePositions = fmap (\x -> V3 x x x) [1..4],
meshPrimitiveTexCoords = fmap (\x -> V2 x x) [9..12]
}
loaderBaseColorTexture :: TextureInfo
loaderBaseColorTexture = TextureInfo
{ textureId = 15,
textureTexCoord = 10
}