gltf-loader 0.1.0.0 → 0.2.0.0

raw patch · 15 files changed

+812/−245 lines, 15 filesdep +microlens-platformPVP ok

version bump matches the API change (PVP)

Dependencies added: microlens-platform

API changes (from Hackage documentation)

Files

• README.md +13/−13
• app/Command/GLTF/Loader/App.hs +7/−1
• app/Command/GLTF/Loader/Run.hs +92/−13
• app/Main.hs +11/−2
• data/big-cube.gltf too large to diff
• gltf-loader.cabal +4/−1
• src/Text/GLTF/Loader.hs +11/−13
• src/Text/GLTF/Loader/Adapter.hs +56/−11
• src/Text/GLTF/Loader/BufferAccessor.hs +30/−130
• src/Text/GLTF/Loader/Decoders.hs +157/−0
• src/Text/GLTF/Loader/Gltf.hs +151/−40
• test/Text/GLTF/Loader/AdapterSpec.hs +65/−8
• test/Text/GLTF/Loader/BufferAccessorSpec.hs +2/−2
• test/Text/GLTF/Loader/Test/MkGltf.hs +144/−9
• test/Text/GLTF/LoaderSpec.hs +69/−2

@@ -57,19 +57,19 @@ Currently, only retreiving indices are supported, but we hope to support the majority of GlTF features: -[] Animitions-[] Asset-[] Cameras-[] Images-[] Materials-[x] Meshes-  [x] Positions-  [x] Indices-  [] Normals-  [] Texture Coordinates-[] Node-[] Samplers-[] Skins+ - [ ] Animitions+ - [ ] Asset+ - [ ] Cameras+ - [ ] Images+ - [ ] Materials+ - [x] Meshes+    - [x] Positions+    - [x] Indices+    - [ ] Normals+    - [ ] Texture Coordinates+ - [ ] Node+ - [ ] Samplers+ - [ ] Skins  ## Authors 

