diff --git a/src/Text/GLTF/Loader/Gltf.hs b/src/Text/GLTF/Loader/Gltf.hs index 7ff4917..74b3dba 100644 --- a/src/Text/GLTF/Loader/Gltf.hs +++ b/src/Text/GLTF/Loader/Gltf.hs @@ -2,6 +2,10 @@ module Text.GLTF.Loader.Gltf ( -- * Data constructors Gltf (..), Asset (..), + Animation (..), + Channel (..), + ChannelSamplerInterpolation (..), + ChannelSamplerOutput (..), Image (..), MagFilter (..), MinFilter (..), @@ -106,6 +110,7 @@ import RIO -- | The root data type for a glTF asset data Gltf = Gltf { gltfAsset :: Asset, + gltfAnimations :: Vector Animation, gltfImages :: Vector Image, gltfMaterials :: Vector Material, gltfMeshes :: Vector Mesh, @@ -129,6 +134,16 @@ data Asset = Asset } deriving (Eq, Show) +-- | Keyframe animations for tranforming and morphing scene nodes +data Animation = Animation + { -- | Defines the animation keyframes for up to one of each from translation + -- , rotation, scale and morph weights. + animationChannels :: Vector Channel, + -- | The user-defined name of this object. + animationName :: Maybe Text + } + deriving (Eq, Show) + -- | Image data used to create a texture. data Image = Image { -- | The binary data of the image @@ -320,6 +335,32 @@ data TextureInfo = TextureInfo } deriving (Eq, Show) +data Channel = Channel + { -- | The target node to apply this channel of the animation to. + channelTargetNode :: Maybe Int, + -- | The interpolation to use for inputs between each animation keyframe + -- sample. + channelSamplerInterpolation :: ChannelSamplerInterpolation, + -- | The timestamps of each of the animation's keyframes. + channelSamplerInputs :: Vector Float, + -- | The values representing the animated property of each keyframe. + channelSamplerOutputs :: ChannelSamplerOutput + } + deriving (Eq, Show) + +data ChannelSamplerOutput + = MorphTargetWeights (Vector Float) + | Rotation (Vector (Quaternion Float)) + | Scale (Vector (V3 Float)) + | Translation (Vector (V3 Float)) + deriving (Eq, Show) + +data ChannelSamplerInterpolation + = CubicSpline + | Linear + | Step + deriving (Eq, Show) + -- | Reference to a normal map texture data NormalTextureInfo = NormalTextureInfo { -- | The index of the texture. diff --git a/src/Text/GLTF/Loader/Internal/Adapter.hs b/src/Text/GLTF/Loader/Internal/Adapter.hs index d76fb46..46aa895 100644 --- a/src/Text/GLTF/Loader/Internal/Adapter.hs +++ b/src/Text/GLTF/Loader/Internal/Adapter.hs @@ -8,6 +8,7 @@ module Text.GLTF.Loader.Internal.Adapter runAdapter, adaptGltf, adaptAsset, + adaptAnimations, adaptImages, adaptMaterials, adaptMeshes, @@ -33,6 +34,7 @@ import Text.GLTF.Loader.Internal.MonadAdapter import qualified Codec.GlTF as GlTF import qualified Codec.GlTF.Asset as Asset +import qualified Codec.GlTF.Animation as Animation import qualified Codec.GlTF.Image as Image import qualified Codec.GlTF.Material as Material import qualified Codec.GlTF.Mesh as Mesh @@ -77,12 +79,14 @@ adaptGltf :: Adapter Gltf adaptGltf = do GlTF.GlTF{..} <- getGltf + gltfAnimations <- adaptAnimations animations gltfImages <- adaptImages images gltfMeshes <- adaptMeshes meshes return $ Gltf { gltfAsset = adaptAsset asset, + gltfAnimations = gltfAnimations, gltfImages = gltfImages, gltfMaterials = adaptMaterials materials, gltfMeshes = gltfMeshes, @@ -101,6 +105,51 @@ adaptAsset Asset.Asset{..} = assetMinVersion = minVersion } +adaptAnimations + :: Maybe (Vector Animation.Animation) + -> Adapter (Vector Animation) +adaptAnimations = maybe (return mempty) (mapM adaptAnimation) + +adaptAnimation :: Animation.Animation -> Adapter Animation +adaptAnimation Animation.Animation{..} = do + gltfChannels <- mapM (adaptAnimationChannel samplers) channels + return + $ Animation + { animationChannels = gltfChannels, + animationName = name + } + +adaptAnimationChannel + :: Vector Animation.AnimationSampler + -> Animation.AnimationChannel + -> Adapter Channel +adaptAnimationChannel samplers Animation.AnimationChannel{..} = do + gltf <- getGltf + buffers <- getBuffers + let Animation.AnimationSampler{ input, interpolation, output } = + samplers ! Animation.unAnimationSamplerIx sampler + Animation.AnimationChannelTarget{ node, path } = target + outputs = case path of + Animation.ROTATION -> Rotation $ animationSamplerRotationOutputs gltf buffers output + Animation.SCALE -> Scale $ animationSamplerScaleOutputs gltf buffers output + Animation.TRANSLATION -> Translation $ animationSamplerTranslationOutputs gltf buffers output + Animation.WEIGHTS -> MorphTargetWeights $ animationSamplerWeightsOutputs gltf buffers output + _ -> error $ "Invalid Channel path: " <> show path + return + $ Channel + { channelTargetNode = fmap Node.unNodeIx node, + channelSamplerInterpolation = adaptInterpolation interpolation, + channelSamplerInputs = animationSamplerInputs gltf buffers input, + channelSamplerOutputs = outputs + } + +adaptInterpolation :: Animation.AnimationSamplerInterpolation -> ChannelSamplerInterpolation +adaptInterpolation Animation.CUBICSPLINE = CubicSpline +adaptInterpolation Animation.LINEAR = Linear +adaptInterpolation Animation.STEP = Step +adaptInterpolation (Animation.AnimationSamplerInterpolation interpolation) = + error $ "Invalid ChannelSamplerInterpolation: " <> show interpolation + adaptImages :: Maybe (Vector Image.Image) -> Adapter (Vector Image) adaptImages codecImages = do imageData <- getImages diff --git a/src/Text/GLTF/Loader/Internal/BufferAccessor.hs b/src/Text/GLTF/Loader/Internal/BufferAccessor.hs index 1e9ff6a..12687e1 100644 --- a/src/Text/GLTF/Loader/Internal/BufferAccessor.hs +++ b/src/Text/GLTF/Loader/Internal/BufferAccessor.hs @@ -7,6 +7,11 @@ module Text.GLTF.Loader.Internal.BufferAccessor loadImages, -- * Deserializing Accessors + animationSamplerInputs, + animationSamplerRotationOutputs, + animationSamplerScaleOutputs, + animationSamplerTranslationOutputs, + animationSamplerWeightsOutputs, vertexIndices, vertexPositions, vertexNormals, @@ -88,6 +93,35 @@ loadImages GlTF{images = images} basePath = do let fallbackImageData = return $ maybe NoImageData ImageBufferView bufferView maybe fallbackImageData (fmap ImageData . loadUri' basePath) uri +animationSamplerInputs :: GlTF -> Vector GltfBuffer -> AccessorIx -> Vector Float +animationSamplerInputs = readBufferWithGet (getScalar getFloat) + +animationSamplerRotationOutputs :: GlTF -> Vector GltfBuffer -> AccessorIx -> Vector (Quaternion Float) +animationSamplerRotationOutputs gltf buffers' accessorId = + fromMaybe (error "Invalid animation sampler output component type.") $ do + buffer@BufferAccessor{componentType = componentType} <- + bufferAccessor gltf buffers' accessorId + + case componentType of + FLOAT -> Just . readFromBuffer (Proxy @(Quaternion Float)) (getQuaternion getFloat) $ buffer + _ -> Nothing + +animationSamplerScaleOutputs :: GlTF -> Vector GltfBuffer -> AccessorIx -> Vector (V3 Float) +animationSamplerScaleOutputs = readBufferWithGet (getVec3 getFloat) + +animationSamplerTranslationOutputs :: GlTF -> Vector GltfBuffer -> AccessorIx -> Vector (V3 Float) +animationSamplerTranslationOutputs = readBufferWithGet (getVec3 getFloat) + +animationSamplerWeightsOutputs :: GlTF -> Vector GltfBuffer -> AccessorIx -> Vector Float +animationSamplerWeightsOutputs gltf buffers' accessorId = + fromMaybe (error "Invalid animation sampler output component type.") $ do + buffer@BufferAccessor{componentType = componentType} <- + bufferAccessor gltf buffers' accessorId + + case componentType of + FLOAT -> Just . readFromBuffer (Proxy @Float) (getScalar getFloat) $ buffer + _ -> Nothing + -- | Decode vertex indices vertexIndices :: GlTF -> Vector GltfBuffer -> AccessorIx -> Vector Word32 vertexIndices gltf buffers' accessorId = diff --git a/src/Text/GLTF/Loader/Internal/Decoders.hs b/src/Text/GLTF/Loader/Internal/Decoders.hs index 12b30b2..8a762aa 100644 --- a/src/Text/GLTF/Loader/Internal/Decoders.hs +++ b/src/Text/GLTF/Loader/Internal/Decoders.hs @@ -18,6 +18,7 @@ module Text.GLTF.Loader.Internal.Decoders getMat2, getMat3, getMat4, + getQuaternion, -- * GLTF Component Type decoders getByte, @@ -121,6 +122,14 @@ getMat4 getter = {- FOURMOLU_DISABLE -} +-- | Quaternion binary decoder +getQuaternion :: Get a -> Get (Vector (Quaternion a)) +getQuaternion getter = getVector $ do + v3 <- V3 <$> getter <*> getter <*> getter + Quaternion + <$> getter + <*> pure v3 + -- | Byte binary decoder getByte :: Get Int8 getByte = getInt8