diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,7 +4,6 @@ > A high level GlTF loader - ## Prerequisites In order to build or install you will need @@ -57,20 +56,20 @@ Currently, only geometries and PBR materials are supported, but we hope to support the majority of GlTF features: - - [ ] Animitions + - [ ] Animations - [x] Asset - [ ] Cameras - - [ ] Images - - [ ] Materials + - [x] Images + - [x] Materials - [x] PBR Metallic Roughness - - [ ] Textures + - [x] Textures - [x] Meshes - [x] Positions - [x] Indices - [x] Normals - [x] Texture Coordinates - [x] Nodes - - [ ] Samplers + - [x] Samplers - [ ] Skins ## Authors diff --git a/app/Command/GLTF/Loader/App.hs b/app/Command/GLTF/Loader/App.hs --- a/app/Command/GLTF/Loader/App.hs +++ b/app/Command/GLTF/Loader/App.hs @@ -5,7 +5,8 @@ -- | Command line arguments data Options = Options - { optionsSummary :: !Bool, + { optionsBinary :: !Bool, + optionsSummary :: !Bool, optionsVerbose :: !Bool, optionsFile :: FilePath } @@ -28,6 +29,11 @@ instance HasOptions App where optionsL = lens appOptions (\app opts -> app { appOptions = opts }) + +_optionsBinary :: Lens' Options Bool +_optionsBinary = lens + optionsBinary + (\opts bin -> opts { optionsBinary = bin }) _optionsSummary :: Lens' Options Bool _optionsSummary = lens diff --git a/app/Command/GLTF/Loader/Run.hs b/app/Command/GLTF/Loader/Run.hs --- a/app/Command/GLTF/Loader/Run.hs +++ b/app/Command/GLTF/Loader/Run.hs @@ -13,8 +13,12 @@ run = do options <- asks (^. optionsL) let file = options ^. _optionsFile + binary = options ^. _optionsBinary summary = options ^. _optionsSummary verbose = options ^. _optionsVerbose + fromFile = if binary + then fmap (over _Right (^. _gltf)) . fromBinaryFile + else fromJsonFile logInfo $ "File: " <> fromString file result <- liftIO $ fromFile file @@ -80,12 +84,18 @@ forM_ (mesh ^. _meshPrimitives) $ \primitive' -> do -- Report Vertices logInfo " Vertices:" - + let positions = primitive' ^. _meshPrimitivePositions forM_ (primitive' ^. _meshPrimitiveIndices) $ \index -> do - forM_ (positions Vector.!? index) $ \position -> do + forM_ (positions Vector.!? fromIntegral index) $ \position -> do logInfo $ " [" <> display index <> "]: " <> displayV3 position + logInfo " Normals:" + let normals = primitive' ^. _meshPrimitiveNormals + forM_ (primitive' ^. _meshPrimitiveIndices) $ \index -> do + forM_ (normals Vector.!? fromIntegral index) $ \normal -> do + logInfo $ " [" <> display index <> "]: " <> displayV3 normal + -- Report material forM_ (primitive' ^. _meshPrimitiveMaterial) $ \materialId -> do forM_ (gltf ^. _materials . to (Vector.!? materialId)) reportMaterial @@ -118,7 +128,7 @@ reportMaterial :: Material -> RIO App () reportMaterial material = do - logInfo $ " Material:" + logInfo " Material:" logInfo $ " Name: " <> material ^. _materialName . to (display . fromMaybe "Unknown") diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -40,9 +40,15 @@ options :: Parser Options options = Options - <$> switch summaryOption + <$> switch binaryOption + <*> switch summaryOption <*> switch verboseOption <*> strArgument fileArg + +binaryOption :: Mod FlagFields Bool +binaryOption = long "binary" + <> short 'b' + <> help "Load file as GLB (Binary glTF)" summaryOption :: Mod FlagFields Bool summaryOption diff --git a/data/Untitled.png b/data/Untitled.png new file mode 100644 Binary files /dev/null and b/data/Untitled.png differ diff --git a/data/cube-separate.bin b/data/cube-separate.bin new file mode 100644 Binary files /dev/null and b/data/cube-separate.bin differ diff --git a/data/cube-separate.gltf b/data/cube-separate.gltf new file mode 100644 --- /dev/null +++ b/data/cube-separate.gltf @@ -0,0 +1,137 @@ +{ + "asset" : { + "generator" : "Khronos glTF Blender I/O v3.3.27", + "version" : "2.0" + }, + "scene" : 0, + "scenes" : [ + { + "name" : "Scene", + "nodes" : [ + 0 + ] + } + ], + "nodes" : [ + { + "mesh" : 0, + "name" : "Cube" + } + ], + "materials" : [ + { + "doubleSided" : true, + "name" : "Material", + "pbrMetallicRoughness" : { + "baseColorTexture" : { + "index" : 0 + }, + "metallicFactor" : 0, + "roughnessFactor" : 0.5 + } + } + ], + "meshes" : [ + { + "name" : "Cube", + "primitives" : [ + { + "attributes" : { + "POSITION" : 0, + "NORMAL" : 1, + "TEXCOORD_0" : 2 + }, + "indices" : 3, + "material" : 0 + } + ] + } + ], + "textures" : [ + { + "sampler" : 0, + "source" : 0 + } + ], + "images" : [ + { + "mimeType" : "image/png", + "name" : "Untitled", + "uri" : "Untitled.png" + } + ], + "accessors" : [ + { + "bufferView" : 0, + "componentType" : 5126, + "count" : 24, + "max" : [ + 1, + 1, + 1 + ], + "min" : [ + -1, + -1, + -1 + ], + "type" : "VEC3" + }, + { + "bufferView" : 1, + "componentType" : 5126, + "count" : 24, + "type" : "VEC3" + }, + { + "bufferView" : 2, + "componentType" : 5126, + "count" : 24, + "type" : "VEC2" + }, + { + "bufferView" : 3, + "componentType" : 5123, + "count" : 36, + "type" : "SCALAR" + } + ], + "bufferViews" : [ + { + "buffer" : 0, + "byteLength" : 288, + "byteOffset" : 0, + "target" : 34962 + }, + { + "buffer" : 0, + "byteLength" : 288, + "byteOffset" : 288, + "target" : 34962 + }, + { + "buffer" : 0, + "byteLength" : 192, + "byteOffset" : 576, + "target" : 34962 + }, + { + "buffer" : 0, + "byteLength" : 72, + "byteOffset" : 768, + "target" : 34963 + } + ], + "samplers" : [ + { + "magFilter" : 9729, + "minFilter" : 9987 + } + ], + "buffers" : [ + { + "byteLength" : 840, + "uri" : "cube-separate.bin" + } + ] +} diff --git a/data/cube.glb b/data/cube.glb new file mode 100644 Binary files /dev/null and b/data/cube.glb differ diff --git a/data/cube.gltf b/data/cube.gltf --- a/data/cube.gltf +++ b/data/cube.gltf @@ -1,6 +1,6 @@ { "asset" : { - "generator" : "Khronos glTF Blender I/O v3.2.40", + "generator" : "Khronos glTF Blender I/O v3.3.27", "version" : "2.0" }, "scene" : 0, @@ -23,14 +23,11 @@ "doubleSided" : true, "name" : "Material", "pbrMetallicRoughness" : { - "baseColorFactor" : [ - 0.800000011920929, - 0.800000011920929, - 0.800000011920929, - 1 - ], + "baseColorTexture" : { + "index" : 0 + }, "metallicFactor" : 0, - "roughnessFactor" : 0.4000000059604645 + "roughnessFactor" : 0.5 } } ], @@ -50,6 +47,19 @@ ] } ], + "textures" : [ + { + "sampler" : 0, + "source" : 0 + } + ], + "images" : [ + { + "bufferView" : 4, + "mimeType" : "image/png", + "name" : "Untitled" + } + ], "accessors" : [ { "bufferView" : 0, @@ -90,28 +100,43 @@ { "buffer" : 0, "byteLength" : 288, - "byteOffset" : 0 + "byteOffset" : 0, + "target" : 34962 }, { "buffer" : 0, "byteLength" : 288, - "byteOffset" : 288 + "byteOffset" : 288, + "target" : 34962 }, { "buffer" : 0, "byteLength" : 192, - "byteOffset" : 576 + "byteOffset" : 576, + "target" : 34962 }, { "buffer" : 0, "byteLength" : 72, - "byteOffset" : 768 + "byteOffset" : 768, + "target" : 34963 + }, + { + "buffer" : 0, + "byteLength" : 20559, + "byteOffset" : 840 } ], + "samplers" : [ + { + "magFilter" : 9729, + "minFilter" : 9987 + } + ], "buffers" : [ { - "byteLength" : 840, - "uri" : "data:application/octet-stream;base64,AACAPwAAgD8AAIC/AACAPwAAgD8AAIC/AACAPwAAgD8AAIC/AACAPwAAgL8AAIC/AACAPwAAgL8AAIC/AACAPwAAgL8AAIC/AACAPwAAgD8AAIA/AACAPwAAgD8AAIA/AACAPwAAgD8AAIA/AACAPwAAgL8AAIA/AACAPwAAgL8AAIA/AACAPwAAgL8AAIA/AACAvwAAgD8AAIC/AACAvwAAgD8AAIC/AACAvwAAgD8AAIC/AACAvwAAgL8AAIC/AACAvwAAgL8AAIC/AACAvwAAgL8AAIC/AACAvwAAgD8AAIA/AACAvwAAgD8AAIA/AACAvwAAgD8AAIA/AACAvwAAgL8AAIA/AACAvwAAgL8AAIA/AACAvwAAgL8AAIA/AAAAAAAAAAAAAIC/AAAAAAAAgD8AAACAAACAPwAAAAAAAACAAAAAAAAAgL8AAACAAAAAAAAAAAAAAIC/AACAPwAAAAAAAACAAAAAAAAAAAAAAIA/AAAAAAAAgD8AAACAAACAPwAAAAAAAACAAAAAAAAAgL8AAACAAAAAAAAAAAAAAIA/AACAPwAAAAAAAACAAACAvwAAAAAAAACAAAAAAAAAAAAAAIC/AAAAAAAAgD8AAACAAACAvwAAAAAAAACAAAAAAAAAgL8AAACAAAAAAAAAAAAAAIC/AACAvwAAAAAAAACAAAAAAAAAAAAAAIA/AAAAAAAAgD8AAACAAACAvwAAAAAAAACAAAAAAAAAgL8AAACAAAAAAAAAAAAAAIA/AAAgPwAAAD8AACA/AAAAPwAAID8AAAA/AADAPgAAAD8AAMA+AAAAPwAAwD4AAAA/AAAgPwAAgD4AACA/AACAPgAAID8AAIA+AADAPgAAgD4AAMA+AACAPgAAwD4AAIA+AAAgPwAAQD8AACA/AABAPwAAYD8AAAA/AADAPgAAQD8AAAA+AAAAPwAAwD4AAEA/AAAgPwAAgD8AACA/AAAAAAAAYD8AAIA+AADAPgAAgD8AAAA+AACAPgAAwD4AAAAAAQAOABQAAQAUAAcACgAGABMACgATABcAFQASAAwAFQAMAA8AEAADAAkAEAAJABYABQACAAgABQAIAAsAEQANAAAAEQAAAAQA" + "byteLength" : 21400, + "uri" : "data:application/octet-stream;base64,AACAPwAAgD8AAIC/AACAPwAAgD8AAIC/AACAPwAAgD8AAIC/AACAPwAAgL8AAIC/AACAPwAAgL8AAIC/AACAPwAAgL8AAIC/AACAPwAAgD8AAIA/AACAPwAAgD8AAIA/AACAPwAAgD8AAIA/AACAPwAAgL8AAIA/AACAPwAAgL8AAIA/AACAPwAAgL8AAIA/AACAvwAAgD8AAIC/AACAvwAAgD8AAIC/AACAvwAAgD8AAIC/AACAvwAAgL8AAIC/AACAvwAAgL8AAIC/AACAvwAAgL8AAIC/AACAvwAAgD8AAIA/AACAvwAAgD8AAIA/AACAvwAAgD8AAIA/AACAvwAAgL8AAIA/AACAvwAAgL8AAIA/AACAvwAAgL8AAIA/AAAAAAAAAAAAAIC/AAAAAAAAgD8AAACAAACAPwAAAAAAAACAAAAAAAAAgL8AAACAAAAAAAAAAAAAAIC/AACAPwAAAAAAAACAAAAAAAAAAAAAAIA/AAAAAAAAgD8AAACAAACAPwAAAAAAAACAAAAAAAAAgL8AAACAAAAAAAAAAAAAAIA/AACAPwAAAAAAAACAAACAvwAAAAAAAACAAAAAAAAAAAAAAIC/AAAAAAAAgD8AAACAAACAvwAAAAAAAACAAAAAAAAAgL8AAACAAAAAAAAAAAAAAIC/AACAvwAAAAAAAACAAAAAAAAAAAAAAIA/AAAAAAAAgD8AAACAAACAvwAAAAAAAACAAAAAAAAAgL8AAACAAAAAAAAAAAAAAIA/AAAgPwAAAD8AACA/AAAAPwAAID8AAAA/AADAPgAAAD8AAMA+AAAAPwAAwD4AAAA/AAAgPwAAgD4AACA/AACAPgAAID8AAIA+AADAPgAAgD4AAMA+AACAPgAAwD4AAIA+AAAgPwAAQD8AACA/AABAPwAAYD8AAAA/AADAPgAAQD8AAAA+AAAAPwAAwD4AAEA/AAAgPwAAgD8AACA/AAAAAAAAYD8AAIA+AADAPgAAgD8AAAA+AACAPgAAwD4AAAAAAQAOABQAAQAUAAcACgAGABMACgATABcAFQASAAwAFQAMAA8AEAADAAkAEAAJABYABQACAAgABQAIAAsAEQANAAAAEQAAAAQAiVBORw0KGgoAAAANSUhEUgAABAAAAAQACAYAAAB/HSuDAAAACXBIWXMAAAsTAAALEwEAmpwYAAAgAElEQVR4AezYQREAIAwDQcC/Z2CQwW0dZNNX5r43HAECBAgQIECAAAECBAgQIPC1wPo6nXAECBAgQIAAAQIECBAgQIDAEzAAeAQCBAgQIECAAAECBAgQIBAQMAAEShaRAAECBAgQIECAAAECBAgYAPwAAQIECBAgQIAAAQIECBAICBgAAiWLSIAAAQIECBAgQIAAAQIEDAB+gAABAgQIECBAgAABAgQIBAQMAIGSRSRAgAABAgQIECBAgAABAgYAP0CAAAECBAgQIECAAAECBAICBoBAySISIECAAAECBAgQIECAAAEDgB8gQIAAAQIECBAgQIAAAQIBAQNAoGQRCRAgQIAAAQIECBAgQICAAcAPECBAgAABAgQIECBAgACBgIABIFCyiAQIECBAgAABAgQIECBAwADgBwgQIECAAAECBAgQIECAQEDAABAoWUQCBAgQIECAAAECBAgQIGAA8AMECBAgQIAAAQIECBAgQCAgYAAIlCwiAQIECBAgQIAAAQIECBAwAPgBAgQIECBAgAABAgQIECAQEDAABEoWkQABAgQIECBAgAABAgQIGAD8AAECBAgQIECAAAECBAgQCAgYAAIli0iAAAECBAgQIECAAAECBAwAfoAAAQIECBAgQIAAAQIECAQEDACBkkUkQIAAAQIECBAgQIAAAQIGAD9AgAABAgQIECBAgAABAgQCAgaAQMkiEiBAgAABAgQIECBAgAABA4AfIECAAAECBAgQIECAAAECAQEDQKBkEQkQIECAAAECBAgQIECAgAHADxAgQIAAAQIECBAgQIAAgYCAASBQsogECBAgQIAAAQIECBAgQMAA4AcIECBAgAABAgQIECBAgEBAwAAQKFlEAgQIECBAgAABAgQIECBgAPADBAgQIECAAAECBAgQIEAgIGAACJQsIgECBAgQIECAAAECBAgQMAD4AQIECBAgQIAAAQIECBAgEBAwAARKFpEAAQIECBAgQIAAAQIECBgA/AABAgQIECBAgAABAgQIEAgIGAACJYtIgAABAgQIECBAgAABAgQMAH6AAAECBAgQIECAAAECBAgEBAwAgZJFJECAAAECBAgQIECAAAECBgA/QIAAAQIECBAgQIAAAQIEAgIGgEDJIhIgQIAAAQIECBAgQIAAAQOAHyBAgAABAgQIECBAgAABAgEBA0CgZBEJECBAgAABAgQIECBAgIABwA8QIECAAAECBAgQIECAAIGAgAEgULKIBAgQIECAAAECBAgQIEDAAOAHCBAgQIAAAQIECBAgQIBAQMAAEChZRAIECBAgQIAAAQIECBAgYADwAwQIECBAgAABAgQIECBAICBgAAiULCIBAgQIECBAgAABAgQIEDAA+AECBAgQIECAAAECBAgQIBAQMAAEShaRAAECBAgQIECAAAECBAgYAPwAAQIECBAgQIAAAQIECBAICBgAAiWLSIAAAQIECBAgQIAAAQIEDAB+gAABAgQIECBAgAABAgQIBAQMAIGSRSRAgAABAgQIECBAgAABAgYAP0CAAAECBAgQIECAAAECBAICBoBAySISIECAAAECBAgQIECAAAEDgB8gQIAAAQIECBAgQIAAAQIBAQNAoGQRCRAgQIAAAQIECBAgQICAAcAPECBAgAABAgQIECBAgACBgIABIFCyiAQIECBAgAABAgQIECBAwADgBwgQIECAAAECBAgQIECAQEDAABAoWUQCBAgQIECAAAECBAgQIGAA8AMECBAgQIAAAQIECBAgQCAgYAAIlCwiAQIECBAgQIAAAQIECBAwAPgBAgQIECBAgAABAgQIECAQEDAABEoWkQABAgQIECBAgAABAgQIGAD8AAECBAgQIECAAAECBAgQCAgYAAIli0iAAAECBAgQIECAAAECBAwAfoAAAQIECBAgQIAAAQIECAQEDACBkkUkQIAAAQIECBAgQIAAAQIGAD9AgAABAgQIECBAgAABAgQCAgaAQMkiEiBAgAABAgQIECBAgAABA4AfIECAAAECBAgQIECAAAECAQEDQKBkEQkQIECAAAECBAgQIECAgAHADxAgQIAAAQIECBAgQIAAgYCAASBQsogECBAgQIAAAQIECBAgQMAA4AcIECBAgAABAgQIECBAgEBAwAAQKFlEAgQIECBAgAABAgQIECBgAPADBAgQIECAAAECBAgQIEAgIGAACJQsIgECBAgQIECAAAECBAgQMAD4AQIECBAgQIAAAQIECBAgEBAwAARKFpEAAQIECBAgQIAAAQIECBgA/AABAgQIECBAgAABAgQIEAgIGAACJYtIgAABAgQIECBAgAABAgQMAH6AAAECBAgQIECAAAECBAgEBAwAgZJFJECAAAECBAgQIECAAAECBgA/QIAAAQIECBAgQIAAAQIEAgIGgEDJIhIgQIAAAQIECBAgQIAAAQOAHyBAgAABAgQIECBAgAABAgEBA0CgZBEJECBAgAABAgQIECBAgIABwA8QIECAAAECBAgQIECAAIGAgAEgULKIBAgQIECAAAECBAgQIEDAAOAHCBAgQIAAAQIECBAgQIBAQMAAEChZRAIECBAgQIAAAQIECBAgYADwAwQIECBAgAABAgQIECBAICBgAAiULCIBAgQIECBAgAABAgQIEDAA+AECBAgQIECAAAECBAgQIBAQMAAEShaRAAECBAgQIECAAAECBAgYAPwAAQIECBAgQIAAAQIECBAICBgAAiWLSIAAAQIECBAgQIAAAQIEDAB+gAABAgQIECBAgAABAgQIBAQMAIGSRSRAgAABAgQIECBAgAABAgYAP0CAAAECBAgQIECAAAECBAICBoBAySISIECAAAECBAgQIECAAAEDgB8gQIAAAQIECBAgQIAAAQIBAQNAoGQRCRAgQIAAAQIECBAgQICAAcAPECBAgAABAgQIECBAgACBgIABIFCyiAQIECBAgAABAgQIECBAwADgBwgQIECAAAECBAgQIECAQEDAABAoWUQCBAgQIECAAAECBAgQIGAA8AMECBAgQIAAAQIECBAgQCAgYAAIlCwiAQIECBAgQIAAAQIECBAwAPgBAgQIECBAgAABAgQIECAQEDAABEoWkQABAgQIECBAgAABAgQIGAD8AAECBAgQIECAAAECBAgQCAgYAAIli0iAAAECBAgQIECAAAECBAwAfoAAAQIECBAgQIAAAQIECAQEDACBkkUkQIAAAQIECBAgQIAAAQIGAD9AgAABAgQIECBAgAABAgQCAgaAQMkiEiBAgAABAgQIECBAgAABA4AfIECAAAECBAgQIECAAAECAQEDQKBkEQkQIECAAAECBAgQIECAgAHADxAgQIAAAQIECBAgQIAAgYCAASBQsogECBAgQIAAAQIECBAgQMAA4AcIECBAgAABAgQIECBAgEBAwAAQKFlEAgQIECBAgAABAgQIECBgAPADBAgQIECAAAECBAgQIEAgIGAACJQsIgECBAgQIECAAAECBAgQMAD4AQIECBAgQIAAAQIECBAgEBAwAARKFpEAAQIECBAgQIAAAQIECBgA/AABAgQIECBAgAABAgQIEAgIGAACJYtIgAABAgQIECBAgAABAgQMAH6AAAECBAgQIECAAAECBAgEBAwAgZJFJECAAAECBAgQIECAAAECBgA/QIAAAQIECBAgQIAAAQIEAgIGgEDJIhIgQIAAAQIECBAgQIAAAQOAHyBAgAABAgQIECBAgAABAgEBA0CgZBEJECBAgAABAgQIECBAgIABwA8QIECAAAECBAgQIECAAIGAgAEgULKIBAgQIECAAAECBAgQIEDAAOAHCBAgQIAAAQIECBAgQIBAQMAAEChZRAIECBAgQIAAAQIECBAgYADwAwQIECBAgAABAgQIECBAICBgAAiULCIBAgQIECBAgAABAgQIEDAA+AECBAgQIECAAAECBAgQIBAQMAAEShaRAAECBAgQIECAAAECBAgYAPwAAQIECBAgQIAAAQIECBAICBgAAiWLSIAAAQIECBAgQIAAAQIEDAB+gAABAgQIECBAgAABAgQIBAQMAIGSRSRAgAABAgQIECBAgAABAgYAP0CAAAECBAgQIECAAAECBAICBoBAySISIECAAAECBAgQIECAAAEDgB8gQIAAAQIECBAgQIAAAQIBAQNAoGQRCRAgQIAAAQIECBAgQICAAcAPECBAgAABAgQIECBAgACBgIABIFCyiAQIECBAgAABAgQIECBAwADgBwgQIECAAAECBAgQIECAQEDAABAoWUQCBAgQIECAAAECBAgQIGAA8AMECBAgQIAAAQIECBAgQCAgYAAIlCwiAQIECBAgQIAAAQIECBAwAPgBAgQIECBAgAABAgQIECAQEDAABEoWkQABAgQIECBAgAABAgQIGAD8AAECBAgQIECAAAECBAgQCAgYAAIli0iAAAECBAgQIECAAAECBAwAfoAAAQIECBAgQIAAAQIECAQEDACBkkUkQIAAAQIECBAgQIAAAQIGAD9AgAABAgQIECBAgAABAgQCAgaAQMkiEiBAgAABAgQIECBAgAABA4AfIECAAAECBAgQIECAAAECAQEDQKBkEQkQIECAAAECBAgQIECAgAHADxAgQIAAAQIECBAgQIAAgYCAASBQsogECBAgQIAAAQIECBAgQMAA4AcIECBAgAABAgQIECBAgEBAwAAQKFlEAgQIECBAgAABAgQIECBgAPADBAgQIECAAAECBAgQIEAgIGAACJQsIgECBAgQIECAAAECBAgQMAD4AQIECBAgQIAAAQIECBAgEBAwAARKFpEAAQIECBAgQIAAAQIECBgA/AABAgQIECBAgAABAgQIEAgIGAACJYtIgAABAgQIECBAgAABAgQMAH6AAAECBAgQIECAAAECBAgEBAwAgZJFJECAAAECBAgQIECAAAECBgA/QIAAAQIECBAgQIAAAQIEAgIGgEDJIhIgQIAAAQIECBAgQIAAAQOAHyBAgAABAgQIECBAgAABAgEBA0CgZBEJECBAgAABAgQIECBAgIABwA8QIECAAAECBAgQIECAAIGAgAEgULKIBAgQIECAAAECBAgQIEDAAOAHCBAgQIAAAQIECBAgQIBAQMAAEChZRAIECBAgQIAAAQIECBAgYADwAwQIECBAgAABAgQIECBAICBgAAiULCIBAgQIECBAgAABAgQIEDAA+AECBAgQIECAAAECBAgQIBAQMAAEShaRAAECBAgQIECAAAECBAgYAPwAAQIECBAgQIAAAQIECBAICBgAAiWLSIAAAQIECBAgQIAAAQIEDAB+gAABAgQIECBAgAABAgQIBAQMAIGSRSRAgAABAgQIECBAgAABAgYAP0CAAAECBAgQIECAAAECBAICBoBAySISIECAAAECBAgQIECAAAEDgB8gQIAAAQIECBAgQIAAAQIBAQNAoGQRCRAgQIAAAQIECBAgQICAAcAPECBAgAABAgQIECBAgACBgIABIFCyiAQIECBAgAABAgQIECBAwADgBwgQIECAAAECBAgQIECAQEDAABAoWUQCBAgQIECAAAECBAgQIGAA8AMECBAgQIAAAQIECBAgQCAgYAAIlCwiAQIECBAgQIAAAQIECBAwAPgBAgQIECBAgAABAgQIECAQEDAABEoWkQABAgQIECBAgAABAgQIGAD8AAECBAgQIECAAAECBAgQCAgYAAIli0iAAAECBAgQIECAAAECBAwAfoAAAQIECBAgQIAAAQIECAQEDACBkkUkQIAAAQIECBAgQIAAAQIGAD9AgAABAgQIECBAgAABAgQCAgaAQMkiEiBAgAABAgQIECBAgAABA4AfIECAAAECBAgQIECAAAECAQEDQKBkEQkQIECAAAECBAgQIECAgAHADxAgQIAAAQIECBAgQIAAgYCAASBQsogECBAgQIAAAQIECBAgQMAA4AcIECBAgAABAgQIECBAgEBAwAAQKFlEAgQIECBAgAABAgQIECBgAPADBAgQIECAAAECBAgQIEAgIGAACJQsIgECBAgQIECAAAECBAgQMAD4AQIECBAgQIAAAQIECBAgEBAwAARKFpEAAQIECBAgQIAAAQIECBgA/AABAgQIECBAgAABAgQIEAgIGAACJYtIgAABAgQIECBAgAABAgQMAH6AAAECBAgQIECAAAECBAgEBAwAgZJFJECAAAECBAgQIECAAAECBgA/QIAAAQIECBAgQIAAAQIEAgIGgEDJIhIgQIAAAQIECBAgQIAAAQOAHyBAgAABAgQIECBAgAABAgEBA0CgZBEJECBAgAABAgQIECBAgIABwA8QIECAAAECBAgQIECAAIGAgAEgULKIBAgQIECAAAECBAgQIEDAAOAHCBAgQIAAAQIECBAgQIBAQMAAEChZRAIECBAgQIAAAQIECBAgYADwAwQIECBAgAABAgQIECBAICBgAAiULCIBAgQIECBAgAABAgQIEDAA+AECBAgQIECAAAECBAgQIBAQMAAEShaRAAECBAgQIECAAAECBAgYAPwAAQIECBAgQIAAAQIECBAICBgAAiWLSIAAAQIECBAgQIAAAQIEDAB+gAABAgQIECBAgAABAgQIBAQMAIGSRSRAgAABAgQIECBAgAABAgYAP0CAAAECBAgQIECAAAECBAICBoBAySISIECAAAECBAgQIECAAAEDgB8gQIAAAQIECBAgQIAAAQIBAQNAoGQRCRAgQIAAAQIECBAgQICAAcAPECBAgAABAgQIECBAgACBgIABIFCyiAQIECBAgAABAgQIECBAwADgBwgQIECAAAECBAgQIECAQEDAABAoWUQCBAgQIECAAAECBAgQIGAA8AMECBAgQIAAAQIECBAgQCAgYAAIlCwiAQIECBAgQIAAAQIECBAwAPgBAgQIECBAgAABAgQIECAQEDAABEoWkQABAgQIECBAgAABAgQIGAD8AAECBAgQIECAAAECBAgQCAgYAAIli0iAAAECBAgQIECAAAECBAwAfoAAAQIECBAgQIAAAQIECAQEDACBkkUkQIAAAQIECBAgQIAAAQIGAD9AgAABAgQIECBAgAABAgQCAgaAQMkiEiBAgAABAgQIECBAgAABA4AfIECAAAECBAgQIECAAAECAQEDQKBkEQkQIECAAAECBAgQIECAgAHADxAgQIAAAQIECBAgQIAAgYCAASBQsogECBAgQIAAAQIECBAgQMAA4AcIECBAgAABAgQIECBAgEBAwAAQKFlEAgQIECBAgAABAgQIECBgAPADBAgQIECAAAECBAgQIEAgIGAACJQsIgECBAgQIECAAAECBAgQMAD4AQIECBAgQIAAAQIECBAgEBAwAARKFpEAAQIECBAgQIAAAQIECBgA/AABAgQIECBAgAABAgQIEAgIGAACJYtIgAABAgQIECBAgAABAgQMAH6AAAECBAgQIECAAAECBAgEBAwAgZJFJECAAAECBAgQIECAAAECBgA/QIAAAQIECBAgQIAAAQIEAgIGgEDJIhIgQIAAAQIECBAgQIAAAQOAHyBAgAABAgQIECBAgAABAgEBA0CgZBEJECBAgAABAgQIECBAgIABwA8QIECAAAECBAgQIECAAIGAgAEgULKIBAgQIECAAAECBAgQIEDAAOAHCBAgQIAAAQIECBAgQIBAQMAAEChZRAIECBAgQIAAAQIECBAgYADwAwQIECBAgAABAgQIECBAICBgAAiULCIBAgQIECBAgAABAgQIEDAA+AECBAgQIECAAAECBAgQIBAQMAAEShaRAAECBAgQIECAAAECBAgYAPwAAQIECBAgQIAAAQIECBAICBgAAiWLSIAAAQIECBAgQIAAAQIEDAB+gAABAgQIECBAgAABAgQIBAQMAIGSRSRAgAABAgQIECBAgAABAgYAP0CAAAECBAgQIECAAAECBAICBoBAySISIECAAAECBAgQIECAAAEDgB8gQIAAAQIECBAgQIAAAQIBAQNAoGQRCRAgQIAAAQIECBAgQICAAcAPECBAgAABAgQIECBAgACBgIABIFCyiAQIECBAgAABAgQIECBAwADgBwgQIECAAAECBAgQIECAQEDAABAoWUQCBAgQIECAAAECBAgQIGAA8AMECBAgQIAAAQIECBAgQCAgYAAIlCwiAQIECBAgQIAAAQIECBAwAPgBAgQIECBAgAABAgQIECAQEDAABEoWkQABAgQIECBAgAABAgQIGAD8AAECBAgQIECAAAECBAgQCAgYAAIli0iAAAECBAgQIECAAAECBAwAfoAAAQIECBAgQIAAAQIECAQEDACBkkUkQIAAAQIECBAgQIAAAQIGAD9AgAABAgQIECBAgAABAgQCAgaAQMkiEiBAgAABAgQIECBAgAABA4AfIECAAAECBAgQIECAAAECAQEDQKBkEQkQIECAAAECBAgQIECAgAHADxAgQIAAAQIECBAgQIAAgYCAASBQsogECBAgQIAAAQIECBAgQMAA4AcIECBAgAABAgQIECBAgEBAwAAQKFlEAgQIECBAgAABAgQIECBgAPADBAgQIECAAAECBAgQIEAgIGAACJQsIgECBAgQIECAAAECBAgQMAD4AQIECBAgQIAAAQIECBAgEBAwAARKFpEAAQIECBAgQIAAAQIECBgA/AABAgQIECBAgAABAgQIEAgIGAACJYtIgAABAgQIECBAgAABAgQMAH6AAAECBAgQIECAAAECBAgEBAwAgZJFJECAAAECBAgQIECAAAECBgA/QIAAAQIECBAgQIAAAQIEAgIGgEDJIhIgQIAAAQIECBAgQIAAAQOAHyBAgAABAgQIECBAgAABAgEBA0CgZBEJECBAgAABAgQIECBAgIABwA8QIECAAAECBAgQIECAAIGAgAEgULKIBAgQIECAAAECBAgQIEDAAOAHCBAgQIAAAQIECBAgQIBAQMAAEChZRAIECBAgQIAAAQIECBAgYADwAwQIECBAgAABAgQIECBAICBgAAiULCIBAgQIECBAgAABAgQIEDAA+AECBAgQIECAAAECBAgQIBAQMAAEShaRAAECBAgQIECAAAECBAgYAPwAAQIECBAgQIAAAQIECBAICBgAAiWLSIAAAQIECBAgQIAAAQIEDAB+gAABAgQIECBAgAABAgQIBAQMAIGSRSRAgAABAgQIECBAgAABAgYAP0CAAAECBAgQIECAAAECBAICBoBAySISIECAAAECBAgQIECAAAEDgB8gQIAAAQIECBAgQIAAAQIBAQNAoGQRCRAgQIAAAQIECBAgQICAAcAPECBAgAABAgQIECBAgACBgIABIFCyiAQIECBAgAABAgQIECBAwADgBwgQIECAAAECBAgQIECAQEDAABAoWUQCBAgQIECAAAECBAgQIGAA8AMECBAgQIAAAQIECBAgQCAgYAAIlCwiAQIECBAgQIAAAQIECBAwAPgBAgQIECBAgAABAgQIECAQEDAABEoWkQABAgQIECBAgAABAgQIGAD8AAECBAgQIECAAAECBAgQCAgYAAIli0iAAAECBAgQIECAAAECBAwAfoAAAQIECBAgQIAAAQIECAQEDACBkkUkQIAAAQIECBAgQIAAAQIGAD9AgAABAgQIECBAgAABAgQCAgaAQMkiEiBAgAABAgQIECBAgAABA4AfIECAAAECBAgQIECAAAECAQEDQKBkEQkQIECAAAECBAgQIECAgAHADxAgQIAAAQIECBAgQIAAgYCAASBQsogECBAgQIAAAQIECBAgQMAA4AcIECBAgAABAgQIECBAgEBAwAAQKFlEAgQIECBAgAABAgQIECBgAPADBAgQIECAAAECBAgQIEAgIGAACJQsIgECBAgQIECAAAECBAgQMAD4AQIECBAgQIAAAQIECBAgEBAwAARKFpEAAQIECBAgQIAAAQIECBgA/AABAgQIECBAgAABAgQIEAgIGAACJYtIgAABAgQIECBAgAABAgQMAH6AAAECBAgQIECAAAECBAgEBAwAgZJFJECAAAECBAgQIECAAAECBgA/QIAAAQIECBAgQIAAAQIEAgIGgEDJIhIgQIAAAQIECBAgQIAAAQOAHyBAgAABAgQIECBAgAABAgEBA0CgZBEJECBAgAABAgQIECBAgIABwA8QIECAAAECBAgQIECAAIGAgAEgULKIBAgQIECAAAECBAgQIEDAAOAHCBAgQIAAAQIECBAgQIBAQMAAEChZRAIECBAgQIAAAQIECBAgYADwAwQIECBAgAABAgQIECBAICBgAAiULCIBAgQIECBAgAABAgQIEDAA+AECBAgQIECAAAECBAgQIBAQMAAEShaRAAECBAgQIECAAAECBAgYAPwAAQIECBAgQIAAAQIECBAICBgAAiWLSIAAAQIECBAgQIAAAQIEDAB+gAABAgQIECBAgAABAgQIBAQMAIGSRSRAgAABAgQIECBAgAABAgYAP0CAAAECBAgQIECAAAECBAICBoBAySISIECAAAECBAgQIECAAAEDgB8gQIAAAQIECBAgQIAAAQIBAQNAoGQRCRAgQIAAAQIECBAgQICAAcAPECBAgAABAgQIECBAgACBgIABIFCyiAQIECBAgAABAgQIECBAwADgBwgQIECAAAECBAgQIECAQEDAABAoWUQCBAgQIECAAAECBAgQIGAA8AMECBAgQIAAAQIECBAgQCAgYAAIlCwiAQIECBAgQIAAAQIECBAwAPgBAgQIECBAgAABAgQIECAQEDAABEoWkQABAgQIECBAgAABAgQIGAD8AAECBAgQIECAAAECBAgQCAgYAAIli0iAAAECBAgQIECAAAECBAwAfoAAAQIECBAgQIAAAQIECAQEDACBkkUkQIAAAQIECBAgQIAAAQIGAD9AgAABAgQIECBAgAABAgQCAgaAQMkiEiBAgAABAvxMergAACAASURBVAQIECBAgAABA4AfIECAAAECBAgQIECAAAECAQEDQKBkEQkQIECAAAECBAgQIECAgAHADxAgQIAAAQIECBAgQIAAgYCAASBQsogECBAgQIAAAQIECBAgQMAA4AcIECBAgAABAgQIECBAgEBAwAAQKFlEAgQIECBAgAABAgQIECBgAPADBAgQIECAAAECBAgQIEAgIGAACJQsIgECBAgQIECAAAECBAgQMAD4AQIECBAgQIAAAQIECBAgEBAwAARKFpEAAQIECBAgQIAAAQIECBgA/AABAgQIECBAgAABAgQIEAgIGAACJYtIgAABAgQIECBAgAABAgQMAH6AAAECBAgQIECAAAECBAgEBAwAgZJFJECAAAECBAgQIECAAAECBgA/QIAAAQIECBAgQIAAAQIEAgIGgEDJIhIgQIAAAQIECBAgQIAAAQOAHyBAgAABAgQIECBAgAABAgEBA0CgZBEJECBAgAABAgQIECBAgIABwA8QIECAAAECBAgQIECAAIGAgAEgULKIBAgQIECAAAECBAgQIEDAAOAHCBAgQIAAAQIECBAgQIBAQMAAEChZRAIECBAgQIAAAQIECBAgYADwAwQIECBAgAABAgQIECBAICBgAAiULCIBAgQIECBAgAABAgQIEDAA+AECBAgQIECAAAECBAgQIBAQMAAEShaRAAECBAgQIECAAAECBAgYAPwAAQIECBAgQIAAAQIECBAICBgAAiWLSIAAAQIECBAgQIAAAQIEDAB+gAABAgQIECBAgAABAgQIBAQMAIGSRSRAgAABAgQIECBAgAABAgYAP0CAAAECBAgQIECAAAECBAICBoBAySISIECAAAECBAgQIECAAAEDgB8gQIAAAQIECBAgQIAAAQIBAQNAoGQRCRAgQIAAAQIECBAgQICAAcAPECBAgAABAgQIECBAgACBgIABIFCyiAQIECBAgAABAgQIECBAwADgBwgQIECAAAECBAgQIECAQEDAABAoWUQCBAgQIECAAAECBAgQIGAA8AMECBAgQIAAAQIECBAgQCAgYAAIlCwiAQIECBAgQIAAAQIECBAwAPgBAgQIECBAgAABAgQIECAQEDAABEoWkQABAgQIECBAgAABAgQIGAD8AAECBAgQIECAAAECBAgQCAgYAAIli0iAAAECBAgQIECAAAECBAwAfoAAAQIECBAgQIAAAQIECAQEDACBkkUkQIAAAQIECBAgQIAAAQIGAD9AgAABAgQIECBAgAABAgQCAgaAQMkiEiBAgAABAgQIECBAgAABA4AfIECAAAECBAgQIECAAAECAQEDQKBkEQkQIECAAAECBAgQIECAgAHADxAgQIAAAQIECBAgQIAAgYCAASBQsogECBAgQIAAAQIECBAgQMAA4AcIECBAgAABAgQIECBAgEBAwAAQKFlEAgQIECBAgAABAgQIECBgAPADBAgQIECAAAECBAgQIEAgIGAACJQsIgECBAgQIECAAAECBAgQMAD4AQIECBAgQIAAAQIECBAgEBAwAARKFpEAAQIECBAgQIAAAQIECBgA/AABAgQIECBAgAABAgQIEAgIGAACJYtIgAABAgQIECBAgAABAgQMAH6AAAECBAgQIECAAAECBAgEBAwAgZJFJECAAAECBAgQIECAAAECBgA/QIAAAQIECBAgQIAAAQIEAgIGgEDJIhIgQIAAAQIECBAgQIAAAQOAHyBAgAABAgQIECBAgAABAgEBA0CgZBEJECBAgAABAgQIECBAgIABwA8QIECAAAECBAgQIECAAIGAgAEgULKIBAgQIECAAAECBAgQIEDAAOAHCBAgQIAAAQIECBAgQIBAQMAAEChZRAIECBAgQIAAAQIECBAgYADwAwQIECBAgAABAgQIECBAICBgAAiULCIBAgQIECBAgAABAgQIEDAA+AECBAgQIECAAAECBAgQIBAQMAAEShaRAAECBAgQIECAAAECBAgYAPwAAQIECBAgQIAAAQIECBAICBgAAiWLSIAAAQIECBAgQIAAAQIEDAB+gAABAgQIECBAgAABAgQIBAQMAIGSRSRAgAABAgQIECBAgAABAgYAP0CAAAECBAgQIECAAAECBAICBoBAySISIECAAAECBAgQIECAAAEDgB8gQIAAAQIECBAgQIAAAQIBAQNAoGQRCRAgQIAAAQIECBAgQICAAcAPECBAgAABAgQIECBAgACBgIABIFCyiAQIECBAgAABAgQIECBAwADgBwgQIECAAAECBAgQIECAQEDAABAoWUQCBAgQIECAAAECBAgQIGAA8AMECBAgQIAAAQIECBAgQCAgYAAIlCwiAQIECBAgQIAAAQIECBAwAPgBAgQIECBAgAABAgQIECAQEDAABEoWkQABAgQIECBAgAABAgQIGAD8AAECBAgQIECAAAECBAgQCAgYAAIli0iAAAECBAgQIECAAAECBAwAfoAAAQIECBAgQIAAAQIECAQEDACBkkUkQIAAAQIECBAgQIAAAQIGAD9AgAABAgQIECBAgAABAgQCAgaAQMkiEiBAgAABAgQIECBAgAABA4AfIECAAAECBAgQIECAAAECAQEDQKBkEQkQIECAAAECBAgQIECAgAHADxAgQIAAAQIECBAgQIAAgYCAASBQsogECBAgQIAAAQIECBAgQMAA4AcIECBAgAABAgQIECBAgEBAwAAQKFlEAgQIECBAgAABAgQIECBgAPADBAgQIECAAAECBAgQIEAgIGAACJQsIgECBAgQIECAAAECBAgQMAD4AQIECBAgQIAAAQIECBAgEBAwAARKFpEAAQIECBAgQIAAAQIECBgA/AABAgQIECBAgAABAgQIEAgIGAACJYtIgAABAgQIECBAgAABAgQMAH6AAAECBAgQIECAAAECBAgEBAwAgZJFJECAAAECBAgQIECAAAECBgA/QIAAAQIECBAgQIAAAQIEAgIGgEDJIhIgQIAAAQIECBAgQIAAAQOAHyBAgAABAgQIECBAgAABAgEBA0CgZBEJECBAgAABAgQIECBAgIABwA8QIECAAAECBAgQIECAAIGAgAEgULKIBAgQIECAAAECBAgQIEDAAOAHCBAgQIAAAQIECBAgQIBAQMAAEChZRAIECBAgQIAAAQIECBAgYADwAwQIECBAgAABAgQIECBAICBgAAiULCIBAgQIECBAgAABAgQIEDAA+AECBAgQIECAAAECBAgQIBAQMAAEShaRAAECBAgQIECAAAECBAgYAPwAAQIECBAgQIAAAQIECBAICBgAAiWLSIAAAQIECBAgQIAAAQIEDAB+gAABAgQIECBAgAABAgQIBAQMAIGSRSRAgAABAgQIECBAgAABAgYAP0CAAAECBAgQIECAAAECBAICBoBAySISIECAAAECBAgQIECAAAEDgB8gQIAAAQIECBAgQIAAAQIBAQNAoGQRCRAgQIAAAQIECBAgQICAAcAPECBAgAABAgQIECBAgACBgIABIFCyiAQIECBAgAABAgQIECBAwADgBwgQIECAAAECBAgQIECAQEDAABAoWUQCBAgQIECAAAECBAgQIGAA8AMECBAgQIAAAQIECBAgQCAgYAAIlCwiAQIECBAgQIAAAQIECBAwAPgBAgQIECBAgAABAgQIECAQEDAABEoWkQABAgQIECBAgAABAgQIGAD8AAECBAgQIECAAAECBAgQCAgYAAIli0iAAAECBAgQIECAAAECBAwAfoAAAQIECBAgQIAAAQIECAQEDACBkkUkQIAAAQIECBAgQIAAAQIGAD9AgAABAgQIECBAgAABAgQCAgaAQMkiEiBAgAABAgQIECBAgAABA4AfIECAAAECBAgQIECAAAECAQEDQKBkEQkQIECAAAECBAgQIECAgAHADxAgQIAAAQIECBAgQIAAgYCAASBQsogECBAgQIAAAQIECBAgQMAA4AcIECBAgAABAgQIECBAgEBAwAAQKFlEAgQIECBAgAABAgQIECBgAPADBAgQIECAAAECBAgQIEAgIGAACJQsIgECBAgQIECAAAECBAgQMAD4AQIECBAgQIAAAQIECBAgEBAwAARKFpEAAQIECBAgQIAAAQIECBgA/AABAgQIECBAgAABAgQIEAgIGAACJYtIgAABAgQIECBAgAABAgQMAH6AAAECBAgQIECAAAECBAgEBAwAgZJFJECAAAECBAgQIECAAAECBgA/QIAAAQIECBAgQIAAAQIEAgIGgEDJIhIgQIAAAQIECBAgQIAAAQOAHyBAgAABAgQIECBAgAABAgEBA0CgZBEJECBAgAABAgQIECBAgIABwA8QIECAAAECBAgQIECAAIGAgAEgULKIBAgQIECAAAECBAgQIEDAAOAHCBAgQIAAAQIECBAgQIBAQMAAEChZRAIECBAgQIAAAQIECBAgYADwAwQIECBAgAABAgQIECBAICBgAAiULCIBAgQIECBAgAABAgQIEDAA+AECBAgQIECAAAECBAgQIBAQMAAEShaRAAECBAgQIECAAAECBAgYAPwAAQIECBAgQIAAAQIECBAICBgAAiWLSIAAAQIECBAgQIAAAQIEDAB+gAABAgQIECBAgAABAgQIBAQMAIGSRSRAgAABAgQIECBAgAABAgYAP0CAAAECBAgQIECAAAECBAICBoBAySISIECAAAECBAgQIECAAAEDgB8gQIAAAQIECBAgQIAAAQIBAQNAoGQRCRAgQIAAAQIECBAgQICAAcAPECBAgAABAgQIECBAgACBgIABIFCyiAQIECBAgAABAgQIECBAwADgBwgQIECAAAECBAgQIECAQEDAABAoWUQCBAgQIECAAAECBAgQIGAA8AMECBAgQIAAAQIECBAgQCAgYAAIlCwiAQIECBAgQIAAAQIECBAwAPgBAgQIECBAgAABAgQIECAQEDAABEoWkQABAgQIECBAgAABAgQIGAD8AAECBAgQIECAAAECBAgQCAgYAAIli0iAAAECBAgQIECAAAECBAwAfoAAAQIECBAgQIAAAQIECAQEDACBkkUkQIAAAQIECBAgQIAAAQIGAD9AgAABAgQIECBAgAABAgQCAgaAQMkiEiBAgAABAgQIECBAgAABA4AfIECAAAECBAgQIECAAAECAQEDQKBkEQkQIECAAAECBAgQIECAgAHADxAgQIAAAQIECBAgQIAAgYCAASBQsogECBAgQIAAAQIECBAgQMAA4AcIECBAgAABAgQIECBAgEBAwAAQKFlEAgQIECBAgAABAgQIECBgAPADBAgQIECAAAECBAgQIEAgIGAACJQsIgECBAgQIECAAAECBAgQMAD4AQIECBAgQIAAAQIECBAgEBAwAARKFpEAAQIECBAgQIAAAQIECBgA/AABAgQIECBAgAABAgQIEAgIGAACJYtIgAABAgQIECBAgAABAgQMAH6AAAECBAgQIECAAAECBAgEBAwAgZJFJECAAAECBAgQIECAAAECBgA/QIAAAQIECBAgQIAAAQIEAgIGgEDJIhIgQIAAAQIECBAgQIAAAQOAHyBAgAABAgQIECBAgAABAgEBA0CgZBEJECBAgAABAgQIECBAgIABwA8QIECAAAECBAgQIECAAIGAgAEgULKIBAgQIECAAAECBAgQIEDAAOAHCBAgQIAAAQIECBAgQIBAQMAAEChZRAIECBAgQIAAAQIECBAgYADwAwQIECBAgAABAgQIECBAICBgAAiULCIBAgQIECBAgAABAgQIEDAA+AECBAgQIECAAAECBAgQIBAQMAAEShaRAAECBAgQIECAAAECBAgYAPwAAQIECBAgQIAAAQIECBAICBgAAiWLSIAAAQIECBAgQIAAAQIEDAB+gAABAgQIECBAgAABAgQIBAQMAIGSRSRAgAABAgQIECBAgAABAgYAP0CAAAECBAgQIECAAAECBAICBoBAySISIECAAAECBAgQIECAAAEDgB8gQIAAAQIECBAgQIAAAQIBAQNAoGQRCRAgQIAAAQIECBAgQICAAcAPECBAgAABAgQIECBAgACBgIABIFCyiAQIECBAgAABAgQIECBAwADgBwgQIECAAAECBAgQIECAQEDAABAoWUQCBAgQIECAAAECBAgQIGAA8AMECBAgQIAAAQIECBAgQCAgYAAIlCwiAQIECBAgQIAAAQIECBAwAPgBAgQIECBAgAABAgQIECAQEDAABEoWkQABAgQIECBAgAABAgQIGAD8AAECBAgQIECAAAECBAgQCAgYAAIli0iAAAECBAgQIECAAAECBAwAfoAAAQIECBAgQIAAAQIECAQEDACBkkUkQIAAAQIECBAgQIAAAQIGAD9AgAABAgQIECBAgAABAgQCAgaAQMkiEiBAgAABAgQIECBAgAABA4AfIECAAAECBAgQIECAAAECAQEDQKBkEQkQIECAAAECBAgQIECAgAHADxAgQIAAAQIECBAgQIAAgYCAASBQsogECBAgQIAAAQIECBAgQMAA4AcIECBAgAABAgQIECBAgEBAwAAQKFlEAgQIECBAgAABAgQIECBgAPADBAgQIECAAAECBAgQIEAgIGAACJQsIgECBAgQIECAAAECBAgQMAD4AQIECBAgQIAAAQIECBAgEBAwAARKFpEAAQIECBAgQIAAAQIECBgA/AABAgQIECBAgAABAgQIEAgIGAACJYtIgAABAgQIECBAgAABAgQMAH6AAAECBAgQIECAAAECBAgEBAwAgZJFJECAAAECBAgQIECAAAECBgA/QIAAAQIECBAgQIAAAQIEAgIGgEDJIhIgQIAAAQIECBAgQIAAAQOAHyBAgAABAgQIECBAgAABAgEBA0CgZBEJECBAgAABAgQIECBAgIABwA8QIECAAAECBAgQIECAAIGAgAEgULKIBAgQIECAAAECBAgQIEDAAOAHCBAgQIAAAQIECBAgQIBAQMAAEChZRAIECBAgQIAAAQIECBAgYADwAwQIECBAgAABAgQIECBAICBgAAiULCIBAgQIECBAgAABAgQIEDAA+AECBAgQIECAAAECBAgQIBAQMAAEShaRAAECBAgQIECAAAECBAgYAPwAAQIECBAgQIAAAQIECBAICBgAAiWLSIAAAQIECBAgQIAAAQIEDAB+gAABAgQIECBAgAABAgQIBAQMAIGSRSRAgAABAgQIECBAgAABAgYAP0CAAAECBAgQIECAAAECBAICBoBAySISIECAAAECBAgQIECAAAEDgB8gQIAAAQIECBAgQIAAAQIBAQNAoGQRCRAgQIAAAQIECBAgQICAAcAPECBAgAABAgQIECBAgACBgIABIFCyiAQIECBAgAABAgQIECBAwADgBwgQIECAAAECBAgQIECAQEDAABAoWUQCBAgQIECAAAECBAgQIGAA8AMECBAgQIAAAQIECBAgQCAgYAAIlCwiAQIECBAgQIAAAQIECBAwAPgBAgQIECBAgAABAgQIECAQEDAABEoWkQABAgQIECBAgAABAgQIGAD8AAECBAgQIECAAAECBAgQCAgYAAIli0iAAAECBAgQIECAAAECBAwAfoAAAQIECBAgQIAAAQIECAQEDACBkkUkQIAAAQIECBAgQIAAAQIGAD9AgAABAgQIECBAgAABAgQCAgaAQMkiEiBAgAABAgQIECBAgAABA4AfIECAAAECBAgQIECAAAECAQEDQKBkEQkQIECAAAECBAgQIECAgAHADxAgQIAAAQIECBAgQIAAgYCAASBQsogECBAgQIAAAQIECBAgQMAA4AcIECBAgAABAgQIECBAgEBAwAAQKFlEAgQIECBAgAABAgQIECBgAPADBAgQIECAAAECBAgQIEAgIGAACJQsIgECBAgQIECAAAECBAgQMAD4AQIECBAgQIAAAQIECBAgEBAwAARKFpEAAQIECBAgQIAAAQIECBgA/AABAgQIECBAgAABAgQIEAgIGAACJYtIgAABAgQIECBAgAABAgQMAH6AAAECBAgQIECAAAECBAgEBAwAgZJFJECAAAECBAgQIECAAAECBgA/QIAAAQIECBAgQIAAAQIEAgIGgEDJIhIgQIAAAQIECBAgQIAAAQOAHyBAgAABAgQIECBAgAABAgEBA0CgZBEJECBAgAABAgQIECBAgIABwA8QIECAAAECBAgQIECAAIGAgAEgULKIBAgQIECAAAECBAgQIEDAAOAHCBAgQIAAAQIECBAgQIBAQMAAEChZRAIECBAgQIAAAQIECBAgYADwAwQIECBAgAABAgQIECBAICBgAAiULCIBAgQIECBAgAABAgQIEDAA+AECBAgQIECAAAECBAgQIBAQMAAEShaRAAECBAgQIECAAAECBAgYAPwAAQIECBAgQIAAAQIECBAICBgAAiWLSIAAAQIECBAgQIAAAQIEDAB+gAABAgQIECBAgAABAgQIBAQMAIGSRSRAgAABAgQIECBAgAABAgYAP0CAAAECBAgQIECAAAECBAICBoBAySISIECAAAECBAgQIECAAAEDgB8gQIAAAQIECBAgQIAAAQIBAQNAoGQRCRAgQIAAAQIECBAgQICAAcAPECBAgAABAgQIECBAgACBgIABIFCyiAQIECBAgAABAgQIECBAwADgBwgQIECAAAECBAgQIECAQEDAABAoWUQCBAgQIECAAAECBAgQIGAA8AMECBAgQIAAAQIECBAgQCAgYAAIlCwiAQIECBAgQIAAAQIECBAwAPgBAgQIECBAgAABAgQIECAQEDAABEoWkQABAgQIECBAgAABAgQIGAD8AAECBAgQIECAAAECBAgQCAgYAAIli0iAAAECBAgQIECAAAECBAwAfoAAAQIECBAgQIAAAQIECAQEDACBkkUkQIAAAQIECBAgQIAAAQIGAD9AgAABAgQIECBAgAABAgQCAgaAQMkiEiBAgAABAgQIECBAgAABA4AfIECAAAECBAgQIECAAAECAQEDQKBkEQkQIECAAAECBAgQIECAgAHADxAgQIAAAQIECBAgQIAAgYCAASBQsogECBAgQIAAAQIECBAgQMAA4AcIECBAgAABAgQIECBAgEBAwAAQKFlEAgQIECBAgAABAgQIECBgAPADBAgQIECAAAECBAgQIEAgIGAACJQsIgECBAgQIECAAAECBAgQMAD4AQIECBAgQIAAAQIECBAgEBAwAARKFpEAAQIECBAgQIAAAQIECBgA/AABAgQIECBAgAABAgQIEAgIGAACJYtIgAABAgQIECBAgAABAgQMAH6AAAECBAgQIECAAAECBAgEBAwAgZJFJECAAAECBAgQIECAAAECBgA/QIAAAQIECBAgQIAAAQIEAgIGgEDJIhIgQIAAAQIECBAgQIAAAQOAHyBAgAABAgQIECBAgAABAgEBA0CgZBEJECBAgAABAgQIECBAgIABwA8QIECAAAECBAgQIECAAIGAgAEgULKIBAgQIECAAAECBAgQIEDAAOAHCBAgQIAAAQIECBAgQIBAQMAAEChZRAIECBAgQIAAAQIECBAgYADwAwQIECBAgAABAgQIECBAICBgAAiULCIBAgQIECBAgAABAgQIEDAA+AECBAgQIECAAAECBAgQIBAQMAAEShaRAAECBAgQIECAAAECBAgYAPwAAQIECBAgQIAAAQIECBAICBgAAiWLSIAAAQIECBAgQIAAAQIEDAB+gAABAgQIECBAgAABAgQIBAQMAIGSRSRAgAABAgQIECBAgAABAgYAP0CAAAECBAgQIECAAAECBAICBoBAySISIECAAAECBAgQIECAAAEDgB8gQIAAAQIECBAgQIAAAQIBAQNAoGQRCRAgQIAAAQIECBAgQICAAcAPECBAgAABAgQIECBAgACBgIABIFCyiAQIECBAgAABAgQIECBAwADgBwgQIECAAAECBAgQIECAQEDAABAoWUQCBAgQIECAAAECBAgQIGAA8AMECBAgQIAAAQIECBAgQCAgYAAIlCwiAQIECBAgQIAAAQIECBAwAPgBAgQIECBAgAABAgQIECAQEDAABEoWkQABAgQIECBAgAABAgQIGAD8AAECBAgQIECAAAECBAgQCAgYAAIli0iAAAECBAgQIECAAAECBAwAfoAAAQIECBAgQIAAAQIECAQEDACBkkUkQIAAAQIECBAgQIAAAQIGAD9AgAABAgQIECBAgAABAgQCAgaAQMkiEiBAgAABAgQIECBAgAABA4AfIECAAAECBAgQIECAAAECAQEDQKBkEQkQIECAAAECBAgQIECAgAHADxAgQIAAAQIECBAgQIAAgYCAASBQsogECBAgQIAAAQIECBAgQMAA4AcIECBAgAABAgQIECBAgEBAwAAQKFlEAgQIECBAgAABAgQIECBgAPADBAgQIECAAAECBAgQIEAgIGAACJQsIgECBAgQIECAAAECBAgQMAD4AQIECBAgQIAAAQIECBAgEBAwAARKFpEAAQIECBAgQIAAAQIECBgA/AABAgQIECBAgAABAgQIEAgIGAACJYtIgAABAgQIECBAgAABAgQMAH6AAAECBAgQIECAAAECBAgEBAwAgZJFJECAAAECBAgQIECAAAECBgA/QIAAAQIECBAgQIAAAQIEAgIGgEDJIhIgQIAAAQIECBAgQIAAAQOAHyBAgAABAgQIECBAgAABAgEBA0CgZBEJECBAgAABAgQIECBAgIABwA8QIECAAAECBAgQIECAAIGAgAEgULKIBAgQIECAAAECBAgQIEDAAOAHCBAgQIAAAQIECBAgQIBAQMAAEChZRAIECBAgQIAAAQIECBAgYADwAwQIECBAgAABAgQIECBAICBgAAiULCIBAgQIECBAgAABAgQIEDAA+AECBAgQIECAAAECBAgQIBAQMAAEShaRAAECBAgQIECAAAECBAgYAPwAAQIECBAgNt3nXAAAD+lJREFUQIAAAQIECBAICBgAAiWLSIAAAQIECBAgQIAAAQIEDAB+gAABAgQIECBAgAABAgQIBAQMAIGSRSRAgAABAgQIECBAgAABAgYAP0CAAAECBAgQIECAAAECBAICBoBAySISIECAAAECBAgQIECAAAEDgB8gQIAAAQIECBAgQIAAAQIBAQNAoGQRCRAgQIAAAQIECBAgQICAAcAPECBAgAABAgQIECBAgACBgIABIFCyiAQIECBAgAABAgQIECBAwADgBwgQIECAAAECBAgQIECAQEDAABAoWUQCBAgQIECAAAECBAgQIGAA8AMECBAgQIAAAQIECBAgQCAgYAAIlCwiAQIECBAgQIAAAQIECBAwAPgBAgQIECBAgAABAgQIECAQEDAABEoWkQABAgQIECBAgAABAgQIGAD8AAECBAgQIECAAAECBAgQCAgYAAIli0iAAAECBAgQIECAAAECBAwAfoAAAQIECBAgQIAAAQIECAQEDACBkkUkQIAAAQIECBAgQIAAAQIGAD9AgAABAgQIECBAgAABAgQCAgaAQMkiEiBAgAABAgQIECBAgAABA4AfIECAAAECBAgQIECAAAECAQEDQKBkEQkQIECAAAECBAgQIECAgAHADxAgQIAAAQIECBAgQIAAgYCAASBQsogECBAgQIAAAQIECBAgQMAA4AcIECBAgAABAgQIECBAgEBAwAAQKFlEAgQIECBAgAABAgQIECBgAPADBAgQIECAAAECBAgQIEAgIGAACJQsIgECBAgQIECAAAECBAgQMAD4AQIECBAgQIAAAQIECBAgEBAwAARKFpEAAQIECBAgQIAAAQIECBgA/AABAgQIECBAgAABAgQIEAgIGAACJYtIgAABAgQIECBAgAABAgQMAH6AAAECBAgQIECAAAECBAgEBAwAgZJFJECAAAECBAgQIECAAAECBgA/QIAAAQIECBAgQIAAAQIEAgIGgEDJIhIgQIAAAQIECBAgQIAAAQOAHyBAgAABAgQIECBAgAABAgEBA0CgZBEJECBAgAABAgQIECBAgIABwA8QIECAAAECBAgQIECAAIGAgAEgULKIBAgQIECAAAECBAgQIEDAAOAHCBAgQIAAAQIECBAgQIBAQMAAEChZRAIECBAgQIAAAQIECBAgYADwAwQIECBAgAABAgQIECBAICBgAAiULCIBAgQIECBAgAABAgQIEDAA+AECBAgQIECAAAECBAgQIBAQMAAEShaRAAECBAgQIECAAAECBAgYAPwAAQIECBAgQIAAAQIECBAICBgAAiWLSIAAAQIECBAgQIAAAQIEDAB+gAABAgQIECBAgAABAgQIBAQMAIGSRSRAgAABAgQIECBAgAABAgYAP0CAAAECBAgQIECAAAECBAICBoBAySISIECAAAECBAgQIECAAAEDgB8gQIAAAQIECBAgQIAAAQIBAQNAoGQRCRAgQIAAAQIECBAgQICAAcAPECBAgAABAgQIECBAgACBgIABIFCyiAQIECBAgAABAgQIECBAwADgBwgQIECAAAECBAgQIECAQEDAABAoWUQCBAgQIECAAAECBAgQIGAA8AMECBAgQIAAAQIECBAgQCAgYAAIlCwiAQIECBAgQIAAAQIECBAwAPgBAgQIECBAgAABAgQIECAQEDAABEoWkQABAgQIECBAgAABAgQIGAD8AAECBAgQIECAAAECBAgQCAgYAAIli0iAAAECBAgQIECAAAECBAwAfoAAAQIECBAgQIAAAQIECAQEDACBkkUkQIAAAQIECBAgQIAAAQIGAD9AgAABAgQIECBAgAABAgQCAgaAQMkiEiBAgAABAgQIECBAgAABA4AfIECAAAECBAgQIECAAAECAQEDQKBkEQkQIECAAAECBAgQIECAgAHADxAgQIAAAQIECBAgQIAAgYCAASBQsogECBAgQIAAAQIECBAgQMAA4AcIECBAgAABAgQIECBAgEBAwAAQKFlEAgQIECBAgAABAgQIECBgAPADBAgQIECAAAECBAgQIEAgIGAACJQsIgECBAgQIECAAAECBAgQMAD4AQIECBAgQIAAAQIECBAgEBAwAARKFpEAAQIECBAgQIAAAQIECBgA/AABAgQIECBAgAABAgQIEAgIGAACJYtIgAABAgQIECBAgAABAgQMAH6AAAECBAgQIECAAAECBAgEBAwAgZJFJECAAAECBAgQIECAAAECBgA/QIAAAQIECBAgQIAAAQIEAgIGgEDJIhIgQIAAAQIECBAgQIAAAQOAHyBAgAABAgQIECBAgAABAgEBA0CgZBEJECBAgAABAgQIECBAgIABwA8QIECAAAECBAgQIECAAIGAgAEgULKIBAgQIECAAAECBAgQIEDAAOAHCBAgQIAAAQIECBAgQIBAQMAAEChZRAIECBAgQIAAAQIECBAgYADwAwQIECBAgAABAgQIECBAICBgAAiULCIBAgQIECBAgAABAgQIEDAA+AECBAgQIECAAAECBAgQIBAQMAAEShaRAAECBAgQIECAAAECBAgYAPwAAQIECBAgQIAAAQIECBAICBgAAiWLSIAAAQIECBAgQIAAAQIEDAB+gAABAgQIECBAgAABAgQIBAQMAIGSRSRAgAABAgQIECBAgAABAgYAP0CAAAECBAgQIECAAAECBAICBoBAySISIECAAAECBAgQIECAAAEDgB8gQIAAAQIECBAgQIAAAQIBAQNAoGQRCRAgQIAAAQIECBAgQICAAcAPECBAgAABAgQIECBAgACBgIABIFCyiAQIECBAgAABAgQIECBAwADgBwgQIECAAAECBAgQIECAQEDAABAoWUQCBAgQIECAAAECBAgQIGAA8AMECBAgQIAAAQIECBAgQCAgYAAIlCwiAQIECBAgQIAAAQIECBAwAPgBAgQIECBAgAABAgQIECAQEDAABEoWkQABAgQIECBAgAABAgQIGAD8AAECBAgQIECAAAECBAgQCAgYAAIli0iAAAECBAgQIECAAAECBAwAfoAAAQIECBAgQIAAAQIECAQEDACBkkUkQIAAAQIECBAgQIAAAQIGAD9AgAABAgQIECBAgAABAgQCAgaAQMkiEiBAgAABAgQIECBAgAABA4AfIECAAAECBAgQIECAAAECAQEDQKBkEQkQIECAAAECBAgQIECAgAHADxAgQIAAAQIECBAgQIAAgYCAASBQsogECBAgQIAAAQIECBAgQMAA4AcIECBAgAABAgQIECBAgEBAwAAQKFlEAgQIECBAgAABAgQIECBgAPADBAgQIECAAAECBAgQIEAgIGAACJQsIgECBAgQIECAAAECBAgQMAD4AQIECBAgQIAAAQIECBAgEBAwAARKFpEAAQIECBAgQIAAAQIECBgA/AABAgQIECBAgAABAgQIEAgIGAACJYtIgAABAgQIECBAgAABAgQMAH6AAAECBAgQIECAAAECBAgEBAwAgZJFJECAAAECBAgQIECAAAECBgA/QIAAAQIECBAgQIAAAQIEAgIGgEDJIhIgQIAAAQIECBAgQIAAAQOAHyBAgAABAgQIECBAgAABAgEBA0CgZBEJECBAgAABAgQIECBAgIABwA8QIECAAAECBAgQIECAAIGAgAEgULKIBAgQIECAAAECBAgQIEDAAOAHCBAgQIAAAQIECBAgQIBAQMAAEChZRAIECBAgQIAAAQIECBAgYADwAwQIECBAgAABAgQIECBAICBgAAiULCIBAgQIECBAgAABAgQIEDAA+AECBAgQIECAAAECBAgQIBAQMAAEShaRAAECBAgQIECAAAECBAgYAPwAAQIECBAgQIAAAQIECBAICBgAAiWLSIAAAQIECBAgQIAAAQIEDAB+gAABAgQIECBAgAABAgQIBAQMAIGSRSRAgAABAgQIECBAgAABAgYAP0CAAAECBAgQIECAAAECBAICBoBAySISIECAAAECBAgQIECAAAEDgB8gQIAAAQIECBAgQIAAAQIBAQNAoGQRCRAgQIAAAQIECBAgQICAAcAPECBAgAABAgQIECBAgACBgIABIFCyiAQIECBAgAABAgQIECBAwADgBwgQIECAAAECBAgQIECAQEDAABAoWUQCBAgQIECAAAECBAgQIGAA8AMECBAgQIAAAQIECBAgQCAgYAAIlCwiAQIECBAgQIAAAQIECBAwAPgBAgQIECBAgAABAgQIECAQEDAABEoWkQABAgQIECBAgAABAgQIGAD8AAECBAgQIECAAAECBAgQCAgYAAIli0iAAAECBAgQIECAAAECBAwAfoAAAQIECBAgQIAAAQIECAQEDACBkkUkQIAAAQIECBAgQIAAAQIGAD9AgAABAgQIECBAgAABAgQCAgaAQMkiEiBAgAABAgQIECBAgAABA4AfIECAAAECBAgQIECAAAECAQEDQKBkEQkQIECAAAECBAgQIECAgAHADxAgQIAAAQIECBAgQIAAgYCAASBQsogECBAgQIAAAQIECBAgQMAA4AcIECBAgAABAgQIECBAgEBAwAAQKFlEAgQIECBAgAABAgQIECBgAPADBAgQIECAAAECBAgQIEAgIGAACJQsIgECBAgQIECAAAECBAgQMAD4AQIECBAgQIAAAQIECBAgEBAwAARKFpEAAQIECBAgQIAAAQIECBgA/AABAgQIECBAgAABAgQIEAgIGAACJYtIgAABAgQIECBAgAABAgQMAH6AAAECBAgQIECAAAECBAgEBAwAgZJFJECAAAECBAgQIECAAAECBgA/QIAAAQIECBAgQIAAAQIEAgIGgEDJIhIgQIAAAQIECBAgQIAAAQOAHyBAgAABAgQIECBAgAABAgEBA0CgZBEJECBAgAABAgQIECBAgIABwA8QIECAAAECBAgQIECAAIGAgAEgULKIBAgQIECAAAECBAgQIEDAAOAHCBAgQIAAAQIECBAgQIBAQMAAEChZRAIECBAgQIAAAQIECBAgYADwAwQIECBAgAABAgQIECBAICBgAAiULCIBAgQIECBAgAABAgQIEDAA+AECBAgQIECAAAECBAgQIBAQMAAEShaRAAECBAgQIECAAAECBAgYAPwAAQIECBAgQIAAAQIECBAICBgAAiWLSIAAAQIECBAgQIAAAQIEDAB+gAABAgQIECBAgAABAgQIBAQMAIGSRSRAgAABAgQIECBAgAABAgYAP0CAAAECBAgQIECAAAECBAICBoBAySISIECAAAECBAgQIECAAAEDgB8gQIAAAQIECBAgQIAAAQIBAQNAoGQRCRAgQIAAAQIECBAgQICAAcAPECBAgAABAgQIECBAgACBgIABIFCyiAQIECBAgAABAgQIECBAwADgBwgQIECAAAECBAgQIECAQEDAABAoWUQCBAgQIEDgbDQERkNgNARGQ2A0BEZDYDQEAOJdC/zeE7NaAAAAAElFTkSuQmCCAA==" } ] } diff --git a/gltf-loader.cabal b/gltf-loader.cabal --- a/gltf-loader.cabal +++ b/gltf-loader.cabal @@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.7. +-- This file has been generated from package.yaml by hpack version 0.35.0. -- -- see: https://github.com/sol/hpack name: gltf-loader -version: 0.2.0.1 +version: 0.3.0.0 synopsis: High level GlTF loader description: Please see the README on Github at category: Graphics @@ -20,8 +20,12 @@ extra-source-files: README.md data/big-cube.gltf + data/cube-separate.bin + data/cube-separate.gltf + data/cube.glb data/cube.gltf data/invalid.gltf + data/Untitled.png source-repository head type: git @@ -30,11 +34,13 @@ library exposed-modules: Text.GLTF.Loader - Text.GLTF.Loader.Adapter - Text.GLTF.Loader.BufferAccessor - Text.GLTF.Loader.Decoders Text.GLTF.Loader.Errors + Text.GLTF.Loader.Glb Text.GLTF.Loader.Gltf + Text.GLTF.Loader.Internal.Adapter + Text.GLTF.Loader.Internal.BufferAccessor + Text.GLTF.Loader.Internal.Decoders + Text.GLTF.Loader.Internal.MonadAdapter other-modules: Paths_gltf_loader hs-source-dirs: @@ -86,6 +92,7 @@ , gltf-codec , linear , microlens + , microlens-platform , rio >=0.1.12.0 , unordered-containers default-language: Haskell2010 @@ -153,8 +160,8 @@ type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: - Text.GLTF.Loader.AdapterSpec - Text.GLTF.Loader.BufferAccessorSpec + Text.GLTF.Loader.Internal.AdapterSpec + Text.GLTF.Loader.Internal.BufferAccessorSpec Text.GLTF.Loader.Test.MkGltf Text.GLTF.LoaderSpec Paths_gltf_loader @@ -210,6 +217,7 @@ , hspec , linear , microlens + , microlens-platform , rio >=0.1.12.0 , unordered-containers default-language: Haskell2010 diff --git a/src/Text/GLTF/Loader.hs b/src/Text/GLTF/Loader.hs --- a/src/Text/GLTF/Loader.hs +++ b/src/Text/GLTF/Loader.hs @@ -1,37 +1,79 @@ - module Text.GLTF.Loader ( -- * Scene loading functions - fromFile, - fromByteString, + fromJsonFile, + fromJsonByteString, + fromBinaryFile, + fromBinaryByteString, - -- * GLTF Types + -- * GLTF Data Types module Text.GLTF.Loader.Gltf, + module Text.GLTF.Loader.Glb, -- * Loading Errors module Text.GLTF.Loader.Errors ) where -import Text.GLTF.Loader.Adapter -import Text.GLTF.Loader.BufferAccessor +import Text.GLTF.Loader.Internal.Adapter +import Text.GLTF.Loader.Internal.BufferAccessor import Text.GLTF.Loader.Errors +import Text.GLTF.Loader.Glb import Text.GLTF.Loader.Gltf +import Data.Binary.Get (ByteOffset) import Data.Either +import Data.Maybe (fromJust) import Lens.Micro import RIO +import RIO.FilePath (takeDirectory) import qualified Codec.GlTF as GlTF +import qualified Codec.GLB as GLB +import qualified RIO.Vector as Vector -- | Load a glTF scene from a ByteString -fromByteString :: MonadUnliftIO io => ByteString -> io (Either Errors Gltf) -fromByteString = toGltfResult . GlTF.fromByteString +fromJsonByteString :: MonadUnliftIO io => ByteString -> io (Either Errors Gltf) +fromJsonByteString input = toGltfResult "." Nothing (GlTF.fromByteString input) -- | Load a glTF scene from a file -fromFile :: MonadUnliftIO io => FilePath -> io (Either Errors Gltf) -fromFile path = liftIO (GlTF.fromFile path) >>= toGltfResult +fromJsonFile :: MonadUnliftIO io => FilePath -> io (Either Errors Gltf) +fromJsonFile path = liftIO (GlTF.fromFile path) >>= toGltfResult (takeDirectory path) Nothing + +fromBinaryFile :: MonadUnliftIO io => FilePath -> io (Either Errors Glb) +fromBinaryFile path = liftIO (GLB.fromFile path) >>= toGlbResult "." -toGltfResult :: MonadUnliftIO io => Either String GlTF.GlTF -> io (Either Errors Gltf) -toGltfResult res - = res - & over _Left (ReadError . fromString) - & traverseOf _Right toGltfResult' - where toGltfResult' gltf = adaptGltf gltf <$> loadBuffers gltf +fromBinaryByteString :: MonadUnliftIO io => ByteString -> io (Either Errors Glb) +fromBinaryByteString input = toGlbResult "." (GLB.fromByteString input) + +toGltfResult + :: MonadUnliftIO io + => FilePath + -> Maybe GLB.Chunk + -> Either String GlTF.GlTF + -> io (Either Errors Gltf) +toGltfResult basePath chunk res = res + & over _Left (ReadError . fromString) + & traverseOf _Right (runGltfAdapter basePath chunk) + +toGlbResult + :: MonadUnliftIO io + => FilePath + -> Either (ByteOffset, String) GLB.GLB + -> io (Either Errors Glb) +toGlbResult basePath (Right res) = processGlb basePath res +toGlbResult _ (Left (_, err)) = pure . Left . ReadError . fromString $ err + +runGltfAdapter + :: MonadUnliftIO io + => FilePath + -> Maybe GLB.Chunk + -> GlTF.GlTF + -> io Gltf +runGltfAdapter basePath chunk gltf = runAdapter gltf + <$> loadBuffers gltf chunk basePath + <*> loadImages gltf basePath + +processGlb :: MonadUnliftIO io => FilePath -> GLB.GLB -> io (Either Errors Glb) +processGlb basePath GLB.GLB{..} = over _Right Glb <$> res + where gltfChunk = chunks Vector.!? 0 + bufferChunk = chunks Vector.!? 1 + gltf = GlTF.fromChunk (fromJust gltfChunk) + res = toGltfResult basePath bufferChunk gltf diff --git a/src/Text/GLTF/Loader/Adapter.hs b/src/Text/GLTF/Loader/Adapter.hs deleted file mode 100644 --- a/src/Text/GLTF/Loader/Adapter.hs +++ /dev/null @@ -1,153 +0,0 @@ --- |Transform a `Codec.GlTF.GlTF` to `Text.GLTF.Loader.Gltf.Gltf` -module Text.GLTF.Loader.Adapter - ( attributePosition, - attributeNormal, - attributeTexCoord, - adaptGltf, - adaptAsset, - adaptMaterials, - adaptMeshes, - adaptNodes, - adaptMaterial, - adaptMesh, - adaptNode, - adaptAlphaMode, - adaptPbrMetallicRoughness, - adaptMeshPrimitives, - adaptMeshPrimitive, - adaptMeshPrimitiveMode - ) where - -import Text.GLTF.Loader.BufferAccessor -import Text.GLTF.Loader.Gltf - -import Linear (V3(..), V4(..)) -import RIO -import RIO.Partial (toEnum) -import qualified Codec.GlTF as GlTF -import qualified Codec.GlTF.Asset as GlTF.Asset -import qualified Codec.GlTF.Material as GlTF.Material -import qualified Codec.GlTF.PbrMetallicRoughness as GlTF.PbrMetallicRoughness -import qualified Codec.GlTF.Mesh as GlTF.Mesh -import qualified Codec.GlTF.Node as GlTF.Node -import qualified Data.HashMap.Strict as HashMap - -attributePosition :: Text -attributePosition = "POSITION" - -attributeNormal :: Text -attributeNormal = "NORMAL" - -attributeTexCoord :: Text -attributeTexCoord = "TEXCOORD_0" - -adaptGltf :: GlTF.GlTF -> Vector GltfBuffer -> Gltf -adaptGltf gltf@GlTF.GlTF{..} buffers' = Gltf - { gltfAsset = adaptAsset asset, - gltfMaterials = adaptMaterials materials, - gltfMeshes = adaptMeshes gltf buffers' meshes, - gltfNodes = adaptNodes nodes - } - -adaptAsset :: GlTF.Asset.Asset -> Asset -adaptAsset GlTF.Asset.Asset{..} = Asset - { assetVersion = version, - assetCopyright = copyright, - assetGenerator = generator, - assetMinVersion = minVersion - } - -adaptMaterials :: Maybe (Vector GlTF.Material.Material) -> Vector Material -adaptMaterials = maybe mempty (fmap adaptMaterial) - -adaptMeshes - :: GlTF.GlTF - -> Vector GltfBuffer - -> Maybe (Vector GlTF.Mesh.Mesh) - -> Vector Mesh -adaptMeshes gltf buffers' = maybe mempty (fmap $ adaptMesh gltf buffers') - -adaptNodes :: Maybe (Vector GlTF.Node.Node) -> Vector Node -adaptNodes = maybe mempty (fmap adaptNode) - -adaptMaterial :: GlTF.Material.Material -> Material -adaptMaterial GlTF.Material.Material{..} = Material - { materialAlphaCutoff = alphaCutoff, - materialAlphaMode = adaptAlphaMode alphaMode, - materialDoubleSided = doubleSided, - materialEmissiveFactor = toV3 emissiveFactor, - materialName = name, - materialPbrMetallicRoughness = adaptPbrMetallicRoughness <$> pbrMetallicRoughness - } - -adaptMesh - :: GlTF.GlTF - -> Vector GltfBuffer - -> GlTF.Mesh.Mesh - -> Mesh -adaptMesh gltf buffers' GlTF.Mesh.Mesh{..} = Mesh - { meshPrimitives = adaptMeshPrimitives gltf buffers' primitives, - meshWeights = fromMaybe mempty weights, - meshName = name - } - -adaptNode :: GlTF.Node.Node -> Node -adaptNode GlTF.Node.Node{..} = Node - { nodeMeshId = GlTF.Mesh.unMeshIx <$> mesh, - nodeName = name, - nodeRotation = toV4 <$> rotation, - nodeScale = toV3 <$> scale, - nodeTranslation = toV3 <$> translation, - nodeWeights = maybe [] toList weights - } - -adaptAlphaMode :: GlTF.Material.MaterialAlphaMode -> MaterialAlphaMode -adaptAlphaMode GlTF.Material.BLEND = Blend -adaptAlphaMode GlTF.Material.MASK = Mask -adaptAlphaMode GlTF.Material.OPAQUE = Opaque -adaptAlphaMode (GlTF.Material.MaterialAlphaMode alphaMode) - = error $ "Invalid MaterialAlphaMode: " <> show alphaMode - -adaptPbrMetallicRoughness - :: GlTF.PbrMetallicRoughness.PbrMetallicRoughness - -> PbrMetallicRoughness -adaptPbrMetallicRoughness GlTF.PbrMetallicRoughness.PbrMetallicRoughness{..} - = PbrMetallicRoughness - { pbrBaseColorFactor = toV4 baseColorFactor, - pbrMetallicFactor = metallicFactor, - pbrRoughnessFactor = roughnessFactor - } - -adaptMeshPrimitives - :: GlTF.GlTF - -> Vector GltfBuffer - -> Vector GlTF.Mesh.MeshPrimitive - -> Vector MeshPrimitive -adaptMeshPrimitives gltf = fmap . adaptMeshPrimitive gltf - -adaptMeshPrimitive - :: GlTF.GlTF - -> Vector GltfBuffer - -> GlTF.Mesh.MeshPrimitive - -> MeshPrimitive -adaptMeshPrimitive gltf buffers' GlTF.Mesh.MeshPrimitive{..} = MeshPrimitive - { meshPrimitiveIndices = maybe mempty (vertexIndices gltf buffers') indices, - meshPrimitiveMaterial = GlTF.Material.unMaterialIx <$> material, - meshPrimitiveMode = adaptMeshPrimitiveMode mode, - meshPrimitiveNormals = maybe mempty (vertexNormals gltf buffers') normals, - meshPrimitivePositions = maybe mempty (vertexPositions gltf buffers') positions, - meshPrimitiveTexCoords = maybe mempty (vertexTexCoords gltf buffers') texCoords - } - where positions = attributes HashMap.!? attributePosition - normals = attributes HashMap.!? attributeNormal - texCoords = attributes HashMap.!? attributeTexCoord - - -adaptMeshPrimitiveMode :: GlTF.Mesh.MeshPrimitiveMode -> MeshPrimitiveMode -adaptMeshPrimitiveMode = toEnum . GlTF.Mesh.unMeshPrimitiveMode - -toV3 :: (a, a, a) -> V3 a -toV3 (x, y, z) = V3 x y z - -toV4 :: (a, a, a, a) -> V4 a -toV4 (w, x, y, z) = V4 w x y z diff --git a/src/Text/GLTF/Loader/BufferAccessor.hs b/src/Text/GLTF/Loader/BufferAccessor.hs deleted file mode 100644 --- a/src/Text/GLTF/Loader/BufferAccessor.hs +++ /dev/null @@ -1,136 +0,0 @@ -module Text.GLTF.Loader.BufferAccessor - ( GltfBuffer(..), - -- * Loading GLTF buffers - loadBuffers, - -- * Deserializing Accessors - vertexIndices, - vertexPositions, - vertexNormals, - vertexTexCoords, - ) where - -import Text.GLTF.Loader.Decoders - -import Codec.GlTF.Accessor -import Codec.GlTF.Buffer -import Codec.GlTF.BufferView -import Codec.GlTF.URI -import Codec.GlTF -import Data.Binary.Get -import Data.ByteString.Lazy (fromStrict) -import Foreign.Storable -import Linear -import RIO hiding (min, max) -import qualified RIO.Vector as Vector -import qualified RIO.ByteString as ByteString - --- | Holds the entire payload of a glTF buffer -newtype GltfBuffer = GltfBuffer { unBuffer :: ByteString } - deriving (Eq, Show) - --- | A buffer and some metadata -data BufferAccessor = BufferAccessor - { offset :: Int, - count :: Int, - buffer :: GltfBuffer - } - --- | Read all the buffers into memory -loadBuffers :: MonadUnliftIO io => GlTF -> io (Vector GltfBuffer) -loadBuffers GlTF{buffers=buffers} = do - let buffers' = fromMaybe [] buffers - - Vector.forM buffers' $ \Buffer{..} -> do - payload <- - maybe - (return "") - (\uri' -> do - readRes <- liftIO $ loadURI undefined uri' - case readRes of - Left err -> error err - Right res -> return res) - uri - - return $ GltfBuffer payload - --- | Decode vertex indices -vertexIndices :: GlTF -> Vector GltfBuffer -> AccessorIx -> Vector Int -vertexIndices = readBufferWithGet getIndices - --- | Decode vertex positions -vertexPositions :: GlTF -> Vector GltfBuffer -> AccessorIx -> Vector (V3 Float) -vertexPositions = readBufferWithGet getPositions - --- | Decode vertex normals -vertexNormals :: GlTF -> Vector GltfBuffer -> AccessorIx -> Vector (V3 Float) -vertexNormals = readBufferWithGet getNormals - --- | Decode texture coordinates. Note that we only use the first one. -vertexTexCoords :: GlTF -> Vector GltfBuffer -> AccessorIx -> Vector (V2 Float) -vertexTexCoords = readBufferWithGet getTexCoords - --- | Decode a buffer using the given Binary decoder -readBufferWithGet - :: Storable storable - => Get (Vector storable) - -> GlTF - -> Vector GltfBuffer - -> AccessorIx - -> Vector storable -readBufferWithGet getter gltf buffers' accessorId - = maybe mempty - (readFromBuffer undefined getter) - (bufferAccessor gltf buffers' accessorId) - --- | Look up a Buffer from a GlTF and AccessorIx -bufferAccessor - :: GlTF - -> Vector GltfBuffer - -> AccessorIx - -> Maybe BufferAccessor -bufferAccessor GlTF{..} buffers' accessorId = do - accessor <- lookupAccessor accessorId =<< accessors - bufferView <- lookupBufferViewFromAccessor accessor =<< bufferViews - buffer <- lookupBufferFromBufferView bufferView buffers' - - let Accessor{byteOffset=offset, count=count} = accessor - BufferView{byteOffset=offset'} = bufferView - - return $ BufferAccessor - { offset = offset + offset', - count = count, - buffer = buffer - } - --- | Look up a BufferView by Accessor -lookupBufferViewFromAccessor :: Accessor -> Vector BufferView -> Maybe BufferView -lookupBufferViewFromAccessor Accessor{..} bufferViews - = bufferView >>= flip lookupBufferView bufferViews - --- | Look up a Buffer by BufferView -lookupBufferFromBufferView :: BufferView -> Vector GltfBuffer -> Maybe GltfBuffer -lookupBufferFromBufferView BufferView{..} = lookupBuffer buffer - --- | Look up an Accessor by Ix -lookupAccessor :: AccessorIx -> Vector Accessor -> Maybe Accessor -lookupAccessor (AccessorIx accessorId) = (Vector.!? accessorId) - --- | Look up a BufferView by Ix -lookupBufferView :: BufferViewIx -> Vector BufferView -> Maybe BufferView -lookupBufferView (BufferViewIx bufferViewId) = (Vector.!? bufferViewId) - --- | Look up a Buffer by Ix -lookupBuffer :: BufferIx -> Vector GltfBuffer -> Maybe GltfBuffer -lookupBuffer (BufferIx bufferId) = (Vector.!? bufferId) - --- | Decode a buffer using the given Binary decoder -readFromBuffer - :: Storable storable - => storable - -> Get (Vector storable) - -> BufferAccessor - -> Vector storable -readFromBuffer storable getter BufferAccessor{..} - = runGet getter (fromStrict payload') - where payload' = ByteString.take len' . ByteString.drop offset . unBuffer $ buffer - len' = count * sizeOf storable diff --git a/src/Text/GLTF/Loader/Decoders.hs b/src/Text/GLTF/Loader/Decoders.hs deleted file mode 100644 --- a/src/Text/GLTF/Loader/Decoders.hs +++ /dev/null @@ -1,157 +0,0 @@ -module Text.GLTF.Loader.Decoders - ( -- * GLTF Property-specific Type decoders - getIndices, - getPositions, - getNormals, - getTexCoords, - -- * GLTF Accessor Type decoders - getScalar, - getVec2, - getVec3, - getVec4, - getMat2, - getMat3, - getMat4, - -- * GLTF Component Type decoders - getByte, - getUnsignedByte, - getShort, - getUnsignedShort, - getUnsignedInt, - getFloat - ) where - -import Data.Binary.Get -import Linear -import RIO hiding (min, max) -import qualified RIO.Vector as Vector - --- | Vertex indices binary decoder -getIndices :: Get (Vector Int) -getIndices = getScalar (fromIntegral <$> getUnsignedShort) - --- | Vertex positions binary decoder -getPositions :: Get (Vector (V3 Float)) -getPositions = getVec3 getFloat - --- | Vertex normals binary decoder -getNormals :: Get (Vector (V3 Float)) -getNormals = getVec3 getFloat - --- | Texture coordinates binary decoder -getTexCoords :: Get (Vector (V2 Float)) -getTexCoords = getVec2 getFloat - --- | Scalar (simple) type binary decoder -getScalar :: Get a -> Get (Vector a) -getScalar = getVector - --- | 2D Vector binary decoder -getVec2 :: Get a -> Get (Vector (V2 a)) -getVec2 getter = getVector $ V2 <$> getter <*> getter - --- | 3D Vector binary decoder -getVec3 :: Get a -> Get (Vector (V3 a)) -getVec3 getter = getVector $ V3 <$> getter <*> getter <*> getter - --- | 4D Vector binary decoder -getVec4 :: Get a -> Get (Vector (V4 a)) -getVec4 getter = getVector $ V4 <$> getter <*> getter <*> getter <*> getter - --- | 2x2 Matrix binary decoder -getMat2 :: Get a -> Get (Vector (M22 a)) -getMat2 getter = getVector $ do - m1_1 <- getter - m1_2 <- getter - - m2_1 <- getter - m2_2 <- getter - - return $ V2 - (V2 m1_1 m2_1) - (V2 m1_2 m2_2) - --- | 3x3 Matrix binary decoder -getMat3 :: Get a -> Get (Vector (M33 a)) -getMat3 getter = getVector $ do - m1_1 <- getter - m1_2 <- getter - m1_3 <- getter - - m2_1 <- getter - m2_2 <- getter - m2_3 <- getter - - m3_1 <- getter - m3_2 <- getter - m3_3 <- getter - - return $ V3 - (V3 m1_1 m2_1 m3_1) - (V3 m1_2 m2_2 m3_2) - (V3 m1_3 m2_3 m3_3) - --- | 4x4 Matrix binary decoder -getMat4 :: Get a -> Get (Vector (M44 a)) -getMat4 getter = getVector $ do - m1_1 <- getter - m1_2 <- getter - m1_3 <- getter - m1_4 <- getter - - m2_1 <- getter - m2_2 <- getter - m2_3 <- getter - m2_4 <- getter - - m3_1 <- getter - m3_2 <- getter - m3_3 <- getter - m3_4 <- getter - - m4_1 <- getter - m4_2 <- getter - m4_3 <- getter - m4_4 <- getter - - return $ V4 - (V4 m1_1 m2_1 m3_1 m4_1) - (V4 m1_2 m2_2 m3_2 m4_2) - (V4 m1_3 m2_3 m3_3 m4_3) - (V4 m1_4 m2_4 m3_4 m4_4) - --- | Byte binary decoder -getByte :: Get Int8 -getByte = getInt8 - --- | Unsigned Byte binary decoder -getUnsignedByte :: Get Word8 -getUnsignedByte = getWord8 - --- | Short binary decoder -getShort :: Get Int16 -getShort = getInt16le - --- | Unsigned Short binary decoder -getUnsignedShort :: Get Word16 -getUnsignedShort = getWord16le - --- | Unsigned Int binary decoder -getUnsignedInt :: Get Word32 -getUnsignedInt = getWord32le - --- | Float binary decoder -getFloat :: Get Float -getFloat = getFloatle - --- | Boxed Vector binary decoder -getVector :: Get a -> Get (Vector a) -getVector = fmap Vector.fromList . getList - --- | List binary decoder -getList :: Get a -> Get [a] -getList getter = do - empty <- isEmpty - if empty - then return [] - else (:) <$> getter <*> getList getter diff --git a/src/Text/GLTF/Loader/Glb.hs b/src/Text/GLTF/Loader/Glb.hs new file mode 100644 --- /dev/null +++ b/src/Text/GLTF/Loader/Glb.hs @@ -0,0 +1,16 @@ +module Text.GLTF.Loader.Glb + ( Glb(..), + _gltf + ) where + +import RIO + +import Text.GLTF.Loader.Gltf + +-- | A Binary glTF +newtype Glb = Glb { unGltf :: Gltf } + deriving (Eq, Show) + +-- | Embedded glTF root data, from the first chunk +_gltf :: Lens' Glb Gltf +_gltf = lens unGltf (const Glb) diff --git a/src/Text/GLTF/Loader/Gltf.hs b/src/Text/GLTF/Loader/Gltf.hs --- a/src/Text/GLTF/Loader/Gltf.hs +++ b/src/Text/GLTF/Loader/Gltf.hs @@ -2,6 +2,9 @@ ( -- * Data constructors Gltf(..), Asset(..), + Image(..), + MagFilter(..), + MinFilter(..), Material(..), MaterialAlphaMode(..), Mesh(..), @@ -9,16 +12,28 @@ 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, @@ -31,12 +46,23 @@ _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, @@ -45,8 +71,12 @@ _meshPrimitivePositions, -- ** PbrMetallicRoughness Lenses _pbrBaseColorFactor, + _pbrBaseColorTexture, _pbrMetallicFactor, - _pbrRoughnessFactor + _pbrRoughnessFactor, + -- ** TextureInfo Lenses + _textureInfoId, + _textureInfoTexCoord ) where import Linear @@ -55,71 +85,166 @@ -- | The root data type for a glTF asset data Gltf = Gltf { gltfAsset :: Asset, + gltfImages :: Vector Image, gltfMaterials :: Vector Material, gltfMeshes :: Vector Mesh, - gltfNodes :: Vector Node + gltfNodes :: Vector Node, + gltfSamplers :: Vector Sampler, + gltfTextures :: Vector Texture } deriving (Eq, Show) -- | Metadata about the glTF asset data Asset = Asset - { assetVersion :: Text, + { -- | The glTF version that this asset targets. + assetVersion :: Text, + -- | A copyright message suitable for display to credit the content creator. assetCopyright :: Maybe Text, + -- | Tool that generated this glTF model. assetGenerator :: Maybe Text, + -- | The minimum glTF version that this asset targets assetMinVersion :: Maybe Text } deriving (Eq, Show) +-- | Image data used to create a texture. +data Image = Image + { -- | The binary data of the image + imageData :: Maybe ByteString, + -- | The image’s media type. + imageMimeType :: Text, + -- | The user-defined name of this object. + imageName :: Maybe Text + } deriving (Eq, Show) + -- | The material appearance of a primitive data Material = Material - { materialAlphaCutoff :: Float, + { -- | Specifies the cutoff threshold when in MASK alpha mode. + materialAlphaCutoff :: Float, + -- | The material’s alpha rendering mode enumeration specifying the interpretation of + -- the alpha value of the base color. materialAlphaMode :: MaterialAlphaMode, + -- | Specifies whether the material is double sided. materialDoubleSided :: Bool, + -- | The factors for the emissive color of the material. materialEmissiveFactor :: V3 Float, + -- | The user-defined name of this object. materialName :: Maybe Text, + -- | Metallic roughness Physically Based Rendering (PBR) methodology parameter values. materialPbrMetallicRoughness :: Maybe PbrMetallicRoughness } deriving (Eq, Show) -- | A set of primitives to be rendered data Mesh = Mesh - { meshPrimitives :: Vector MeshPrimitive, - meshWeights :: Vector Float, - meshName :: Maybe Text + { -- | The user-defined name of this object. + meshName :: Maybe Text, + -- | A Vector of primitives, each defining geometry to be rendered. + meshPrimitives :: Vector MeshPrimitive, + -- | A Vector of weights to be applied to the morph targets. + meshWeights :: Vector Float } deriving (Eq, Show) -- | A node in the node hierarchy data Node = Node - { nodeMeshId :: Maybe Int, + { -- | The indices of this Node's children + nodeChildren :: Vector Int, + -- | The index of the mesh in this node. + nodeMeshId :: Maybe Int, + -- | The user-defined name of this object. nodeName :: Maybe Text, + -- | The node's unit quaternion rotation. nodeRotation :: Maybe (V4 Float), + -- | The node's non-uniform scale nodeScale :: Maybe (V3 Float), + -- | The node's translation along the x, y, and z axes. nodeTranslation :: Maybe (V3 Float), + -- | The weights of the instantiated morph target. nodeWeights :: [Float] } deriving (Eq, Show) +-- | Texture sampler properties for filtering and wrapping modes. +data Sampler = Sampler + { -- | Magnification filter. + samplerMagFilter :: Maybe MagFilter, + -- | Minification filter. + samplerMinFilter :: Maybe MinFilter, + -- | The user-defined name of this object. + samplerName :: Maybe Text, + -- | S (U) wrapping mode. All valid values correspond to WebGL enums. + samplerWrapS :: SamplerWrap, + -- | T (V) wrapping mode. All valid values correspond to WebGL enums. + samplerWrapT :: SamplerWrap + } deriving (Eq, Show) + +-- | A texture and its sampler. +data Texture = Texture + { -- | The user-defined name of this object. + textureName :: Maybe Text, + -- | The index of the sampler used by this texture. + textureSamplerId :: Maybe Int, + -- | The index of the image used by this texture. + textureSourceId :: Maybe Int + } deriving (Eq, Show) + -- | Geometry to be rendered with the given material data MeshPrimitive = MeshPrimitive - { meshPrimitiveIndices :: Vector Int, + { -- | A Vector of vertex indices. + meshPrimitiveIndices :: Vector Word16, + -- | The index of the material to apply to this primitive when rendering. meshPrimitiveMaterial :: Maybe Int, + -- | The topology type of primitives to render. meshPrimitiveMode :: MeshPrimitiveMode, + -- | A Vector of vertex normals. meshPrimitiveNormals :: Vector (V3 Float), + -- | A Vector of vertex positions. meshPrimitivePositions :: Vector (V3 Float), + -- | A Vector of vertex texture coordinates meshPrimitiveTexCoords :: Vector (V2 Float) } deriving (Eq, 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 (Eq, Enum, 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 - { pbrBaseColorFactor :: V4 Float, + { -- | The factors for the base color of the material. + pbrBaseColorFactor :: V4 Float, + -- | The base color texture + pbrBaseColorTexture :: Maybe TextureInfo, + -- | The factor for the metalness of the material. pbrMetallicFactor :: Float, + -- | The factor for the roughness of the material. pbrRoughnessFactor :: Float } deriving (Eq, Show) +-- | Magnification filter. +data MagFilter = MagLinear | MagNearest + deriving (Enum, Eq, Show) + +-- | Minification Filter. +data MinFilter + = MinNearest + | MinLinear + | MinNearestMipmapNearest + | MinLinearMipmapNearest + | MinNearestMipmapLinear + | MinLinearMipmapLinear + deriving (Enum, Eq, Show) + +-- | Sampler wrapping mode. +data SamplerWrap + = ClampToEdge + | MirroredRepeat + | Repeat + deriving (Enum, Eq, Show) + -- | The topology type of primitives to render. data MeshPrimitiveMode = Points @@ -131,138 +256,276 @@ | TriangleFan deriving (Eq, Enum, Show) +-- | Reference to a texture. +data TextureInfo = TextureInfo + { -- | The index of the texture. + textureId :: Int, + -- | This integer value is used to construct a string in the format + -- TEXCOORD_ which is a reference to a key in mesh.primitives.attributes + -- (e.g. a value of 0 corresponds to TEXCOORD_0). + textureTexCoord :: Int + } deriving (Eq, Show) + +-- | Metadata about the glTF asset _asset :: Lens' Gltf Asset _asset = lens gltfAsset (\gltf asset -> gltf { gltfAsset = asset }) +-- | A Vector of Images. An Image defines data used to create a texture. +_images :: Lens' Gltf (Vector Image) +_images = lens gltfImages (\gltf images -> gltf { gltfImages = images }) + +-- | A Vector of Materials. A Material defines the appearance of a primitive. _materials :: Lens' Gltf (Vector Material) _materials = lens gltfMaterials (\gltf mats -> gltf { gltfMaterials = mats }) +-- | A Vector of Meshes. A Mesh is a set of primitives to be rendered. _meshes :: Lens' Gltf (Vector Mesh) _meshes = lens gltfMeshes (\gltf meshes -> gltf { gltfMeshes = meshes }) +-- | A Vector of Nodes in the hierarchy. _nodes :: Lens' Gltf (Vector Node) _nodes = lens gltfNodes (\gltf nodes -> gltf { gltfNodes = nodes }) +-- | A Vector of Texture Samplers. Texture Sampler defines properties for filtering and +-- wrapping modes. +_samplers :: Lens' Gltf (Vector Sampler) +_samplers = lens gltfSamplers (\gltf samplers -> gltf { gltfSamplers = samplers }) + +-- | A texture and its sampler. +_textures :: Lens' Gltf (Vector Texture) +_textures = lens gltfTextures (\gltf texs -> gltf { gltfTextures = texs }) + +-- | The glTF version that this asset targets. _assetVersion :: Lens' Asset Text _assetVersion = lens assetVersion (\asset version' -> asset { assetVersion = version' }) +-- | A copyright message suitable for display to credit the content creator. _assetCopyright :: Lens' Asset (Maybe Text) _assetCopyright = lens assetCopyright (\asset copyright' -> asset { assetCopyright = copyright' }) +-- | Tool that generated this glTF model. _assetGenerator :: Lens' Asset (Maybe Text) _assetGenerator = lens assetGenerator (\asset generator' -> asset { assetGenerator = generator' }) +-- | The minimum glTF version that this asset targets _assetMinVersion :: Lens' Asset (Maybe Text) _assetMinVersion = lens assetMinVersion (\asset minVersion' -> asset { assetMinVersion = minVersion' }) +-- | The binary data of the image +_imageData :: Lens' Image (Maybe ByteString) +_imageData = lens imageData (\img data' -> img { imageData = data' }) + +-- | The image’s media type. +_imageMimeType :: Lens' Image Text +_imageMimeType = lens imageMimeType (\img mime -> img { imageMimeType = mime }) + +-- | The user-defined name of this object. +_imageName :: Lens' Image (Maybe Text) +_imageName = lens imageName (\img name -> img { imageName = name }) + +-- | Specifies the cutoff threshold when in MASK alpha mode. _materialAlphaCutoff :: Lens' Material Float _materialAlphaCutoff = lens materialAlphaCutoff (\material alphaCutoff -> material { materialAlphaCutoff = 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 materialAlphaMode (\material mode -> material { materialAlphaMode = mode }) +-- | Specifies whether the material is double sided. _materialDoubleSided :: Lens' Material Bool _materialDoubleSided = lens materialDoubleSided (\material doubleSided -> material { materialDoubleSided = doubleSided }) +-- | The factors for the emissive color of the material. _materialEmissiveFactor :: Lens' Material (V3 Float) _materialEmissiveFactor = lens materialEmissiveFactor (\material emissiveFactor -> material { materialEmissiveFactor = emissiveFactor }) +-- | The user-defined name of this object. _materialName :: Lens' Material (Maybe Text) _materialName = lens materialName (\material name -> material { materialName = name }) +-- | Metallic roughness Physically Based Rendering (PBR) methodology parameter values. _materialPbrMetallicRoughness :: Lens' Material (Maybe PbrMetallicRoughness) _materialPbrMetallicRoughness = lens materialPbrMetallicRoughness (\material roughness -> material { materialPbrMetallicRoughness = roughness }) -_meshWeights :: Lens' Mesh (Vector Float) -_meshWeights = lens meshWeights (\mesh weights -> mesh { meshWeights = weights }) - +-- | The user-defined name of this object. _meshName :: Lens' Mesh (Maybe Text) _meshName = lens meshName (\mesh name -> mesh { meshName = name }) +-- | A Vector of primitives, each defining geometry to be rendered. _meshPrimitives :: Lens' Mesh (Vector MeshPrimitive) _meshPrimitives = lens meshPrimitives (\mesh primitives -> mesh { meshPrimitives = primitives }) +-- | A Vector of weights to be applied to the morph targets. +_meshWeights :: Lens' Mesh (Vector Float) +_meshWeights = lens meshWeights (\mesh weights -> mesh { meshWeights = weights }) + +-- | The indices of this node's children. +_nodeChildren :: Lens' Node (Vector Int) +_nodeChildren = lens nodeChildren (\node children -> node { nodeChildren = children }) + +-- | The index of the mesh in this node. _nodeMeshId :: Lens' Node (Maybe Int) _nodeMeshId = lens nodeMeshId (\node meshId -> node { nodeMeshId = meshId }) +-- | The user-defined name of this object. _nodeName :: Lens' Node (Maybe Text) _nodeName = lens nodeName (\node name' -> node { nodeName = name' }) +-- | The node's unit quaternion rotation. _nodeRotation :: Lens' Node (Maybe (V4 Float)) _nodeRotation = lens nodeRotation (\node rotation' -> node { nodeRotation = rotation' }) +-- | The node's non-uniform scale _nodeScale :: Lens' Node (Maybe (V3 Float)) _nodeScale = lens nodeScale (\node scale' -> node { nodeScale = scale' }) +-- | The node's translation along the x, y, and z axes. _nodeTranslation :: Lens' Node (Maybe (V3 Float)) _nodeTranslation = lens nodeTranslation (\node translation' -> node { nodeTranslation = translation' }) +-- | The weights of the instantiated morph target. _nodeWeights :: Lens' Node [Float] _nodeWeights = lens nodeWeights (\node weights' -> node { nodeWeights = weights' }) -_meshPrimitiveIndices :: Lens' MeshPrimitive (Vector Int) +-- | Magnification filter. +_samplerMagFilter :: Lens' Sampler (Maybe MagFilter) +_samplerMagFilter = lens + samplerMagFilter + (\sampler mag -> sampler { samplerMagFilter = mag }) + +-- | Minification filter. +_samplerMinFilter :: Lens' Sampler (Maybe MinFilter) +_samplerMinFilter = lens + samplerMinFilter + (\sampler min' -> sampler { samplerMinFilter = min' }) + +-- | The user-defined name of this object. +_samplerName :: Lens' Sampler (Maybe Text) +_samplerName = lens + samplerName + (\sampler name -> sampler { samplerName = name }) + +-- | S (U) wrapping mode. +_samplerWrapS :: Lens' Sampler SamplerWrap +_samplerWrapS = lens + samplerWrapS + (\sampler wrapS -> sampler { samplerWrapS = wrapS }) + +-- | T (V) wrapping mode. +_samplerWrapT :: Lens' Sampler SamplerWrap +_samplerWrapT = lens + samplerWrapT + (\sampler wrapT -> sampler { samplerWrapT = wrapT }) + +-- | The user-defined name of this object. +_textureName :: Lens' Texture (Maybe Text) +_textureName = lens textureName (\tex name -> tex { textureName = name }) + +-- | The index of the sampler used by this texture. +_textureSamplerId :: Lens' Texture (Maybe Int) +_textureSamplerId = lens + textureSamplerId + (\tex sampler -> tex { textureSamplerId = sampler }) + +-- | The index of the image used by this texture. +_textureSourceId :: Lens' Texture (Maybe Int) +_textureSourceId = lens + textureSourceId + (\tex source -> tex { textureSourceId = source }) + +-- | A Vector of vertex indices. +_meshPrimitiveIndices :: Lens' MeshPrimitive (Vector Word16) _meshPrimitiveIndices = lens meshPrimitiveIndices (\primitive' indices -> primitive' { meshPrimitiveIndices = indices }) +-- | The index of the material to apply to this primitive when rendering. _meshPrimitiveMaterial :: Lens' MeshPrimitive (Maybe Int) _meshPrimitiveMaterial = lens meshPrimitiveMaterial (\primitive' material -> primitive' { meshPrimitiveMaterial = material }) +-- | The topology type of primitives to render. _meshPrimitiveMode :: Lens' MeshPrimitive MeshPrimitiveMode _meshPrimitiveMode = lens meshPrimitiveMode (\primitive' mode -> primitive' { meshPrimitiveMode = mode }) +-- | A Vector of vertex normals. _meshPrimitiveNormals :: Lens' MeshPrimitive (Vector (V3 Float)) _meshPrimitiveNormals = lens meshPrimitiveNormals (\primitive' normals -> primitive' { meshPrimitiveNormals = normals }) +-- | A Vector of vertex positions. _meshPrimitivePositions :: Lens' MeshPrimitive (Vector (V3 Float)) _meshPrimitivePositions = lens meshPrimitivePositions (\primitive' positions -> primitive' { meshPrimitivePositions = positions }) +-- | A Vector of vertex texture coordinates _meshPrimitiveTexCoords :: Lens' MeshPrimitive (Vector (V2 Float)) _meshPrimitiveTexCoords = lens meshPrimitiveTexCoords (\primitive' coords -> primitive' { meshPrimitiveTexCoords = coords }) - + +-- | The factors for the base color of the material. _pbrBaseColorFactor :: Lens' PbrMetallicRoughness (V4 Float) _pbrBaseColorFactor = lens pbrBaseColorFactor (\pbr baseColor -> pbr { pbrBaseColorFactor = baseColor }) - + +-- | The base color texture +_pbrBaseColorTexture :: Lens' PbrMetallicRoughness (Maybe TextureInfo) +_pbrBaseColorTexture = lens + pbrBaseColorTexture + (\pbr texture -> pbr { pbrBaseColorTexture = texture }) + +-- | The factor for the metalness of the material. _pbrMetallicFactor :: Lens' PbrMetallicRoughness Float _pbrMetallicFactor = lens pbrMetallicFactor (\pbr metallicFactor -> pbr { pbrMetallicFactor = metallicFactor }) +-- | The factor for the roughness of the material. _pbrRoughnessFactor :: Lens' PbrMetallicRoughness Float _pbrRoughnessFactor = lens pbrRoughnessFactor (\pbr roughnessFactor -> pbr { pbrRoughnessFactor = roughnessFactor }) + +-- | The index of the texture. +_textureInfoId :: Lens' TextureInfo Int +_textureInfoId = lens + textureId + (\texInfo id' -> texInfo { textureId = id' }) + +-- | This integer value is used to construct a string in the format +-- TEXCOORD_ 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 + textureTexCoord + (\texInfo coord -> texInfo { textureTexCoord = coord }) diff --git a/src/Text/GLTF/Loader/Internal/Adapter.hs b/src/Text/GLTF/Loader/Internal/Adapter.hs new file mode 100644 --- /dev/null +++ b/src/Text/GLTF/Loader/Internal/Adapter.hs @@ -0,0 +1,254 @@ +-- |Transform a `Codec.GlTF.GlTF` to `Text.GLTF.Loader.Gltf.Gltf` +module Text.GLTF.Loader.Internal.Adapter + ( attributePosition, + attributeNormal, + attributeTexCoord, + runAdapter, + adaptGltf, + adaptAsset, + adaptImages, + adaptMaterials, + adaptMeshes, + adaptNodes, + adaptTextures, + adaptImage, + adaptMaterial, + adaptMesh, + adaptNode, + adaptTexture, + adaptAlphaMode, + adaptPbrMetallicRoughness, + adaptMeshPrimitives, + adaptMeshPrimitive, + adaptMeshPrimitiveMode + ) where + +import Text.GLTF.Loader.Gltf +import Text.GLTF.Loader.Internal.BufferAccessor +import Text.GLTF.Loader.Internal.MonadAdapter + +import Linear (V3(..), V4(..)) +import RIO +import RIO.Partial (toEnum) +import RIO.Vector.Partial ((!)) +import qualified Codec.GlTF as GlTF +import qualified Codec.GlTF.Asset as Asset +import qualified Codec.GlTF.Image as Image +import qualified Codec.GlTF.Material as Material +import qualified Codec.GlTF.PbrMetallicRoughness as PbrMetallicRoughness +import qualified Codec.GlTF.Mesh as Mesh +import qualified Codec.GlTF.Node as Node +import qualified Codec.GlTF.Sampler as Sampler +import qualified Codec.GlTF.Texture as Texture +import qualified Codec.GlTF.TextureInfo as TextureInfo +import qualified Data.HashMap.Strict as HashMap +import qualified RIO.Vector as V + +attributePosition :: Text +attributePosition = "POSITION" + +attributeNormal :: Text +attributeNormal = "NORMAL" + +attributeTexCoord :: Text +attributeTexCoord = "TEXCOORD_0" + +runAdapter + :: GlTF.GlTF + -> Vector GltfBuffer + -> Vector GltfImageData + -> Gltf +runAdapter gltf buffers images = runReader adaptGltf env + where env = AdaptEnv gltf buffers images + +adaptGltf :: Adapter Gltf +adaptGltf = do + GlTF.GlTF{..} <- getGltf + + gltfImages <- adaptImages images + gltfMeshes <- adaptMeshes meshes + + return $ Gltf + { gltfAsset = adaptAsset asset, + gltfImages = gltfImages, + gltfMaterials = adaptMaterials materials, + gltfMeshes = gltfMeshes, + gltfNodes = adaptNodes nodes, + gltfSamplers = adaptSamplers samplers, + gltfTextures = adaptTextures textures + } + +adaptAsset :: Asset.Asset -> Asset +adaptAsset Asset.Asset{..} = Asset + { assetVersion = version, + assetCopyright = copyright, + assetGenerator = generator, + assetMinVersion = minVersion + } + +adaptImages :: Maybe (Vector Image.Image) -> Adapter (Vector Image) +adaptImages codecImages = do + imageData <- getImages + + let images' = fromMaybe mempty codecImages + iforM = flip V.imapM + + iforM images' $ \imgId img -> + adaptImage (imageData ! imgId) img + +adaptMaterials :: Maybe (Vector Material.Material) -> Vector Material +adaptMaterials = maybe mempty (fmap adaptMaterial) + +adaptMeshes :: Maybe (Vector Mesh.Mesh) -> Adapter (Vector Mesh) +adaptMeshes = maybe (return mempty) (V.mapM adaptMesh) + +adaptNodes :: Maybe (Vector Node.Node) -> Vector Node +adaptNodes = maybe mempty (fmap adaptNode) + +adaptSamplers :: Maybe (Vector Sampler.Sampler) -> Vector Sampler +adaptSamplers = maybe mempty (fmap adaptSampler) + +adaptTextures :: Maybe (Vector Texture.Texture) -> Vector Texture +adaptTextures = maybe mempty (fmap adaptTexture) + +adaptImage :: GltfImageData -> Image.Image -> Adapter Image +adaptImage imgData Image.Image{..} = do + payload <- getImageData imgData + + -- Note that we treat mimeType as required, even though it may not be in the + -- specification. Tests in Blender suggest it's ALWAYS provided; When we come + -- across an example where it isn't, we'll address it then. + case mimeType of + Nothing -> error "Invalid Image: no mime-type specified" + Just mimeType' -> return Image + { imageData = payload, + imageMimeType = mimeType', + imageName = name + } + +adaptMaterial :: Material.Material -> Material +adaptMaterial Material.Material{..} = Material + { materialAlphaCutoff = alphaCutoff, + materialAlphaMode = adaptAlphaMode alphaMode, + materialDoubleSided = doubleSided, + materialEmissiveFactor = toV3 emissiveFactor, + materialName = name, + materialPbrMetallicRoughness = adaptPbrMetallicRoughness <$> pbrMetallicRoughness + } + +adaptMesh :: Mesh.Mesh -> Adapter Mesh +adaptMesh Mesh.Mesh{..} = do + primitives' <- adaptMeshPrimitives primitives + + return $ Mesh + { meshPrimitives = primitives', + meshWeights = fromMaybe mempty weights, + meshName = name + } + +adaptNode :: Node.Node -> Node +adaptNode Node.Node{..} = Node + { nodeChildren = maybe mempty (fmap Node.unNodeIx) children, + nodeMeshId = Mesh.unMeshIx <$> mesh, + nodeName = name, + nodeRotation = toV4 <$> rotation, + nodeScale = toV3 <$> scale, + nodeTranslation = toV3 <$> translation, + nodeWeights = maybe [] toList weights + } + +adaptSampler :: Sampler.Sampler -> Sampler +adaptSampler Sampler.Sampler{..} = Sampler + { samplerMagFilter = adaptMagFilter <$> magFilter, + samplerMinFilter = adaptMinFilter <$> minFilter, + samplerName = name, + samplerWrapS = adaptSamplerWrap wrapS, + samplerWrapT = adaptSamplerWrap wrapT + } + +adaptTexture :: Texture.Texture -> Texture +adaptTexture Texture.Texture{..} = Texture + { textureName = name, + textureSamplerId = Sampler.unSamplerIx <$> sampler, + textureSourceId = Image.unImageIx <$> source + } + +getImageData :: GltfImageData -> Adapter (Maybe ByteString) +getImageData (ImageData payload) = return $ Just payload +getImageData NoImageData = return Nothing +getImageData (ImageBufferView bufferViewId) = imageDataRaw' <$> getGltf <*> getBuffers + where imageDataRaw' gltf buffers' = imageDataRaw gltf buffers' bufferViewId + +adaptAlphaMode :: Material.MaterialAlphaMode -> MaterialAlphaMode +adaptAlphaMode Material.BLEND = Blend +adaptAlphaMode Material.MASK = Mask +adaptAlphaMode Material.OPAQUE = Opaque +adaptAlphaMode (Material.MaterialAlphaMode alphaMode) + = error $ "Invalid MaterialAlphaMode: " <> show alphaMode + +adaptPbrMetallicRoughness + :: PbrMetallicRoughness.PbrMetallicRoughness + -> PbrMetallicRoughness +adaptPbrMetallicRoughness PbrMetallicRoughness.PbrMetallicRoughness{..} + = PbrMetallicRoughness + { pbrBaseColorFactor = toV4 baseColorFactor, + pbrBaseColorTexture = adaptTextureInfo <$> baseColorTexture, + pbrMetallicFactor = metallicFactor, + pbrRoughnessFactor = roughnessFactor + } + +adaptMeshPrimitives :: Vector Mesh.MeshPrimitive -> Adapter (Vector MeshPrimitive) +adaptMeshPrimitives = V.mapM adaptMeshPrimitive + +adaptMagFilter :: Sampler.SamplerMagFilter -> MagFilter +adaptMagFilter Sampler.MAG_LINEAR = MagLinear +adaptMagFilter Sampler.MAG_NEAREST = MagNearest +adaptMagFilter mode = error $ "Invalid MagFilter: " <> show mode + +adaptMinFilter :: Sampler.SamplerMinFilter -> MinFilter +adaptMinFilter Sampler.MIN_NEAREST = MinNearest +adaptMinFilter Sampler.MIN_LINEAR = MinLinear +adaptMinFilter Sampler.MIN_NEAREST_MIPMAP_NEAREST = MinNearestMipmapNearest +adaptMinFilter Sampler.MIN_NEAREST_MIPMAP_LINEAR = MinNearestMipmapLinear +adaptMinFilter Sampler.MIN_LINEAR_MIPMAP_NEAREST = MinLinearMipmapNearest +adaptMinFilter Sampler.MIN_LINEAR_MIPMAP_LINEAR = MinLinearMipmapLinear +adaptMinFilter mode = error $ "Invalid MinFilter: " <> show mode + +adaptSamplerWrap :: Sampler.SamplerWrap -> SamplerWrap +adaptSamplerWrap Sampler.CLAMP_TO_EDGE = ClampToEdge +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 + { textureId = index, + textureTexCoord = texCoord + } + +adaptMeshPrimitive :: Mesh.MeshPrimitive -> Adapter MeshPrimitive +adaptMeshPrimitive Mesh.MeshPrimitive{..} = do + gltf <- getGltf + buffers' <- getBuffers + + return $ MeshPrimitive + { meshPrimitiveIndices = maybe mempty (vertexIndices gltf buffers') indices, + meshPrimitiveMaterial = Material.unMaterialIx <$> material, + meshPrimitiveMode = adaptMeshPrimitiveMode mode, + meshPrimitiveNormals = maybe mempty (vertexNormals gltf buffers') normals, + meshPrimitivePositions = maybe mempty (vertexPositions gltf buffers') positions, + meshPrimitiveTexCoords = maybe mempty (vertexTexCoords gltf buffers') texCoords + } + where positions = attributes HashMap.!? attributePosition + normals = attributes HashMap.!? attributeNormal + texCoords = attributes HashMap.!? attributeTexCoord + + +adaptMeshPrimitiveMode :: Mesh.MeshPrimitiveMode -> MeshPrimitiveMode +adaptMeshPrimitiveMode = toEnum . Mesh.unMeshPrimitiveMode + +toV3 :: (a, a, a) -> V3 a +toV3 (x, y, z) = V3 x y z + +toV4 :: (a, a, a, a) -> V4 a +toV4 (w, x, y, z) = V4 w x y z diff --git a/src/Text/GLTF/Loader/Internal/BufferAccessor.hs b/src/Text/GLTF/Loader/Internal/BufferAccessor.hs new file mode 100644 --- /dev/null +++ b/src/Text/GLTF/Loader/Internal/BufferAccessor.hs @@ -0,0 +1,216 @@ +module Text.GLTF.Loader.Internal.BufferAccessor + ( GltfBuffer(..), + GltfImageData(..), + -- * Loading GLTF buffers + loadBuffers, + loadImages, + -- * Deserializing Accessors + vertexIndices, + vertexPositions, + vertexNormals, + vertexTexCoords, + imageDataRaw, + ) where + +import Text.GLTF.Loader.Internal.Decoders + +import Codec.GLB (Chunk(..)) +import Codec.GlTF.Accessor +import Codec.GlTF.Buffer +import Codec.GlTF.BufferView +import Codec.GlTF.Image +import Codec.GlTF.URI +import Codec.GlTF +import Data.Binary.Get +import Data.ByteString.Lazy (fromStrict) +import Foreign.Storable +import Linear +import RIO hiding (min, max) +import RIO.FilePath +import qualified RIO.Vector as Vector +import qualified RIO.ByteString as ByteString + +-- | Holds the entire payload of a glTF buffer +newtype GltfBuffer + = GltfBuffer { unBuffer :: ByteString } + deriving (Eq, Show, Semigroup, Monoid) + +data GltfImageData + = ImageData ByteString + | ImageBufferView BufferViewIx + | NoImageData + deriving (Eq, Show) + +-- | A buffer and some metadata +data BufferAccessor = BufferAccessor + { offset :: Int, + count :: Int, + buffer :: GltfBuffer + } + +-- | Read all the buffers into memory +loadBuffers + :: MonadUnliftIO io + => GlTF + -> Maybe Chunk + -> FilePath -- ^ Base path of GlTF file + -> io (Vector GltfBuffer) +loadBuffers GlTF{buffers=buffers} chunk basePath = do + let buffers' = fromMaybe [] buffers + iforM = flip Vector.imapM + + iforM buffers' $ \idx Buffer{..} -> do + -- If the first buffer does not have a URI defined, it refers to a GLB chunk + let fallback = if idx == 0 && isNothing uri + then maybe mempty chunkData chunk + else mempty + + uri' <- maybe (pure fallback) (loadUri' basePath) uri + return $ GltfBuffer uri' + +loadImages + :: MonadUnliftIO io + => GlTF + -> FilePath -- ^ Base path of GlTF file + -> io (Vector GltfImageData) +loadImages GlTF{images=images} basePath = do + let images' = fromMaybe [] images + + Vector.forM images' $ \Image{..} -> do + let fallbackImageData = return $ maybe NoImageData ImageBufferView bufferView + maybe fallbackImageData (fmap ImageData . loadUri' basePath) uri + +-- | Decode vertex indices +vertexIndices :: GlTF -> Vector GltfBuffer -> AccessorIx -> Vector Word16 +vertexIndices = readBufferWithGet getIndices + +-- | Decode vertex positions +vertexPositions :: GlTF -> Vector GltfBuffer -> AccessorIx -> Vector (V3 Float) +vertexPositions = readBufferWithGet getPositions + +-- | Decode vertex normals +vertexNormals :: GlTF -> Vector GltfBuffer -> AccessorIx -> Vector (V3 Float) +vertexNormals = readBufferWithGet getNormals + +-- | Decode texture coordinates. Note that we only use the first one. +vertexTexCoords :: GlTF -> Vector GltfBuffer -> AccessorIx -> Vector (V2 Float) +vertexTexCoords = readBufferWithGet getTexCoords + +-- | Read an image from a buffer view +imageDataRaw :: GlTF -> Vector GltfBuffer -> BufferViewIx -> Maybe ByteString +imageDataRaw = readBufferView + +-- | Return a buffer view undecoded +readBufferView :: GlTF -> Vector GltfBuffer -> BufferViewIx -> Maybe ByteString +readBufferView gltf buffers' bufferViewId = do + accessor@BufferAccessor{count=length'} + <- bufferViewAccessor gltf buffers' bufferViewId + + return $ readFromBufferRaw accessor length' + +-- | Read a URI. Throws error on failure +loadUri' + :: MonadUnliftIO io + => FilePath -- ^ Base path + -> URI -- ^ URI to load + -> io ByteString +loadUri' baseDir uri' = do + readRes <- liftIO $ loadURI (loadFile baseDir) uri' + case readRes of + Left err -> error err + Right res -> return res + +loadFile :: MonadUnliftIO io => FilePath -> FilePath -> io (Either String ByteString) +loadFile baseDir filename = do + contents <- readFileBinary (baseDir filename) + + return $ Right contents + +-- | Decode a buffer using the given Binary decoder +readBufferWithGet + :: Storable storable + => Get (Vector storable) + -> GlTF + -> Vector GltfBuffer + -> AccessorIx + -> Vector storable +readBufferWithGet getter gltf buffers' accessorId + = maybe mempty + (readFromBuffer undefined getter) + (bufferAccessor gltf buffers' accessorId) + +-- | Look up a Buffer from a GlTF and AccessorIx +bufferAccessor + :: GlTF + -> Vector GltfBuffer + -> AccessorIx + -> Maybe BufferAccessor +bufferAccessor GlTF{..} buffers' accessorId = do + accessor <- lookupAccessor accessorId =<< accessors + bufferView <- lookupBufferViewFromAccessor accessor =<< bufferViews + buffer <- lookupBufferFromBufferView bufferView buffers' + + let Accessor{byteOffset=offset, count=count} = accessor + BufferView{byteOffset=offset'} = bufferView + + return $ BufferAccessor + { offset = offset + offset', + count = count, + buffer = buffer + } + +-- | Look up a Buffer from a GlTF and BufferView +bufferViewAccessor + :: GlTF + -> Vector GltfBuffer + -> BufferViewIx + -> Maybe BufferAccessor +bufferViewAccessor GlTF{..} buffers' bufferViewId = do + bufferView <- lookupBufferView bufferViewId =<< bufferViews + buffer <- lookupBufferFromBufferView bufferView buffers' + + let BufferView{byteLength=length', byteOffset=offset'} = bufferView + + return $ BufferAccessor + { offset = offset', + count = length', + buffer = buffer + } + +-- | Look up a BufferView by Accessor +lookupBufferViewFromAccessor :: Accessor -> Vector BufferView -> Maybe BufferView +lookupBufferViewFromAccessor Accessor{..} bufferViews + = bufferView >>= flip lookupBufferView bufferViews + +-- | Look up a Buffer by BufferView +lookupBufferFromBufferView :: BufferView -> Vector GltfBuffer -> Maybe GltfBuffer +lookupBufferFromBufferView BufferView{..} = lookupBuffer buffer + +-- | Look up an Accessor by Ix +lookupAccessor :: AccessorIx -> Vector Accessor -> Maybe Accessor +lookupAccessor (AccessorIx accessorId) = (Vector.!? accessorId) + +-- | Look up a BufferView by Ix +lookupBufferView :: BufferViewIx -> Vector BufferView -> Maybe BufferView +lookupBufferView (BufferViewIx bufferViewId) = (Vector.!? bufferViewId) + +-- | Look up a Buffer by Ix +lookupBuffer :: BufferIx -> Vector GltfBuffer -> Maybe GltfBuffer +lookupBuffer (BufferIx bufferId) = (Vector.!? bufferId) + +-- | Decode a buffer using the given Binary decoder +readFromBuffer + :: Storable storable + => storable + -> Get (Vector storable) + -> BufferAccessor + -> Vector storable +readFromBuffer storable getter accessor@BufferAccessor{..} + = runGet getter . fromStrict $ payload + where payload = readFromBufferRaw accessor len' + len' = count * sizeOf storable + +-- | Read from buffer without decoding +readFromBufferRaw :: BufferAccessor -> Int -> ByteString +readFromBufferRaw BufferAccessor{..} len' + = ByteString.take len' . ByteString.drop offset . unBuffer $ buffer diff --git a/src/Text/GLTF/Loader/Internal/Decoders.hs b/src/Text/GLTF/Loader/Internal/Decoders.hs new file mode 100644 --- /dev/null +++ b/src/Text/GLTF/Loader/Internal/Decoders.hs @@ -0,0 +1,157 @@ +module Text.GLTF.Loader.Internal.Decoders + ( -- * GLTF Property-specific Type decoders + getIndices, + getPositions, + getNormals, + getTexCoords, + -- * GLTF Accessor Type decoders + getScalar, + getVec2, + getVec3, + getVec4, + getMat2, + getMat3, + getMat4, + -- * GLTF Component Type decoders + getByte, + getUnsignedByte, + getShort, + getUnsignedShort, + getUnsignedInt, + getFloat + ) where + +import Data.Binary.Get +import Linear +import RIO hiding (min, max) +import qualified RIO.Vector as Vector + +-- | Vertex indices binary decoder +getIndices :: Get (Vector Word16) +getIndices = getScalar getUnsignedShort + +-- | Vertex positions binary decoder +getPositions :: Get (Vector (V3 Float)) +getPositions = getVec3 getFloat + +-- | Vertex normals binary decoder +getNormals :: Get (Vector (V3 Float)) +getNormals = getVec3 getFloat + +-- | Texture coordinates binary decoder +getTexCoords :: Get (Vector (V2 Float)) +getTexCoords = getVec2 getFloat + +-- | Scalar (simple) type binary decoder +getScalar :: Get a -> Get (Vector a) +getScalar = getVector + +-- | 2D Vector binary decoder +getVec2 :: Get a -> Get (Vector (V2 a)) +getVec2 getter = getVector $ V2 <$> getter <*> getter + +-- | 3D Vector binary decoder +getVec3 :: Get a -> Get (Vector (V3 a)) +getVec3 getter = getVector $ V3 <$> getter <*> getter <*> getter + +-- | 4D Vector binary decoder +getVec4 :: Get a -> Get (Vector (V4 a)) +getVec4 getter = getVector $ V4 <$> getter <*> getter <*> getter <*> getter + +-- | 2x2 Matrix binary decoder +getMat2 :: Get a -> Get (Vector (M22 a)) +getMat2 getter = getVector $ do + m1_1 <- getter + m1_2 <- getter + + m2_1 <- getter + m2_2 <- getter + + return $ V2 + (V2 m1_1 m2_1) + (V2 m1_2 m2_2) + +-- | 3x3 Matrix binary decoder +getMat3 :: Get a -> Get (Vector (M33 a)) +getMat3 getter = getVector $ do + m1_1 <- getter + m1_2 <- getter + m1_3 <- getter + + m2_1 <- getter + m2_2 <- getter + m2_3 <- getter + + m3_1 <- getter + m3_2 <- getter + m3_3 <- getter + + return $ V3 + (V3 m1_1 m2_1 m3_1) + (V3 m1_2 m2_2 m3_2) + (V3 m1_3 m2_3 m3_3) + +-- | 4x4 Matrix binary decoder +getMat4 :: Get a -> Get (Vector (M44 a)) +getMat4 getter = getVector $ do + m1_1 <- getter + m1_2 <- getter + m1_3 <- getter + m1_4 <- getter + + m2_1 <- getter + m2_2 <- getter + m2_3 <- getter + m2_4 <- getter + + m3_1 <- getter + m3_2 <- getter + m3_3 <- getter + m3_4 <- getter + + m4_1 <- getter + m4_2 <- getter + m4_3 <- getter + m4_4 <- getter + + return $ V4 + (V4 m1_1 m2_1 m3_1 m4_1) + (V4 m1_2 m2_2 m3_2 m4_2) + (V4 m1_3 m2_3 m3_3 m4_3) + (V4 m1_4 m2_4 m3_4 m4_4) + +-- | Byte binary decoder +getByte :: Get Int8 +getByte = getInt8 + +-- | Unsigned Byte binary decoder +getUnsignedByte :: Get Word8 +getUnsignedByte = getWord8 + +-- | Short binary decoder +getShort :: Get Int16 +getShort = getInt16le + +-- | Unsigned Short binary decoder +getUnsignedShort :: Get Word16 +getUnsignedShort = getWord16le + +-- | Unsigned Int binary decoder +getUnsignedInt :: Get Word32 +getUnsignedInt = getWord32le + +-- | Float binary decoder +getFloat :: Get Float +getFloat = getFloatle + +-- | Boxed Vector binary decoder +getVector :: Get a -> Get (Vector a) +getVector = fmap Vector.fromList . getList + +-- | List binary decoder +getList :: Get a -> Get [a] +getList getter = do + empty <- isEmpty + if empty + then return [] + else (:) <$> getter <*> getList getter diff --git a/src/Text/GLTF/Loader/Internal/MonadAdapter.hs b/src/Text/GLTF/Loader/Internal/MonadAdapter.hs new file mode 100644 --- /dev/null +++ b/src/Text/GLTF/Loader/Internal/MonadAdapter.hs @@ -0,0 +1,29 @@ +module Text.GLTF.Loader.Internal.MonadAdapter + ( Adapter(), + AdaptEnv(..), + getGltf, + getBuffers, + getImages + ) where + +import Text.GLTF.Loader.Internal.BufferAccessor + +import RIO +import qualified Codec.GlTF as GlTF + +type Adapter = Reader AdaptEnv + +data AdaptEnv = AdaptEnv + { asGltf :: GlTF.GlTF, + asBuffers :: Vector GltfBuffer, + asImages :: Vector GltfImageData + } + +getGltf :: Reader AdaptEnv GlTF.GlTF +getGltf = asks asGltf + +getBuffers :: Reader AdaptEnv (Vector GltfBuffer) +getBuffers = asks asBuffers + +getImages :: Reader AdaptEnv (Vector GltfImageData) +getImages = asks asImages diff --git a/test/Text/GLTF/Loader/AdapterSpec.hs b/test/Text/GLTF/Loader/AdapterSpec.hs deleted file mode 100644 --- a/test/Text/GLTF/Loader/AdapterSpec.hs +++ /dev/null @@ -1,224 +0,0 @@ -module Text.GLTF.Loader.AdapterSpec (spec) where - -import Text.GLTF.Loader.Adapter -import Text.GLTF.Loader.BufferAccessor -import Text.GLTF.Loader.Gltf -import Text.GLTF.Loader.Test.MkGltf - -import Linear -import RIO -import Test.Hspec -import qualified Codec.GlTF.Material as Material -import qualified Codec.GlTF.Mesh as Mesh -import qualified Codec.GlTF.Node as Node - -spec :: Spec -spec = do - let codecGltf = mkCodecGltf - codecMeshPrimitive = mkCodecMeshPrimitive - - describe "adaptGltf" $ do - it "Adapts a basic GlTF" $ do - buffers' <- buffers - adaptGltf codecGltf buffers' `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 - buffers' <- buffers - - let meshes = Just [codecMesh, codecMesh'] - adaptedMeshes = [loaderMesh, set _meshWeights [3.1] loaderMesh] - - adaptMeshes codecGltf buffers' meshes `shouldBe` adaptedMeshes - - it "Adapts empty meshes" $ do - buffers' <- buffers - - adaptMeshes codecGltf buffers' (Just []) `shouldBe` [] - adaptMeshes codecGltf buffers' Nothing `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 "adaptMesh" $ do - let codecMesh = mkCodecMesh - codecMesh' = mkCodecMesh { Mesh.weights = Nothing } - codecMesh'' = mkCodecMesh { Mesh.weights = Just [] } - - it "Adapts a basic mesh" $ do - buffers' <- buffers - adaptMesh codecGltf buffers' codecMesh `shouldBe` loaderMesh - - it "Adapts empty weights" $ do - buffers' <- buffers - let meshEmptyWeight = set _meshWeights [] loaderMesh - - adaptMesh codecGltf buffers' codecMesh' `shouldBe` meshEmptyWeight - adaptMesh codecGltf buffers' codecMesh'' `shouldBe` meshEmptyWeight - - describe "adaptNode" $ do - let codecNode = mkCodecNode - codecNode' = mkCodecNode { Node.weights = Nothing } - codecNode'' = mkCodecNode { Node.weights = Just [] } - - it "Adapts a basic node" $ do - adaptNode codecNode `shouldBe` loaderNode - - it "Adapts empty weights" $ do - let nodeEmptyWeight = set _nodeWeights [] loaderNode - adaptNode codecNode' `shouldBe` nodeEmptyWeight - adaptNode codecNode'' `shouldBe` nodeEmptyWeight - - 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 - buffers' <- buffers - let primitives = [codecMeshPrimitive, codecMeshPrimitive'] - expectedResult - = [ loaderMeshPrimitive, - set _meshPrimitiveMode Points loaderMeshPrimitive - ] - - adaptMeshPrimitives codecGltf buffers' primitives `shouldBe` expectedResult - - describe "adaptMeshPrimitive" $ do - it "adapts a basic primitive" $ do - buffers' <- buffers - adaptMeshPrimitive codecGltf buffers' codecMeshPrimitive `shouldBe` loaderMeshPrimitive - - it "ignores indices when unspecified" $ do - buffers' <- buffers - - let codecMeshPrimitive' = mkCodecMeshPrimitive - { Mesh.indices = Nothing } - loaderMeshPrimitive' = loaderMeshPrimitive & _meshPrimitiveIndices .~ [] - - adaptMeshPrimitive codecGltf buffers' codecMeshPrimitive' `shouldBe` loaderMeshPrimitive' - - it "ignores material when unspecified" $ do - buffers' <- buffers - - let codecMeshPrimitive' = mkCodecMeshPrimitive - { Mesh.material = Nothing } - loaderMeshPrimitive' = loaderMeshPrimitive & _meshPrimitiveMaterial .~ Nothing - - adaptMeshPrimitive codecGltf buffers' codecMeshPrimitive' - `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 - -loaderGltf :: Gltf -loaderGltf = Gltf - { gltfAsset = loaderAsset, - gltfMaterials = [loaderMaterial], - gltfMeshes = [loaderMesh], - gltfNodes = [loaderNode] - } - -loaderAsset :: Asset -loaderAsset = Asset - { assetVersion = "version", - assetCopyright = Just "copyright", - assetGenerator = Just "generator", - assetMinVersion = Just "minVersion" - } - -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 - { 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] - } - -loaderPbrMetallicRoughness :: PbrMetallicRoughness -loaderPbrMetallicRoughness = PbrMetallicRoughness - { pbrBaseColorFactor = V4 1.0 2.0 3.0 4.0, - 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] - } diff --git a/test/Text/GLTF/Loader/BufferAccessorSpec.hs b/test/Text/GLTF/Loader/BufferAccessorSpec.hs deleted file mode 100644 --- a/test/Text/GLTF/Loader/BufferAccessorSpec.hs +++ /dev/null @@ -1,94 +0,0 @@ -module Text.GLTF.Loader.BufferAccessorSpec (spec) where - -import Text.GLTF.Loader.BufferAccessor -import Text.GLTF.Loader.Decoders -import Text.GLTF.Loader.Test.MkGltf - -import Linear (V3(..)) -import Data.Binary.Builder -import Data.Binary.Get (runGet) -import Data.Binary.Put (putFloatle, runPut) -import Data.ByteString.Lazy (fromStrict, toStrict) -import RIO -import RIO.Vector.Partial ((!)) -import Test.Hspec -import qualified Codec.GlTF as GlTF -import qualified Codec.GlTF.Accessor as Accessor -import qualified Codec.GlTF.Buffer as Buffer -import qualified Codec.GlTF.BufferView as BufferView -import qualified Codec.GlTF.URI as URI - -spec :: Spec -spec = do - let gltf = mkCodecGltf - - describe "loadBuffers" $ do - it "Reads buffers from GlTF" $ do - buffers <- loadBuffers gltf - - let (GltfBuffer buffer') = buffers ! 0 - values = runGet (getScalar (fromIntegral <$> getUnsignedShort)) . fromStrict $ buffer' - - values `shouldBe` ([1..4] :: Vector Integer) - - it "Handles malformed URI" $ do - let gltf' = gltf - { GlTF.buffers = Just - [ mkCodecBufferIndices { Buffer.uri = Just $ URI.URI "uh oh!" } ] - } - - loadBuffers gltf' `shouldThrow` anyException - - it "Handles no buffer" $ do - let gltf' = gltf { GlTF.buffers = Nothing } - buffers <- loadBuffers gltf' - - buffers `shouldBe` [] - - describe "vertexIndices" $ do - it "Reads basic values from buffer" $ do - vertexIndices gltf buffers' accessorIdIndices `shouldBe` [1, 2, 3, 4] - - it "Returns empty when accessor not defined" $ do - let gltf' = gltf { GlTF.accessors = Nothing } - vertexIndices gltf' buffers' accessorIdIndices `shouldBe` [] - - it "Returns empty when buffer not found" $ do - let bufferView = mkCodecBufferViewIndices { BufferView.buffer = Buffer.BufferIx 99 } - gltf' = gltf { GlTF.bufferViews = Just [bufferView] } - vertexIndices gltf' buffers' accessorIdIndices `shouldBe` [] - - describe "vertexPositions" $ do - it "Reads basic values from buffer" $ do - vertexPositions gltf buffers' accessorIdPositions `shouldBe` - [ V3 1 1 1, - V3 2 2 2, - V3 3 3 3, - V3 4 4 4 - ] - - it "Returns empty when accessor not defined" $ do - let gltf' = gltf { GlTF.accessors = Nothing } - vertexPositions gltf' buffers' accessorIdPositions `shouldBe` [] - - it "Returns empty when buffer not found" $ do - let bufferView = mkCodecBufferViewIndices { BufferView.buffer = Buffer.BufferIx 99 } - gltf' = gltf { GlTF.bufferViews = Just [bufferView] } - vertexPositions gltf' buffers' accessorIdPositions `shouldBe` [] - -buffers' :: Vector GltfBuffer -buffers' = [bufferIndices, bufferPositions] - -accessorIdIndices :: Accessor.AccessorIx -accessorIdIndices = Accessor.AccessorIx 0 - -accessorIdPositions :: Accessor.AccessorIx -accessorIdPositions = Accessor.AccessorIx 1 - -bufferIndices :: GltfBuffer -bufferIndices = GltfBuffer . toStrict . toLazyByteString $ putIndices - where putIndices = foldr ((<>) . putWord16le) empty ([1, 2, 3, 4] :: [Word16]) - -bufferPositions :: GltfBuffer -bufferPositions = GltfBuffer . toStrict . runPut $ putPositions - where putPositions = mapM_ (replicateM_ 3 . putFloatle) ([1..4] :: [Float]) diff --git a/test/Text/GLTF/Loader/Internal/AdapterSpec.hs b/test/Text/GLTF/Loader/Internal/AdapterSpec.hs new file mode 100644 --- /dev/null +++ b/test/Text/GLTF/Loader/Internal/AdapterSpec.hs @@ -0,0 +1,350 @@ +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 + } diff --git a/test/Text/GLTF/Loader/Internal/BufferAccessorSpec.hs b/test/Text/GLTF/Loader/Internal/BufferAccessorSpec.hs new file mode 100644 --- /dev/null +++ b/test/Text/GLTF/Loader/Internal/BufferAccessorSpec.hs @@ -0,0 +1,162 @@ +module Text.GLTF.Loader.Internal.BufferAccessorSpec (spec) where + +import Text.GLTF.Loader.Internal.BufferAccessor +import Text.GLTF.Loader.Internal.Decoders +import Text.GLTF.Loader.Test.MkGltf + +import Linear (V3(..)) +import Data.Binary.Builder +import Data.Binary.Get (runGet) +import Data.Binary.Put (putFloatle, runPut) +import Data.ByteString.Lazy (fromStrict, toStrict) +import RIO +import RIO.Vector.Partial ((!)) +import Test.Hspec +import qualified Codec.GlTF as GlTF +import qualified Codec.GlTF.Accessor as Accessor +import qualified Codec.GlTF.Buffer as Buffer +import qualified Codec.GlTF.BufferView as BufferView +import qualified Codec.GlTF.Image as Image +import qualified Codec.GlTF.URI as URI + +spec :: Spec +spec = do + let gltf = mkCodecGltf + basePath = "." + + describe "loadBuffers" $ do + it "Reads buffers from GlTF" $ do + buffers <- loadBuffers gltf Nothing basePath + + let (GltfBuffer buffer') = buffers ! 0 + values = runGet (getScalar (fromIntegral <$> getUnsignedShort)) . fromStrict $ buffer' + + values `shouldBe` ([1..4] :: Vector Integer) + + it "Handles malformed URI" $ do + let gltf' = gltf + { GlTF.buffers = Just + [ mkCodecBufferIndices { Buffer.uri = Just $ URI.URI "uh oh!" } ] + } + + loadBuffers gltf' Nothing basePath `shouldThrow` anyException + + it "Handles no buffer" $ do + let gltf' = gltf { GlTF.buffers = Nothing } + buffers <- loadBuffers gltf' Nothing basePath + + buffers `shouldBe` [] + + it "Handles a chunk buffer" $ do + let chunk = mkCodecBufferChunk + + gltf' = gltf + { GlTF.buffers = Just + [ mkCodecBufferIndices { Buffer.uri = Nothing } ] + } + buffers <- loadBuffers gltf' (Just chunk) basePath + + let (GltfBuffer buffer') = buffers ! 0 + values = runGet (getScalar (fromIntegral <$> getUnsignedShort)) . fromStrict $ buffer' + + values `shouldBe` ([1..4] :: Vector Integer) + + it "Handles chunk + buffers" $ do + let chunk = mkCodecBufferChunk + + gltf' = gltf + { GlTF.buffers = Just + [ mkCodecBufferIndices { Buffer.uri = Nothing }, + mkCodecBufferIndices + ] + } + buffers <- loadBuffers gltf' (Just chunk) basePath + + let getValue = runGet (getScalar (fromIntegral <$> getUnsignedShort)) . fromStrict + + forM_ buffers $ \buffer -> do + let value = getValue . unBuffer $ buffer + value `shouldBe` ([1..4] :: Vector Integer) + + describe "loadImages" $ do + it "Reads image URIs from GlTF" $ do + images <- loadImages gltf basePath + images `shouldBe` [ImageData "imagePayload"] + + it "Reads image BufferViews from GlTF" $ do + let gltf' = gltf + { GlTF.images = Just + [ mkCodecImage { Image.uri = Nothing } ] + } + + images <- loadImages gltf' basePath + images `shouldBe` [ImageBufferView (BufferView.BufferViewIx 4)] + + it "Returns NoImage when no data specificed" $ do + let gltf' = gltf + { GlTF.images = Just + [ mkCodecImage + { Image.uri = Nothing, + Image.bufferView = Nothing + } + ] + } + + images <- loadImages gltf' basePath + images `shouldBe` [NoImageData] + + it "Handles malformed URIs" $ do + let gltf' = gltf + { GlTF.images = Just + [mkCodecImage { Image.uri = Just (URI.URI "Uh oh!") }] + } + + loadImages gltf' basePath `shouldThrow` anyException + + describe "vertexIndices" $ do + it "Reads basic values from buffer" $ do + vertexIndices gltf buffers' accessorIdIndices `shouldBe` [1, 2, 3, 4] + + it "Returns empty when accessor not defined" $ do + let gltf' = gltf { GlTF.accessors = Nothing } + vertexIndices gltf' buffers' accessorIdIndices `shouldBe` [] + + it "Returns empty when buffer not found" $ do + let bufferView = mkCodecBufferViewIndices { BufferView.buffer = Buffer.BufferIx 99 } + gltf' = gltf { GlTF.bufferViews = Just [bufferView] } + vertexIndices gltf' buffers' accessorIdIndices `shouldBe` [] + + describe "vertexPositions" $ do + it "Reads basic values from buffer" $ do + vertexPositions gltf buffers' accessorIdPositions `shouldBe` + [ V3 1 1 1, + V3 2 2 2, + V3 3 3 3, + V3 4 4 4 + ] + + it "Returns empty when accessor not defined" $ do + let gltf' = gltf { GlTF.accessors = Nothing } + vertexPositions gltf' buffers' accessorIdPositions `shouldBe` [] + + it "Returns empty when buffer not found" $ do + let bufferView = mkCodecBufferViewIndices { BufferView.buffer = Buffer.BufferIx 99 } + gltf' = gltf { GlTF.bufferViews = Just [bufferView] } + vertexPositions gltf' buffers' accessorIdPositions `shouldBe` [] + +buffers' :: Vector GltfBuffer +buffers' = [bufferIndices, bufferPositions] + +accessorIdIndices :: Accessor.AccessorIx +accessorIdIndices = Accessor.AccessorIx 0 + +accessorIdPositions :: Accessor.AccessorIx +accessorIdPositions = Accessor.AccessorIx 1 + +bufferIndices :: GltfBuffer +bufferIndices = GltfBuffer . toStrict . toLazyByteString $ putIndices + where putIndices = foldr ((<>) . putWord16le) empty ([1, 2, 3, 4] :: [Word16]) + +bufferPositions :: GltfBuffer +bufferPositions = GltfBuffer . toStrict . runPut $ putPositions + where putPositions = mapM_ (replicateM_ 3 . putFloatle) ([1..4] :: [Float]) diff --git a/test/Text/GLTF/Loader/Test/MkGltf.hs b/test/Text/GLTF/Loader/Test/MkGltf.hs --- a/test/Text/GLTF/Loader/Test/MkGltf.hs +++ b/test/Text/GLTF/Loader/Test/MkGltf.hs @@ -1,6 +1,6 @@ module Text.GLTF.Loader.Test.MkGltf where -import Text.GLTF.Loader.Adapter +import Text.GLTF.Loader.Internal.Adapter import Data.Binary.Builder import Data.Binary.Put (putFloatle, runPut) @@ -9,16 +9,22 @@ import Data.ByteString.Lazy (toStrict) import Foreign (Storable(..)) import Linear -import RIO +import RIO hiding (length) +import RIO.Text (length) +import qualified Codec.GLB as GLB import qualified Codec.GlTF as GlTF import qualified Codec.GlTF.Accessor as Accessor import qualified Codec.GlTF.Asset as Asset import qualified Codec.GlTF.Buffer as Buffer 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.PbrMetallicRoughness as PbrMetallicRoughness import qualified Codec.GlTF.Node as Node +import qualified Codec.GlTF.Sampler as Sampler +import qualified Codec.GlTF.Texture as Texture +import qualified Codec.GlTF.TextureInfo as TextureInfo import qualified Codec.GlTF.URI as URI import qualified Data.HashMap.Strict as HashMap @@ -38,23 +44,25 @@ [ mkCodecBufferIndices, mkCodecBufferPositions, mkCodecBufferNormals, - mkCodecBufferTexCoords + mkCodecBufferTexCoords, + mkCodecBufferImage ], bufferViews = Just [ mkCodecBufferViewIndices, mkCodecBufferViewPositions, mkCodecBufferViewNormals, - mkCodecBufferViewTexCoords + mkCodecBufferViewTexCoords, + mkCodecBufferViewImage ], cameras = Nothing, - images = Nothing, + images = Just [mkCodecImage], materials = Just [mkCodecMaterial], meshes = Just [mkCodecMesh], nodes = Just [mkCodecNode], - samplers = Nothing, + samplers = Just [mkCodecSampler], scenes = Nothing, skins = Nothing, - textures = Nothing, + textures = Just [mkCodecTexture], extensions = Nothing, extras = Nothing } @@ -185,6 +193,28 @@ extras = Nothing } +mkCodecBufferViewImage :: BufferView.BufferView +mkCodecBufferViewImage = BufferView.BufferView + { buffer = Buffer.BufferIx 4, + byteOffset = 0, + byteLength = length "imageData" * 4, + byteStride = Nothing, + target = Nothing, + name = Just "BufferView Image", + extensions = Nothing, + extras = Nothing + } + +mkCodecImage :: Image.Image +mkCodecImage = Image.Image + { uri = Just (URI.URI "data:image/jpg;base64,aW1hZ2VQYXlsb2Fk"), + mimeType = Just "image/png", + bufferView = Just $ BufferView.BufferViewIx 4, + name = Just "Image", + extensions = Nothing, + extras = Nothing + } + mkCodecBufferIndices :: Buffer.Buffer mkCodecBufferIndices = Buffer.Buffer { byteLength = sizeOf (undefined :: Word16) * 4, @@ -221,6 +251,15 @@ name = Just "Buffer Positions" } +mkCodecBufferImage :: Buffer.Buffer +mkCodecBufferImage = Buffer.Buffer + { byteLength = length "imageData" * 4, + uri = Just mkCodecBufferUriImage, + extensions = Nothing, + extras = Nothing, + name = Just "Buffer Image" + } + mkCodecMaterial :: Material.Material mkCodecMaterial = Material.Material { alphaCutoff = 1.0, @@ -251,7 +290,7 @@ metallicFactor = 1.0, roughnessFactor = 2.0, metallicRoughnessTexture = Nothing, - baseColorTexture = Nothing, + baseColorTexture = Just mkCodecBaseColorTexture, extensions = Nothing, extras = Nothing } @@ -259,7 +298,7 @@ mkCodecBufferUriIndices :: URI.URI mkCodecBufferUriIndices = URI.URI uriText where uriText = "data:application/octet-stream;base64," <> encodedText - encodedText = encodeBase64. toStrict . toLazyByteString $ putIndices + encodedText = encodeBase64 . toStrict . toLazyByteString $ putIndices putIndices = foldr ((<>) . putWord16le) empty ([1..4] :: [Word16]) mkCodecBufferUriNormals :: URI.URI @@ -280,6 +319,20 @@ encodedText = encodeBase64. toStrict . runPut $ putPositions putPositions = mapM_ (replicateM_ 2 . putFloatle) ([9..12] :: [Float]) +mkCodecBufferUriImage :: URI.URI +mkCodecBufferUriImage = URI.URI uriText + where uriText = "data:application/octet-stream;base64," <> encodedText + encodedText = encodeBase64 . toStrict $ "imageData" + +mkCodecBufferChunk :: GLB.Chunk +mkCodecBufferChunk = GLB.Chunk + { chunkLength = fromIntegral $ sizeOf (undefined :: Word16) * 4, + chunkType = 0x004E4942, + chunkData = binary + } + where binary = toStrict . toLazyByteString $ putIndices + putIndices = foldr ((<>) . putWord16le) empty ([1..4] :: [Word16]) + mkCodecMeshPrimitive :: Mesh.MeshPrimitive mkCodecMeshPrimitive = Mesh.MeshPrimitive { attributes = HashMap.fromList @@ -295,10 +348,19 @@ extras = Nothing } +mkCodecBaseColorTexture :: TextureInfo.TextureInfo_ +mkCodecBaseColorTexture = TextureInfo.TextureInfo + { extensions = Nothing, + extras = Nothing, + index = 15, + subtype = TextureInfo.Basic, + texCoord = 10 + } + mkCodecNode :: Node.Node mkCodecNode = Node.Node { camera = Nothing, - children = Nothing, + children = Just [Node.NodeIx 1], skin = Nothing, matrix = Nothing, mesh = Just (Mesh.MeshIx 5), @@ -307,6 +369,26 @@ translation = Just (8, 9, 10), weights = Just [11, 12, 13], name = Just "node", + extensions = Nothing, + extras = Nothing + } + +mkCodecSampler :: Sampler.Sampler +mkCodecSampler = Sampler.Sampler + { extensions = Nothing, + extras = Nothing, + magFilter = Just Sampler.MAG_LINEAR, + minFilter = Just Sampler.MIN_LINEAR, + name = Just "Sampler", + wrapS = Sampler.CLAMP_TO_EDGE, + wrapT = Sampler.REPEAT + } + +mkCodecTexture :: Texture.Texture +mkCodecTexture = Texture.Texture + { sampler = Just (Sampler.SamplerIx 0), + source = Just (Image.ImageIx 0), + name = Just "Texture", extensions = Nothing, extras = Nothing } diff --git a/test/Text/GLTF/LoaderSpec.hs b/test/Text/GLTF/LoaderSpec.hs --- a/test/Text/GLTF/LoaderSpec.hs +++ b/test/Text/GLTF/LoaderSpec.hs @@ -3,158 +3,223 @@ import Text.GLTF.Loader import Lens.Micro +import Lens.Micro.Platform () import Linear (V2(..), V3(..), V4(..)) import RIO import Test.Hspec spec :: Spec spec = do - describe "fromByteString" $ do + describe "fromJsonByteString" $ do it "Parses embedded gltf content" $ do gltfText <- readFileBinary "data/cube.gltf" - res <- fromByteString gltfText + res <- fromJsonByteString gltfText res `shouldSatisfy` has _Right it "Fails on invalid content" $ do - res <- fromByteString "Invalid GLTF" + res <- fromJsonByteString "Invalid GLTF" res `shouldSatisfy` has (_Left . _ReadError) - describe "fromFile" $ do - it "Parses embedded gltf file" $ do - gltf <- fromFile "data/cube.gltf" + describe "fromJsonFile" $ do + describe "Gltf embedded" $ gltfFromFileTests "data/cube.gltf" + describe "Gltf separate" $ gltfFromFileTests "data/cube-separate.gltf" + + describe "fromBinaryBinaryString" $ do + it "parses glb content" $ do + glb <- readFileBinary "data/cube.glb" + res <- fromBinaryByteString glb + res `shouldSatisfy` has _Right + + describe "fromBinaryFile" $ do + describe "Glb" $ glbFromFileTests "data/cube.glb" + +gltfFromFileTests :: FilePath -> Spec +gltfFromFileTests file = fromFileTests file fromJsonFile + +glbFromFileTests :: FilePath -> Spec +glbFromFileTests file = fromFileTests file fromFile + where fromFile path = do + glb <- fromBinaryFile path + pure $ over _Right (^. _gltf) glb + +fromFileTests + :: FilePath + -> (FilePath -> IO (Either Errors Gltf)) + -> Spec +fromFileTests file fromFile = do + it "Parses embedded gltf file" $ do + gltf <- fromFile file gltf `shouldSatisfy` has _Right - it "Parses expected nodes" $ do - gltf <- fromFile "data/cube.gltf" - let expected = Gltf - { gltfAsset = Asset - { assetVersion = "2.0", - assetGenerator = Just "Khronos glTF Blender I/O v3.2.40", - assetCopyright = Nothing, - assetMinVersion = Nothing - }, + it "Parses expected nodes" $ do + gltf <- fromFile file - gltfMaterials - = [ Material - { materialAlphaCutoff = 0.5, - materialAlphaMode = Opaque, - materialDoubleSided = True, - materialEmissiveFactor = V3 0.0 0.0 0.0, - materialName = Just "Material", - materialPbrMetallicRoughness = Just $ PbrMetallicRoughness - { pbrBaseColorFactor = V4 0.8 0.8 0.8 1.0, - pbrMetallicFactor = 0.0, - pbrRoughnessFactor = 0.4 - } - } - ], - - gltfMeshes - = [ Mesh - { meshPrimitives - = [ MeshPrimitive - { meshPrimitiveMode = Triangles, - meshPrimitiveIndices - = [ 1, 14, 20, 1, 20, 7, 10, 6, 19, 10, 19, 23, - 21, 18, 12, 21, 12, 15, 16, 3, 9, 16, 9, - 22, 5, 2, 8, 5, 8, 11, 17, 13, 0, 17, 0, 4 - ], - meshPrimitiveMaterial = Just 0, - meshPrimitivePositions - = [ V3 1.0 1.0 (-1.0), -- 1 - V3 1.0 1.0 (-1.0), -- 2 - V3 1.0 1.0 (-1.0), -- 3 - V3 1.0 (-1.0) (-1.0), -- 4 - V3 1.0 (-1.0) (-1.0), -- 5 - V3 1.0 (-1.0) (-1.0), -- 6 - V3 1.0 1.0 1.0, -- 7 - V3 1.0 1.0 1.0, -- 8 - V3 1.0 1.0 1.0, -- 9 - V3 1.0 (-1.0) 1.0, -- 10 - V3 1.0 (-1.0) 1.0, -- 11 - V3 1.0 (-1.0) 1.0, -- 12 - V3 (-1.0) 1.0 (-1.0), -- 13 - V3 (-1.0) 1.0 (-1.0), -- 14 - V3 (-1.0) 1.0 (-1.0), -- 15 - V3 (-1.0) (-1.0) (-1.0),-- 16 - V3 (-1.0) (-1.0) (-1.0),-- 17 - V3 (-1.0) (-1.0) (-1.0),-- 18 - V3 (-1.0) 1.0 1.0, -- 19 - V3 (-1.0) 1.0 1.0, -- 20 - V3 (-1.0) 1.0 1.0, -- 21 - V3 (-1.0) (-1.0) 1.0, -- 22 - V3 (-1.0) (-1.0) 1.0, -- 23 - V3 (-1.0) (-1.0) 1.0 -- 24 - ], - meshPrimitiveNormals - = [ V3 0.0 0.0 (-1.0), - V3 0.0 1.0 (-0.0), - V3 1.0 0.0 (-0.0), - V3 0.0 (-1.0) (-0.0), - V3 0.0 0.0 (-1.0), - V3 1.0 0.0 (-0.0), - V3 0.0 0.0 1.0, - V3 0.0 1.0 (-0.0), - V3 1.0 0.0 (-0.0), - V3 0.0 (-1.0) (-0.0), - V3 0.0 0.0 1.0, - V3 1.0 0.0 (-0.0), - V3 (-1.0) 0.0 (-0.0), - V3 0.0 0.0 (-1.0), - V3 0.0 1.0 (-0.0), - V3 (-1.0) 0.0 (-0.0), - V3 0.0 (-1.0) (-0.0), - V3 0.0 0.0 (-1.0), - V3 (-1.0) 0.0 (-0.0), - V3 0.0 0.0 1.0, - V3 0.0 1.0 (-0.0), - V3 (-1.0) 0.0 (-0.0), - V3 0.0 (-1.0) (-0.0), - V3 0.0 0.0 1.0 - ], - meshPrimitiveTexCoords - = [ V2 0.625 0.5, - V2 0.625 0.5, - V2 0.625 0.5, - V2 0.375 0.5, - V2 0.375 0.5, - V2 0.375 0.5, - V2 0.625 0.25, - V2 0.625 0.25, - V2 0.625 0.25, - V2 0.375 0.25, - V2 0.375 0.25, - V2 0.375 0.25, - V2 0.625 0.75, - V2 0.625 0.75, - V2 0.875 0.5, - V2 0.375 0.75, - V2 0.125 0.5, - V2 0.375 0.75, - V2 0.625 1.0, - V2 0.625 0.0, - V2 0.875 0.25, - V2 0.375 1.0, - V2 0.125 0.25, - V2 0.375 0.0 - ] - } - ], - meshWeights = [], - meshName = Just "Cube" - } - ], + let gltf' = gltf ^?! _Right - gltfNodes - = [ Node - { nodeMeshId = Just 0, - nodeName = Just "Cube", - nodeRotation = Nothing, - nodeScale = Nothing, - nodeTranslation = Nothing, - nodeWeights = [] - } - ] - } - - gltf `shouldBe` Right expected + gltf' ^? _asset `shouldBe` Just expectedAsset + gltf' ^?! _images `shouldSatisfy` \images -> + images ^? _head . _imageMimeType == Just "image/png" && + images ^? _head . _imageName == Just (Just "Untitled") + gltf' ^? _materials `shouldBe` Just expectedMaterials + gltf' ^? _meshes `shouldBe` Just expectedMeshes + gltf' ^? _nodes `shouldBe` Just expectedNodes + gltf' ^? _samplers `shouldBe` Just expectedSamplers + gltf' ^? _textures `shouldBe` Just expectedTextures + +expectedAsset :: Asset +expectedAsset = Asset + { assetVersion = "2.0", + assetGenerator = Just "Khronos glTF Blender I/O v3.3.27", + assetCopyright = Nothing, + assetMinVersion = Nothing + } + +expectedMaterials :: Vector Material +expectedMaterials + = [ Material + { materialAlphaCutoff = 0.5, + materialAlphaMode = Opaque, + materialDoubleSided = True, + materialEmissiveFactor = V3 0.0 0.0 0.0, + materialName = Just "Material", + materialPbrMetallicRoughness = Just $ PbrMetallicRoughness + { pbrBaseColorFactor = V4 1 1 1 1, + pbrBaseColorTexture = Just $ TextureInfo + { textureId = 0, + textureTexCoord = 0 + }, + pbrMetallicFactor = 0.0, + pbrRoughnessFactor = 0.5 + } + } + ] + +expectedMeshes :: Vector Mesh +expectedMeshes + = [ Mesh + { meshPrimitives + = [ MeshPrimitive + { meshPrimitiveMode = Triangles, + meshPrimitiveIndices + = [ 1, 14, 20, 1, 20, 7, 10, 6, 19, 10, 19, 23, + 21, 18, 12, 21, 12, 15, 16, 3, 9, 16, 9, + 22, 5, 2, 8, 5, 8, 11, 17, 13, 0, 17, 0, 4 + ], + meshPrimitiveMaterial = Just 0, + meshPrimitivePositions + = [ V3 1.0 1.0 (-1.0), -- 1 + V3 1.0 1.0 (-1.0), -- 2 + V3 1.0 1.0 (-1.0), -- 3 + V3 1.0 (-1.0) (-1.0), -- 4 + V3 1.0 (-1.0) (-1.0), -- 5 + V3 1.0 (-1.0) (-1.0), -- 6 + V3 1.0 1.0 1.0, -- 7 + V3 1.0 1.0 1.0, -- 8 + V3 1.0 1.0 1.0, -- 9 + V3 1.0 (-1.0) 1.0, -- 10 + V3 1.0 (-1.0) 1.0, -- 11 + V3 1.0 (-1.0) 1.0, -- 12 + V3 (-1.0) 1.0 (-1.0), -- 13 + V3 (-1.0) 1.0 (-1.0), -- 14 + V3 (-1.0) 1.0 (-1.0), -- 15 + V3 (-1.0) (-1.0) (-1.0),-- 16 + V3 (-1.0) (-1.0) (-1.0),-- 17 + V3 (-1.0) (-1.0) (-1.0),-- 18 + V3 (-1.0) 1.0 1.0, -- 19 + V3 (-1.0) 1.0 1.0, -- 20 + V3 (-1.0) 1.0 1.0, -- 21 + V3 (-1.0) (-1.0) 1.0, -- 22 + V3 (-1.0) (-1.0) 1.0, -- 23 + V3 (-1.0) (-1.0) 1.0 -- 24 + ], + meshPrimitiveNormals + = [ V3 0.0 0.0 (-1.0), + V3 0.0 1.0 (-0.0), + V3 1.0 0.0 (-0.0), + V3 0.0 (-1.0) (-0.0), + V3 0.0 0.0 (-1.0), + V3 1.0 0.0 (-0.0), + V3 0.0 0.0 1.0, + V3 0.0 1.0 (-0.0), + V3 1.0 0.0 (-0.0), + V3 0.0 (-1.0) (-0.0), + V3 0.0 0.0 1.0, + V3 1.0 0.0 (-0.0), + V3 (-1.0) 0.0 (-0.0), + V3 0.0 0.0 (-1.0), + V3 0.0 1.0 (-0.0), + V3 (-1.0) 0.0 (-0.0), + V3 0.0 (-1.0) (-0.0), + V3 0.0 0.0 (-1.0), + V3 (-1.0) 0.0 (-0.0), + V3 0.0 0.0 1.0, + V3 0.0 1.0 (-0.0), + V3 (-1.0) 0.0 (-0.0), + V3 0.0 (-1.0) (-0.0), + V3 0.0 0.0 1.0 + ], + meshPrimitiveTexCoords + = [ V2 0.625 0.5, + V2 0.625 0.5, + V2 0.625 0.5, + V2 0.375 0.5, + V2 0.375 0.5, + V2 0.375 0.5, + V2 0.625 0.25, + V2 0.625 0.25, + V2 0.625 0.25, + V2 0.375 0.25, + V2 0.375 0.25, + V2 0.375 0.25, + V2 0.625 0.75, + V2 0.625 0.75, + V2 0.875 0.5, + V2 0.375 0.75, + V2 0.125 0.5, + V2 0.375 0.75, + V2 0.625 1.0, + V2 0.625 0.0, + V2 0.875 0.25, + V2 0.375 1.0, + V2 0.125 0.25, + V2 0.375 0.0 + ] + } + ], + meshWeights = [], + meshName = Just "Cube" + } + ] + +expectedNodes :: Vector Node +expectedNodes = + [ Node + { nodeChildren = [], + nodeMeshId = Just 0, + nodeName = Just "Cube", + nodeRotation = Nothing, + nodeScale = Nothing, + nodeTranslation = Nothing, + nodeWeights = [] + } + ] + +expectedSamplers :: Vector Sampler +expectedSamplers + = [ Sampler + { samplerMagFilter = Just MagLinear, + samplerMinFilter = Just MinLinearMipmapLinear, + samplerName = Nothing, + samplerWrapS = Repeat, + samplerWrapT = Repeat + } + ] + +expectedTextures :: Vector Texture +expectedTextures + = [ Texture + { textureName = Nothing, + textureSamplerId = Just 0, + textureSourceId = Just 0 + } + ]