@@ -5,7 +5,8 @@  -- | Command line arguments data Options = Options-  { optionsVerbose :: !Bool,+  { optionsSummary :: !Bool,+    optionsVerbose :: !Bool,     optionsFile :: FilePath   } @@ -27,6 +28,11 @@  instance HasOptions App where   optionsL = lens appOptions (\app opts -> app { appOptions = opts })++_optionsSummary :: Lens' Options Bool+_optionsSummary = lens+  optionsSummary+  (\opts summary -> opts { optionsSummary = summary })  _optionsVerbose :: Lens' Options Bool _optionsVerbose = lens

@@ -4,38 +4,64 @@ import Text.GLTF.Loader  import Lens.Micro-import Linear (V3(..))+import Lens.Micro.Platform ()+import Linear (V3(..), V4(..)) import RIO-import RIO.List (nub)+import qualified RIO.Vector.Boxed as Vector  run :: RIO App () run = do-  file <- asks $ view (optionsL . _optionsFile)-  logInfo $ "File: " <> fromString file+  options <- asks (^. optionsL)+  let file = options ^. _optionsFile+      summary = options ^. _optionsSummary+      verbose = options ^. _optionsVerbose +  logInfo $ "File: " <> fromString file   result <- liftIO $ fromFile file-  either reportError reportGltf result +  either reportError (reporter verbose summary) result++reporter :: Bool -> Bool -> (Gltf -> RIO App ())+reporter True _ = reportVerbose+reporter _ True = reportSummary+reporter _ _ = reportGltf+ reportError :: HasLogFunc logger => Errors -> RIO logger () reportError err   = logError (display err)   >> exitFailure +reportVerbose :: Gltf -> RIO App ()+reportVerbose gltf = do+  reportAsset $ gltf ^. _asset++  logInfo "" -- Blank line++  reportNodes gltf $ reportMeshVerbose gltf++reportSummary :: Gltf -> RIO App ()+reportSummary gltf = do+  reportAsset $ gltf ^. _asset+  +  logInfo "" -- Blank line++  reportNodes gltf reportMeshSummary+ reportGltf :: Gltf -> RIO App () reportGltf gltf = do   reportAsset $ gltf ^. _asset      logInfo "" -- Blank line -  reportNodes gltf+  reportNodes gltf $ reportMesh gltf  reportAsset :: Asset -> RIO App () reportAsset asset = do   logInfo $ "Generator: " <> asset ^. _assetGenerator . to (fromMaybe "Unknown") . to display   logInfo $ "Version: " <> asset ^. _assetVersion . to display -reportNodes :: Gltf -> RIO App ()-reportNodes gltf = do+reportNodes :: Gltf -> (Mesh -> RIO App ()) -> RIO App ()+reportNodes gltf meshReporter = do   let nodes = gltf ^. _nodes   logInfo $ "Nodes: " <> display (RIO.length nodes) @@ -44,20 +70,63 @@      forM_ (node ^. _nodeMeshId) $ \meshId -> do       logInfo "  Mesh: "-      forM_ (gltf ^. _meshes  ^? ix meshId) reportMesh-        +      forM_ (gltf ^. _meshes ^? ix meshId) meshReporter -reportMesh :: Mesh -> RIO App ()-reportMesh mesh = do+reportMeshVerbose :: Gltf -> Mesh -> RIO App ()+reportMeshVerbose gltf mesh = do   logInfo $ "    Name: " <> mesh ^. _meshName . to (display . fromMaybe "Unknown")   logInfo "    Mesh Primitives:"    forM_ (mesh ^. _meshPrimitives) $ \primitive' -> do+    -- Report Vertices+    logInfo "      Vertices:"++    let positions = primitive' ^. _meshPrimitivePositions+    forM_ (primitive' ^. _meshPrimitiveIndices) $ \index -> do+      forM_ (positions Vector.!? index) $ \position -> do+        logInfo $ "        [" <> display index <> "]: " <> displayV3 position++    -- Report material+    forM_ (primitive' ^. _meshPrimitiveMaterial) $ \materialId -> do+      forM_ (gltf ^. _materials . to (Vector.!? materialId)) reportMaterial+    +reportMesh :: Gltf -> Mesh -> RIO App ()+reportMesh gltf mesh = do+  logInfo $ "    Name: " <> mesh ^. _meshName . to (display . fromMaybe "Unknown")+  logInfo "    Mesh Primitives:"++  forM_ (mesh ^. _meshPrimitives) $ \primitive' -> do     logInfo "      Vertex Positions:" -    forM_ (nub $ primitive' ^. _meshPrimitivePositions) $ \position -> do+    forM_ (Vector.uniq $ primitive' ^. _meshPrimitivePositions) $ \position -> do       logInfo $ "        " <> displayV3 position++    -- Report material+    forM_ (primitive' ^. _meshPrimitiveMaterial) $ \materialId -> do+      forM_ (gltf ^. _materials . to (Vector.!? materialId)) reportMaterial++reportMeshSummary :: Mesh -> RIO App ()+reportMeshSummary mesh = do+  logInfo $ "    Name: " <> mesh ^. _meshName . to (display . fromMaybe "Unknown")++  let primitives' = mesh ^. _meshPrimitives+      vertices = Vector.concatMap (^. _meshPrimitivePositions) primitives'+      indices = Vector.concatMap (^. _meshPrimitiveIndices) primitives'++  logInfo $ "    Unique Vertices: " <> display (length vertices)+  logInfo $ "    Total Vertices: " <> display (length indices)++reportMaterial :: Material -> RIO App ()+reportMaterial material = do+  logInfo $ "      Material:"+  logInfo $ "        Name: " <>+    material ^. _materialName . to (display . fromMaybe "Unknown")   +  forM_ (material ^. _materialPbrMetallicRoughness) $ \pbr -> do+    logInfo $ "        Base Color Factor: " <> pbr ^. _pbrBaseColorFactor . to displayV4+    logInfo $ "        Metallic Factor: " <> pbr ^. _pbrMetallicFactor . to display+    logInfo $ "        Roughness Factor: " <> pbr ^. _pbrRoughnessFactor . to display+   displayV3 :: Display a => V3 a -> Utf8Builder displayV3 (V3 x y z)   = "("@@ -65,3 +134,13 @@   <> display y <> ", "   <> display z <>   ")"++displayV4 :: Display a => V4 a -> Utf8Builder+displayV4 (V4 w x y z)+  = "("+  <> display w <> ", "+  <> display x <> ", "+  <> display y <> ", "+  <> display z <>+  ")"+

@@ -12,7 +12,7 @@ main :: IO () main = do   (options', _) <- parseOptions-  logOptions <- logOptionsHandle stderr (optionsVerbose options')+  logOptions <- logOptionsHandle stderr False   processContext <- mkDefaultProcessContext    runApp processContext options' logOptions run@@ -39,7 +39,16 @@           }  options :: Parser Options-options = Options <$> switch verboseOption <*> strArgument fileArg+options = Options+  <$> switch summaryOption+  <*> switch verboseOption+  <*> strArgument fileArg++summaryOption :: Mod FlagFields Bool+summaryOption+  = long "summary"+    <> short 's'+    <> help "Compact output?"  verboseOption :: Mod FlagFields Bool verboseOption

file too large to diff

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           gltf-loader-version:        0.1.0.0+version:        0.2.0.0 synopsis:       High level GlTF loader description:    Please see the README on Github at <https://github.com/sgillespie/haskell-gltf-loader#readme> category:       Graphics@@ -19,6 +19,7 @@ build-type:     Simple extra-source-files:     README.md+    data/big-cube.gltf     data/cube.gltf     data/invalid.gltf @@ -31,6 +32,7 @@       Text.GLTF.Loader       Text.GLTF.Loader.Adapter       Text.GLTF.Loader.BufferAccessor+      Text.GLTF.Loader.Decoders       Text.GLTF.Loader.Errors       Text.GLTF.Loader.Gltf   other-modules:@@ -142,6 +144,7 @@     , gltf-loader     , linear     , microlens+    , microlens-platform     , optparse-simple     , rio >=0.1.12.0   default-language: Haskell2010

