diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 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 - { 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 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 @@ -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 <> + ")" + diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -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 diff --git a/data/big-cube.gltf b/data/big-cube.gltf new file mode 100644 # file too large to diff: data/big-cube.gltf diff --git a/gltf-loader.cabal b/gltf-loader.cabal --- a/gltf-loader.cabal +++ b/gltf-loader.cabal @@ -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 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 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,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 diff --git a/src/Text/GLTF/Loader/Adapter.hs b/src/Text/GLTF/Loader/Adapter.hs --- a/src/Text/GLTF/Loader/Adapter.hs +++ b/src/Text/GLTF/Loader/Adapter.hs @@ -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 diff --git a/src/Text/GLTF/Loader/BufferAccessor.hs b/src/Text/GLTF/Loader/BufferAccessor.hs --- a/src/Text/GLTF/Loader/BufferAccessor.hs +++ b/src/Text/GLTF/Loader/BufferAccessor.hs @@ -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 diff --git a/src/Text/GLTF/Loader/Decoders.hs b/src/Text/GLTF/Loader/Decoders.hs new file mode 100644 --- /dev/null +++ b/src/Text/GLTF/Loader/Decoders.hs @@ -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 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,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 }) diff --git a/test/Text/GLTF/Loader/AdapterSpec.hs b/test/Text/GLTF/Loader/AdapterSpec.hs --- a/test/Text/GLTF/Loader/AdapterSpec.hs +++ b/test/Text/GLTF/Loader/AdapterSpec.hs @@ -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] } diff --git a/test/Text/GLTF/Loader/BufferAccessorSpec.hs b/test/Text/GLTF/Loader/BufferAccessorSpec.hs --- a/test/Text/GLTF/Loader/BufferAccessorSpec.hs +++ b/test/Text/GLTF/Loader/BufferAccessorSpec.hs @@ -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 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,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 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,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 = [],