Animation.hs

module Codec.GlTF.Animation
  ( AnimationIx(..)
  , Animation(..)

  , AnimationSamplerIx(..)
  , AnimationSampler(..)
  , AnimationSamplerInterpolation(..)
  , pattern LINEAR
  , pattern STEP
  , pattern CUBICSPLINE

  , AnimationChannel(..)

  , AnimationChannelTarget(..)
  , AnimationChannelTargetPath(..)
  , pattern TRANSLATION
  , pattern ROTATION
  , pattern SCALE
  , pattern WEIGHTS
  ) where

import Codec.GlTF.Prelude

import Codec.GlTF.Accessor (AccessorIx)
import Codec.GlTF.Node (NodeIx)

newtype AnimationIx = AnimationIx { unAnimationIx :: Int }
  deriving (Eq, Ord, Show, FromJSON, ToJSON, Generic)

-- | A keyframe animation.
data Animation = Animation
  { channels :: Vector AnimationChannel
  , samplers :: Vector AnimationSampler

  , name       :: Maybe Text
  , extensions :: Maybe Object
  , extras     :: Maybe Value
  } deriving (Eq, Show, Generic)

instance FromJSON Animation
instance ToJSON Animation

newtype AnimationSamplerIx = AnimationSamplerIx { unAnimationSamplerIx :: Int }
  deriving (Eq, Ord, Show, FromJSON, ToJSON, Generic)

-- | Combines input and output accessors with an interpolation algorithm
-- to define a keyframe graph (but not its target).
data AnimationSampler = AnimationSampler
  { input         :: AccessorIx
    -- ^ The values represent time in seconds with @time[0] >= 0.0@,
    -- and strictly increasing values.
  , interpolation :: AnimationSamplerInterpolation
  , output        :: AccessorIx
    -- ^ The index of an accessor containing keyframe output values.
  , extensions    :: Maybe Object
  , extras        :: Maybe Value
  } deriving (Eq, Show, Generic)

instance FromJSON AnimationSampler where
  parseJSON = withObject "AnimationSampler" \o -> do
    input         <- o .:  "input"
    interpolation <- o .:? "interpolation" .!= LINEAR
    output        <- o .:  "output"
    extensions    <- o .:? "extensions"
    extras        <- o .:? "extras"

    pure AnimationSampler{..}

instance ToJSON AnimationSampler

newtype AnimationSamplerInterpolation = AnimationSamplerInterpolation { unAnimationSamplerInterpolation :: Text }
  deriving (Eq, Ord, Show, FromJSON, ToJSON, Generic)

pattern LINEAR :: AnimationSamplerInterpolation
pattern LINEAR = AnimationSamplerInterpolation "LINEAR"

pattern STEP :: AnimationSamplerInterpolation
pattern STEP = AnimationSamplerInterpolation "STEP"

pattern CUBICSPLINE :: AnimationSamplerInterpolation
pattern CUBICSPLINE = AnimationSamplerInterpolation "CUBICSPLINE"

-- | Targets an animation's sampler at a node's property.
data AnimationChannel = AnimationChannel
  { sampler    :: AnimationSamplerIx
  , target     :: AnimationChannelTarget
  , extensions :: Maybe Object
  , extras     :: Maybe Value
  } deriving (Eq, Show, Generic)

instance FromJSON AnimationChannel
instance ToJSON AnimationChannel

-- | The index of the node and TRS property that an animation channel targets.
data AnimationChannelTarget = AnimationChannelTarget
  { node       :: Maybe NodeIx
  , path       :: AnimationChannelTargetPath
  , extensions :: Maybe Object
  , extras     :: Maybe Value
  } deriving (Eq, Show, Generic)

instance FromJSON AnimationChannelTarget
instance ToJSON AnimationChannelTarget

-- | The name of the node's TRS property to modify, or the @weights@ of
-- the Morph Targets it instantiates.
-- For the @translation@ property, the values that are provided by
-- the sampler are the translation along the x, y, and z axes.
-- For the @rotation@ property, the values are a quaternion in
-- the order (x, y, z, w), where w is the scalar.
-- For the @scale@ property, the values are the scaling factors
-- along the x, y, and z axes.",
newtype AnimationChannelTargetPath = AnimationChannelTargetPath { unAnimationChannelTargetPath :: Text } -- XXX: T/R/S/weights/any
  deriving (Eq, Ord, Show, FromJSON, ToJSON, Generic)

pattern TRANSLATION :: AnimationChannelTargetPath
pattern TRANSLATION = AnimationChannelTargetPath "translation"

pattern ROTATION :: AnimationChannelTargetPath
pattern ROTATION = AnimationChannelTargetPath "rotation"

pattern SCALE :: AnimationChannelTargetPath
pattern SCALE = AnimationChannelTargetPath "scale"

pattern WEIGHTS :: AnimationChannelTargetPath
pattern WEIGHTS = AnimationChannelTargetPath "weights"