@@ -1,9 +1,14 @@+ module Text.GLTF.Loader-  ( fromByteString,+  ( -- * Scene loading functions     fromFile,-    -    module Text.GLTF.Loader.Errors,-    module Text.GLTF.Loader.Gltf+    fromByteString,++    -- * GLTF Types+    module Text.GLTF.Loader.Gltf,++    -- * Loading Errors+    module Text.GLTF.Loader.Errors   ) where  import Text.GLTF.Loader.Adapter@@ -14,20 +19,13 @@ import Data.Either import Lens.Micro import RIO-    ( Monad((>>=)),-      IsString(fromString),-      String,-      (<$>),-      (.),-      MonadIO(liftIO),-      MonadUnliftIO,-      ByteString,-      FilePath ) import qualified Codec.GlTF as GlTF +-- | Load a glTF scene from a ByteString fromByteString :: MonadUnliftIO io => ByteString -> io (Either Errors Gltf) fromByteString =  toGltfResult . GlTF.fromByteString +-- | Load a glTF scene from a file fromFile :: MonadUnliftIO io => FilePath -> io (Either Errors Gltf) fromFile path = liftIO (GlTF.fromFile path) >>= toGltfResult   

@@ -2,12 +2,17 @@ module Text.GLTF.Loader.Adapter   ( attributePosition,     attributeNormal,+    attributeTexCoord,     adaptGltf,     adaptAsset,+    adaptMaterials,     adaptMeshes,     adaptNodes,+    adaptMaterial,     adaptMesh,     adaptNode,+    adaptAlphaMode,+    adaptPbrMetallicRoughness,     adaptMeshPrimitives,     adaptMeshPrimitive,     adaptMeshPrimitiveMode@@ -21,6 +26,8 @@ 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@@ -31,10 +38,13 @@ 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     }@@ -47,16 +57,29 @@     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)-  -> [Mesh]-adaptMeshes gltf buffers' = maybe [] (map (adaptMesh gltf buffers') . toList)+  -> Vector Mesh+adaptMeshes gltf buffers' = maybe mempty (fmap $ adaptMesh gltf buffers') -adaptNodes :: Maybe (Vector GlTF.Node.Node) -> [Node]-adaptNodes = maybe [] (map adaptNode . toList)+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@@ -64,7 +87,7 @@   -> Mesh adaptMesh gltf buffers' GlTF.Mesh.Mesh{..} = Mesh     { meshPrimitives = adaptMeshPrimitives gltf buffers' primitives,-      meshWeights = maybe [] toList weights,+      meshWeights = fromMaybe mempty weights,       meshName = name     } @@ -78,12 +101,29 @@     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-  -> [MeshPrimitive]-adaptMeshPrimitives gltf buffers' = map (adaptMeshPrimitive gltf buffers') . toList+  -> Vector MeshPrimitive+adaptMeshPrimitives gltf = fmap . adaptMeshPrimitive gltf  adaptMeshPrimitive   :: GlTF.GlTF@@ -91,12 +131,17 @@   -> GlTF.Mesh.MeshPrimitive   -> MeshPrimitive adaptMeshPrimitive gltf buffers' GlTF.Mesh.MeshPrimitive{..} = MeshPrimitive-    { meshPrimitiveMode = adaptMeshPrimitiveMode mode,-      meshPrimitiveIndices = maybe [] (vertexIndices gltf buffers') indices,-      meshPrimitivePositions = maybe [] (vertexPositions gltf buffers') positions,-      meshPrimitiveNormals = []+    { 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

@@ -6,27 +6,11 @@     vertexIndices,     vertexPositions,     vertexNormals,-    -- * Binary Get decoders-    -- ** Specific Type decoders-    getIndices,-    getPositions,-    -- ** GLTF Accessor Type decoders-    getScalar,-    getVec2,-    getVec3,-    getVec4,-    getMat2,-    getMat3,-    getMat4,-    -- ** GLTF Component Type decoders-    getByte,-    getUnsignedByte,-    getShort,-    getUnsignedShort,-    getUnsignedInt,-    getFloat+    vertexTexCoords,   ) where +import Text.GLTF.Loader.Decoders+ import Codec.GlTF.Accessor import Codec.GlTF.Buffer import Codec.GlTF.BufferView@@ -40,15 +24,18 @@ 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@@ -66,27 +53,36 @@          return $ GltfBuffer payload -vertexIndices :: GlTF -> Vector GltfBuffer -> AccessorIx -> [Int]+-- | Decode vertex indices+vertexIndices :: GlTF -> Vector GltfBuffer -> AccessorIx -> Vector Int vertexIndices = readBufferWithGet getIndices -vertexPositions :: GlTF -> Vector GltfBuffer -> AccessorIx -> [V3 Float]+-- | Decode vertex positions+vertexPositions :: GlTF -> Vector GltfBuffer -> AccessorIx -> Vector (V3 Float) vertexPositions = readBufferWithGet getPositions -vertexNormals :: GlTF -> Vector GltfBuffer -> AccessorIx -> [V3 Float]-vertexNormals = undefined+-- | 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 [storable]+  => Get (Vector storable)   -> GlTF   -> Vector GltfBuffer   -> AccessorIx-  -> [storable]+  -> Vector storable readBufferWithGet getter gltf buffers' accessorId-  = maybe []+  = maybe mempty       (readFromBuffer undefined getter)       (bufferAccessor gltf buffers' accessorId) +-- | Look up a Buffer from a GlTF and AccessorIx bufferAccessor   :: GlTF   -> Vector GltfBuffer@@ -106,131 +102,35 @@       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 [storable]+  -> Get (Vector storable)   -> BufferAccessor-  -> [storable]+  -> Vector storable readFromBuffer storable getter BufferAccessor{..}   = runGet getter (fromStrict payload')   where payload' = ByteString.take len' . ByteString.drop offset . unBuffer $ buffer         len' = count * sizeOf storable--getIndices :: Get [Int]-getIndices = getScalar (fromIntegral <$> getUnsignedShort)--getPositions :: Get [V3 Float]-getPositions = getVec3 getFloat--getScalar :: Get a -> Get [a]-getScalar = getList--getVec2 :: Get a -> Get [V2 a]-getVec2 getter = getList $ V2 <$> getter <*> getter--getVec3 :: Get a -> Get [V3 a]-getVec3 getter = getList $ V3 <$> getter <*> getter <*> getter--getVec4 :: Get a -> Get [V4 a]-getVec4 getter = getList $ V4 <$> getter <*> getter <*> getter <*> getter--getMat2 :: Get a -> Get [M22 a]-getMat2 getter = getList $ 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)--getMat3 :: Get a -> Get [M33 a]-getMat3 getter = getList $ 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)--getMat4 :: Get a -> Get [M44 a]-getMat4 getter = getList $ 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)--getByte :: Get Int8-getByte = getInt8--getUnsignedByte :: Get Word8-getUnsignedByte = getWord8--getShort :: Get Int16-getShort = getInt16le--getUnsignedShort :: Get Word16-getUnsignedShort = getWord16le--getUnsignedInt :: Get Word32-getUnsignedInt = getWord32le--getFloat :: Get Float-getFloat = getFloatle--getList :: Get a -> Get [a]-getList getter = do-  empty <- isEmpty-  if empty-    then return []-    else (:) <$> getter <*> getList getter

@@ -0,0 +1,157 @@+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

@@ -2,43 +2,65 @@   ( -- * Data constructors     Gltf(..),     Asset(..),+    Material(..),+    MaterialAlphaMode(..),     Mesh(..),     Node(..),     MeshPrimitive(..),+    PbrMetallicRoughness(..),     MeshPrimitiveMode(..),     -- * Lenses     _asset,+    _materials,     _meshes,     _nodes,+    -- ** Asset Lenses     _assetVersion,     _assetCopyright,     _assetGenerator,     _assetMinVersion,+    -- ** Material Lenses+    _materialAlphaCutoff,+    _materialAlphaMode,+    _materialDoubleSided,+    _materialEmissiveFactor,+    _materialName,+    _materialPbrMetallicRoughness,+    -- ** Mesh Lenses     _meshPrimitives,-    _meshPrimitiveMode,-    _meshPrimitiveIndices,-    _meshPrimitivePositions,-    _meshPrimitiveNormals,     _meshWeights,     _meshName,+    -- ** Node Lenses     _nodeMeshId,     _nodeName,     _nodeRotation,     _nodeScale,     _nodeTranslation,-    _nodeWeights+    _nodeWeights,+    -- ** MeshPrimitive Lenses+    _meshPrimitiveMaterial,+    _meshPrimitiveIndices,+    _meshPrimitiveMode,+    _meshPrimitiveNormals,+    _meshPrimitivePositions,+    -- ** PbrMetallicRoughness Lenses+    _pbrBaseColorFactor,+    _pbrMetallicFactor,+    _pbrRoughnessFactor   ) where -import Linear.V3 (V3(..))-import Linear.V4 (V4(..))+import Linear import RIO +-- | The root data type for a glTF asset data Gltf = Gltf   { gltfAsset :: Asset,-    gltfMeshes :: [Mesh],-    gltfNodes :: [Node] }-  deriving (Eq, Show)+    gltfMaterials :: Vector Material,+    gltfMeshes :: Vector Mesh,+    gltfNodes :: Vector Node+  } deriving (Eq, Show) +-- | Metadata about the glTF asset data Asset = Asset   { assetVersion :: Text,     assetCopyright :: Maybe Text,@@ -46,12 +68,24 @@     assetMinVersion :: Maybe Text   } deriving (Eq, Show) +-- | The material appearance of a primitive+data Material = Material+  { materialAlphaCutoff :: Float,+    materialAlphaMode :: MaterialAlphaMode,+    materialDoubleSided :: Bool,+    materialEmissiveFactor :: V3 Float,+    materialName :: Maybe Text,+    materialPbrMetallicRoughness :: Maybe PbrMetallicRoughness+  } deriving (Eq, Show)++-- | A set of primitives to be rendered data Mesh = Mesh-  { meshPrimitives :: [MeshPrimitive],-    meshWeights :: [Float],+  { meshPrimitives :: Vector MeshPrimitive,+    meshWeights :: Vector Float,     meshName :: Maybe Text   } deriving (Eq, Show) +-- | A node in the node hierarchy data Node = Node   { nodeMeshId :: Maybe Int,     nodeName :: Maybe Text,@@ -61,13 +95,32 @@     nodeWeights :: [Float]   } deriving (Eq, Show) +-- | Geometry to be rendered with the given material data MeshPrimitive = MeshPrimitive-  { meshPrimitiveMode :: MeshPrimitiveMode,-    meshPrimitiveIndices :: [Int],-    meshPrimitivePositions :: [V3 Float],-    meshPrimitiveNormals :: [V3 Float]+  { meshPrimitiveIndices :: Vector Int,+    meshPrimitiveMaterial :: Maybe Int,+    meshPrimitiveMode :: MeshPrimitiveMode,+    meshPrimitiveNormals :: Vector (V3 Float),+    meshPrimitivePositions :: Vector (V3 Float),+    meshPrimitiveTexCoords :: Vector (V2 Float)   } deriving (Eq, Show) +-- | Alpha rendering mode of a material+data MaterialAlphaMode+  = Blend+  | Mask+  | 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,+    pbrMetallicFactor :: Float,+    pbrRoughnessFactor :: Float+  } deriving (Eq, Show)++-- | The topology type of primitives to render. data MeshPrimitiveMode   = Points   | Lines@@ -81,10 +134,13 @@ _asset :: Lens' Gltf Asset _asset = lens gltfAsset (\gltf asset -> gltf { gltfAsset = asset }) -_meshes :: Lens' Gltf [Mesh]+_materials :: Lens' Gltf (Vector Material)+_materials = lens gltfMaterials (\gltf mats -> gltf { gltfMaterials = mats })++_meshes :: Lens' Gltf (Vector Mesh) _meshes = lens gltfMeshes (\gltf meshes -> gltf { gltfMeshes = meshes }) -_nodes :: Lens' Gltf [Node]+_nodes :: Lens' Gltf (Vector Node) _nodes = lens gltfNodes (\gltf nodes -> gltf { gltfNodes = nodes })  _assetVersion :: Lens' Asset Text@@ -105,37 +161,47 @@   assetMinVersion   (\asset minVersion' -> asset { assetMinVersion = minVersion' }) -_meshPrimitives :: Lens' Mesh [MeshPrimitive]-_meshPrimitives = lens-  meshPrimitives-  (\mesh primitives -> mesh { meshPrimitives = primitives })+_materialAlphaCutoff :: Lens' Material Float+_materialAlphaCutoff = lens+  materialAlphaCutoff+  (\material alphaCutoff -> material { materialAlphaCutoff = alphaCutoff }) -_meshPrimitiveMode :: Lens' MeshPrimitive MeshPrimitiveMode-_meshPrimitiveMode = lens-  meshPrimitiveMode-  (\primitive' mode -> primitive' { meshPrimitiveMode = mode })+_materialAlphaMode :: Lens' Material MaterialAlphaMode+_materialAlphaMode = lens+  materialAlphaMode+  (\material mode -> material { materialAlphaMode = mode }) -_meshPrimitiveIndices :: Lens' MeshPrimitive [Int]-_meshPrimitiveIndices = lens-  meshPrimitiveIndices-  (\primitive' indices -> primitive' { meshPrimitiveIndices = indices })+_materialDoubleSided :: Lens' Material Bool+_materialDoubleSided = lens+  materialDoubleSided+  (\material doubleSided -> material { materialDoubleSided = doubleSided }) -_meshPrimitivePositions :: Lens' MeshPrimitive [V3 Float]-_meshPrimitivePositions = lens-  meshPrimitivePositions-  (\primitive' positions -> primitive' { meshPrimitivePositions = positions })+_materialEmissiveFactor :: Lens' Material (V3 Float)+_materialEmissiveFactor = lens+  materialEmissiveFactor+  (\material emissiveFactor -> material { materialEmissiveFactor = emissiveFactor }) -_meshPrimitiveNormals :: Lens' MeshPrimitive [V3 Float]-_meshPrimitiveNormals = lens-  meshPrimitiveNormals-  (\primitive' normals -> primitive' { meshPrimitiveNormals = normals })-  -_meshWeights :: Lens' Mesh [Float]+_materialName :: Lens' Material (Maybe Text)+_materialName = lens+  materialName+  (\material name -> material { materialName = name })++_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 })  _meshName :: Lens' Mesh (Maybe Text) _meshName = lens meshName (\mesh name -> mesh { meshName = name }) +_meshPrimitives :: Lens' Mesh (Vector MeshPrimitive)+_meshPrimitives = lens+  meshPrimitives+  (\mesh primitives -> mesh { meshPrimitives = primitives })+ _nodeMeshId :: Lens' Node (Maybe Int) _nodeMeshId = lens nodeMeshId (\node meshId -> node { nodeMeshId = meshId }) @@ -155,3 +221,48 @@  _nodeWeights :: Lens' Node [Float] _nodeWeights = lens nodeWeights (\node weights' -> node { nodeWeights = weights' })++_meshPrimitiveIndices :: Lens' MeshPrimitive (Vector Int)+_meshPrimitiveIndices = lens+  meshPrimitiveIndices+  (\primitive' indices -> primitive' { meshPrimitiveIndices = indices })++_meshPrimitiveMaterial :: Lens' MeshPrimitive (Maybe Int)+_meshPrimitiveMaterial = lens+  meshPrimitiveMaterial+  (\primitive' material -> primitive' { meshPrimitiveMaterial = material })++_meshPrimitiveMode :: Lens' MeshPrimitive MeshPrimitiveMode+_meshPrimitiveMode = lens+  meshPrimitiveMode+  (\primitive' mode -> primitive' { meshPrimitiveMode = mode })++_meshPrimitiveNormals :: Lens' MeshPrimitive (Vector (V3 Float))+_meshPrimitiveNormals = lens+  meshPrimitiveNormals+  (\primitive' normals -> primitive' { meshPrimitiveNormals = normals })++_meshPrimitivePositions :: Lens' MeshPrimitive (Vector (V3 Float))+_meshPrimitivePositions = lens+  meshPrimitivePositions+  (\primitive' positions -> primitive' { meshPrimitivePositions = positions })++_meshPrimitiveTexCoords :: Lens' MeshPrimitive (Vector (V2 Float))+_meshPrimitiveTexCoords = lens+  meshPrimitiveTexCoords+  (\primitive' coords -> primitive' { meshPrimitiveTexCoords = coords })+  +_pbrBaseColorFactor :: Lens' PbrMetallicRoughness (V4 Float)+_pbrBaseColorFactor = lens+  pbrBaseColorFactor+  (\pbr baseColor -> pbr { pbrBaseColorFactor = baseColor })+  +_pbrMetallicFactor :: Lens' PbrMetallicRoughness Float+_pbrMetallicFactor = lens+  pbrMetallicFactor+  (\pbr metallicFactor -> pbr { pbrMetallicFactor = metallicFactor })++_pbrRoughnessFactor :: Lens' PbrMetallicRoughness Float+_pbrRoughnessFactor = lens+  pbrRoughnessFactor+  (\pbr roughnessFactor -> pbr { pbrRoughnessFactor = roughnessFactor })

@@ -5,9 +5,10 @@ import Text.GLTF.Loader.Gltf import Text.GLTF.Loader.Test.MkGltf -import Linear (V3(..), V4(..))+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 @@ -45,6 +46,20 @@       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 }@@ -86,6 +101,14 @@       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 }@@ -103,13 +126,27 @@   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' = set _meshPrimitiveIndices [] loaderMeshPrimitive-      -      adaptMeshPrimitive codecGltf buffers' codecMeshPrimitive `shouldBe` loaderMeshPrimitive+          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@@ -129,6 +166,7 @@ loaderGltf :: Gltf loaderGltf = Gltf   { gltfAsset = loaderAsset,+    gltfMaterials = [loaderMaterial],     gltfMeshes = [loaderMesh],     gltfNodes = [loaderNode]   }@@ -141,6 +179,16 @@     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],@@ -158,10 +206,19 @@     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-  { meshPrimitiveMode = Triangles,-    meshPrimitiveIndices = [1..4],-    meshPrimitivePositions = map (\x -> V3 x x x) [1..4],-    meshPrimitiveNormals = []+  { 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]   }

@@ -1,6 +1,7 @@ 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(..))@@ -28,7 +29,7 @@       let (GltfBuffer buffer') = buffers ! 0           values = runGet (getScalar (fromIntegral <$> getUnsignedShort)) . fromStrict $ buffer'       -      values `shouldBe` ([1..4] :: [Integer])+      values `shouldBe` ([1..4] :: Vector Integer)      it "Handles malformed URI" $ do       let gltf' = gltf@@ -43,7 +44,6 @@       buffers <- loadBuffers gltf'        buffers `shouldBe` []-          describe "vertexIndices" $ do     it "Reads basic values from buffer" $ do

@@ -1,20 +1,23 @@ module Text.GLTF.Loader.Test.MkGltf where -import Text.GLTF.Loader.Adapter (attributePosition)+import Text.GLTF.Loader.Adapter  import Data.Binary.Builder import Data.Binary.Put (putFloatle, runPut)+ import Data.ByteString.Base64 (encodeBase64) import Data.ByteString.Lazy (toStrict) import Foreign (Storable(..))-import Linear (V3(..))+import Linear import RIO 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.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.URI as URI import qualified Data.HashMap.Strict as HashMap@@ -24,13 +27,28 @@   { asset = mkCodecAsset,     extensionsUsed = Nothing,     extensionsRequired = Nothing,-    accessors = Just [mkCodecAccessorIndices, mkCodecAccessorPositions],+    accessors = Just+      [ mkCodecAccessorIndices,+        mkCodecAccessorPositions,+        mkCodecAccessorNormals,+        mkCodecAccessorTexCoords+      ],     animations = Nothing,-    buffers = Just [mkCodecBufferIndices, mkCodecBufferPositions],-    bufferViews = Just [mkCodecBufferViewIndices, mkCodecBufferViewPositions],+    buffers = Just+      [ mkCodecBufferIndices,+        mkCodecBufferPositions,+        mkCodecBufferNormals,+        mkCodecBufferTexCoords+      ],+    bufferViews = Just+      [ mkCodecBufferViewIndices,+        mkCodecBufferViewPositions,+        mkCodecBufferViewNormals,+        mkCodecBufferViewTexCoords+      ],     cameras = Nothing,     images = Nothing,-    materials = Nothing,+    materials = Just [mkCodecMaterial],     meshes = Just [mkCodecMesh],     nodes = Just [mkCodecNode],     samplers = Nothing,@@ -68,6 +86,23 @@     type' = Accessor.AttributeType "SCALAR"   } +mkCodecAccessorNormals :: Accessor.Accessor+mkCodecAccessorNormals = Accessor.Accessor+  {+    bufferView = Just $ BufferView.BufferViewIx 2,+    byteOffset = 0,+    componentType = Accessor.ComponentType 5126,+    count = 4,+    extensions = Nothing,+    extras = Nothing,+    max = Nothing,+    min = Nothing,+    name = Just "Accessor Normals",+    normalized = False,+    sparse = Nothing,+    type' = Accessor.AttributeType "VEC3"+  }+ mkCodecAccessorPositions :: Accessor.Accessor mkCodecAccessorPositions = Accessor.Accessor   {@@ -82,9 +117,26 @@     name = Just "Accessor Positions",     normalized = False,     sparse = Nothing,-    type' = Accessor.AttributeType "VEC3"+    type' = Accessor.AttributeType "VEC2"   } +mkCodecAccessorTexCoords :: Accessor.Accessor+mkCodecAccessorTexCoords = Accessor.Accessor+  {+    bufferView = Just $ BufferView.BufferViewIx 3,+    byteOffset = 0,+    componentType = Accessor.ComponentType 5126,+    count = 4,+    extensions = Nothing,+    extras = Nothing,+    max = Nothing,+    min = Nothing,+    name = Just "Accessor Texture Coordinates",+    normalized = False,+    sparse = Nothing,+    type' = Accessor.AttributeType "VEC2"+  }+ mkCodecBufferViewIndices :: BufferView.BufferView mkCodecBufferViewIndices = BufferView.BufferView   { buffer = Buffer.BufferIx 0,@@ -97,6 +149,18 @@     extras = Nothing   } +mkCodecBufferViewNormals :: BufferView.BufferView+mkCodecBufferViewNormals = BufferView.BufferView+  { buffer = Buffer.BufferIx 2,+    byteOffset = 0,+    byteLength = sizeOf (undefined :: V3 Float) * 4,+    byteStride = Nothing,+    target = Nothing,+    name = Just "BufferView Normals",+    extensions = Nothing,+    extras = Nothing+  }+ mkCodecBufferViewPositions :: BufferView.BufferView mkCodecBufferViewPositions = BufferView.BufferView   { buffer = Buffer.BufferIx 1,@@ -109,6 +173,18 @@     extras = Nothing   } +mkCodecBufferViewTexCoords :: BufferView.BufferView+mkCodecBufferViewTexCoords = BufferView.BufferView+  { buffer = Buffer.BufferIx 3,+    byteOffset = 0,+    byteLength = sizeOf (undefined :: V2 Float) * 4,+    byteStride = Nothing,+    target = Nothing,+    name = Just "BufferView Positions",+    extensions = Nothing,+    extras = Nothing+  }+ mkCodecBufferIndices :: Buffer.Buffer mkCodecBufferIndices = Buffer.Buffer   { byteLength = sizeOf (undefined :: Word16) * 4,@@ -118,6 +194,15 @@     name = Just "Buffer Indices"   } +mkCodecBufferNormals :: Buffer.Buffer+mkCodecBufferNormals = Buffer.Buffer+  { byteLength = sizeOf (undefined :: V3 Float) * 4,+    uri = Just mkCodecBufferUriNormals,+    extensions = Nothing,+    extras = Nothing,+    name = Just "Buffer Positions"+  }+ mkCodecBufferPositions :: Buffer.Buffer mkCodecBufferPositions = Buffer.Buffer   { byteLength = sizeOf (undefined :: V3 Float) * 4,@@ -127,6 +212,30 @@     name = Just "Buffer Positions"   } +mkCodecBufferTexCoords :: Buffer.Buffer+mkCodecBufferTexCoords = Buffer.Buffer+  { byteLength = sizeOf (undefined :: V2 Float) * 4,+    uri = Just mkCodecBufferUriTexCoords,+    extensions = Nothing,+    extras = Nothing,+    name = Just "Buffer Positions"+  }++mkCodecMaterial :: Material.Material+mkCodecMaterial = Material.Material+  { alphaCutoff = 1.0,+    emissiveFactor = (1.0, 2.0, 3.0),+    alphaMode = Material.OPAQUE,+    doubleSided = True,+    pbrMetallicRoughness = Just mkCodecPbrMetallicRoughness,+    normalTexture = Nothing,+    occlusionTexture = Nothing,+    emissiveTexture = Nothing,+    name = Just "Material",+    extensions = Nothing,+    extras = Nothing+  }+ mkCodecMesh :: Mesh.Mesh mkCodecMesh = Mesh.Mesh   { primitives = [mkCodecMeshPrimitive],@@ -136,25 +245,51 @@     extras = Nothing   } +mkCodecPbrMetallicRoughness :: PbrMetallicRoughness.PbrMetallicRoughness+mkCodecPbrMetallicRoughness = PbrMetallicRoughness.PbrMetallicRoughness+  { baseColorFactor = (1.0, 2.0, 3.0, 4.0),+    metallicFactor = 1.0,+    roughnessFactor = 2.0,+    metallicRoughnessTexture = Nothing,+    baseColorTexture = Nothing,+    extensions = Nothing,+    extras = Nothing+  }+ mkCodecBufferUriIndices :: URI.URI mkCodecBufferUriIndices = URI.URI uriText   where uriText = "data:application/octet-stream;base64," <> encodedText         encodedText = encodeBase64. toStrict . toLazyByteString $ putIndices         putIndices = foldr ((<>) . putWord16le) empty ([1..4] :: [Word16]) +mkCodecBufferUriNormals :: URI.URI+mkCodecBufferUriNormals = URI.URI uriText+  where uriText = "data:application/octet-stream;base64," <> encodedText+        encodedText = encodeBase64. toStrict . runPut $ putPositions+        putPositions = mapM_ (replicateM_ 3 . putFloatle) ([5..8] :: [Float])+ mkCodecBufferUriPositions :: URI.URI mkCodecBufferUriPositions = URI.URI uriText   where uriText = "data:application/octet-stream;base64," <> encodedText         encodedText = encodeBase64. toStrict . runPut $ putPositions         putPositions = mapM_ (replicateM_ 3 . putFloatle) ([1..4] :: [Float]) +mkCodecBufferUriTexCoords :: URI.URI+mkCodecBufferUriTexCoords = URI.URI uriText+  where uriText = "data:application/octet-stream;base64," <> encodedText+        encodedText = encodeBase64. toStrict . runPut $ putPositions+        putPositions = mapM_ (replicateM_ 2 . putFloatle) ([9..12] :: [Float])+ mkCodecMeshPrimitive :: Mesh.MeshPrimitive mkCodecMeshPrimitive = Mesh.MeshPrimitive   { attributes = HashMap.fromList-      [(attributePosition, Accessor.AccessorIx 1)],+      [ (attributePosition, Accessor.AccessorIx 1),+        (attributeNormal, Accessor.AccessorIx 2),+        (attributeTexCoord, Accessor.AccessorIx 3)+      ],     mode = Mesh.MeshPrimitiveMode 4,     indices = Just $ Accessor.AccessorIx 0,-    material = Nothing,+    material = Just $ Material.MaterialIx 1,     targets = Nothing,     extensions = Nothing,     extras = Nothing

@@ -3,7 +3,7 @@ import Text.GLTF.Loader  import Lens.Micro-import Linear (V3(..))+import Linear (V2(..), V3(..), V4(..)) import RIO import Test.Hspec @@ -34,6 +34,21 @@                   assetMinVersion = Nothing                 }, +              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@@ -44,6 +59,7 @@                                        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@@ -70,7 +86,58 @@                                         V3 (-1.0) (-1.0) 1.0,   -- 23                                         V3 (-1.0) (-1.0) 1.0    -- 24                                       ],-                                 meshPrimitiveNormals = []+                                 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 = [],