module Codec.GlTF.Node
  ( NodeIx(..)
  , Node(..)
  , NodeMatrix(..)

    -- XXX: Misplaced here due to mutual recursion.
  , SkinIx(..)
  , Skin(..)
  ) where

import Codec.GlTF.Prelude

import Codec.GlTF.Accessor (AccessorIx)
import Codec.GlTF.Camera (CameraIx)
import Codec.GlTF.Mesh (MeshIx)

newtype NodeIx = NodeIx { NodeIx -> Int
unNodeIx :: Int }
  deriving (NodeIx -> NodeIx -> Bool
(NodeIx -> NodeIx -> Bool)
-> (NodeIx -> NodeIx -> Bool) -> Eq NodeIx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeIx -> NodeIx -> Bool
$c/= :: NodeIx -> NodeIx -> Bool
== :: NodeIx -> NodeIx -> Bool
$c== :: NodeIx -> NodeIx -> Bool
Eq, Eq NodeIx
Eq NodeIx
-> (NodeIx -> NodeIx -> Ordering)
-> (NodeIx -> NodeIx -> Bool)
-> (NodeIx -> NodeIx -> Bool)
-> (NodeIx -> NodeIx -> Bool)
-> (NodeIx -> NodeIx -> Bool)
-> (NodeIx -> NodeIx -> NodeIx)
-> (NodeIx -> NodeIx -> NodeIx)
-> Ord NodeIx
NodeIx -> NodeIx -> Bool
NodeIx -> NodeIx -> Ordering
NodeIx -> NodeIx -> NodeIx
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NodeIx -> NodeIx -> NodeIx
$cmin :: NodeIx -> NodeIx -> NodeIx
max :: NodeIx -> NodeIx -> NodeIx
$cmax :: NodeIx -> NodeIx -> NodeIx
>= :: NodeIx -> NodeIx -> Bool
$c>= :: NodeIx -> NodeIx -> Bool
> :: NodeIx -> NodeIx -> Bool
$c> :: NodeIx -> NodeIx -> Bool
<= :: NodeIx -> NodeIx -> Bool
$c<= :: NodeIx -> NodeIx -> Bool
< :: NodeIx -> NodeIx -> Bool
$c< :: NodeIx -> NodeIx -> Bool
compare :: NodeIx -> NodeIx -> Ordering
$ccompare :: NodeIx -> NodeIx -> Ordering
$cp1Ord :: Eq NodeIx
Ord, Int -> NodeIx -> ShowS
[NodeIx] -> ShowS
NodeIx -> String
(Int -> NodeIx -> ShowS)
-> (NodeIx -> String) -> ([NodeIx] -> ShowS) -> Show NodeIx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeIx] -> ShowS
$cshowList :: [NodeIx] -> ShowS
show :: NodeIx -> String
$cshow :: NodeIx -> String
showsPrec :: Int -> NodeIx -> ShowS
$cshowsPrec :: Int -> NodeIx -> ShowS
Show, Value -> Parser [NodeIx]
Value -> Parser NodeIx
(Value -> Parser NodeIx)
-> (Value -> Parser [NodeIx]) -> FromJSON NodeIx
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [NodeIx]
$cparseJSONList :: Value -> Parser [NodeIx]
parseJSON :: Value -> Parser NodeIx
$cparseJSON :: Value -> Parser NodeIx
FromJSON, [NodeIx] -> Encoding
[NodeIx] -> Value
NodeIx -> Encoding
NodeIx -> Value
(NodeIx -> Value)
-> (NodeIx -> Encoding)
-> ([NodeIx] -> Value)
-> ([NodeIx] -> Encoding)
-> ToJSON NodeIx
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [NodeIx] -> Encoding
$ctoEncodingList :: [NodeIx] -> Encoding
toJSONList :: [NodeIx] -> Value
$ctoJSONList :: [NodeIx] -> Value
toEncoding :: NodeIx -> Encoding
$ctoEncoding :: NodeIx -> Encoding
toJSON :: NodeIx -> Value
$ctoJSON :: NodeIx -> Value
ToJSON, (forall x. NodeIx -> Rep NodeIx x)
-> (forall x. Rep NodeIx x -> NodeIx) -> Generic NodeIx
forall x. Rep NodeIx x -> NodeIx
forall x. NodeIx -> Rep NodeIx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NodeIx x -> NodeIx
$cfrom :: forall x. NodeIx -> Rep NodeIx x
Generic)

-- | A node in the node hierarchy.
--
-- When the node contains skin, all mesh.primitives must contain JOINTS_0 and WEIGHTS_0 attributes.
--
-- A node can have either a matrix or any combination of translation/rotation/scale (TRS) properties.
--
-- TRS properties are converted to matrices and postmultiplied in the T * R * S order to
-- compose the transformation matrix; first the scale is applied to the vertices, then
-- the rotation, and then the translation.
-- If none are provided, the transform is the identity.
--
-- When a node is targeted for animation (referenced by an animation.channel.target),
-- only TRS properties may be present; matrix will not be present.
data Node = Node
  { Node -> Maybe CameraIx
camera :: Maybe CameraIx
  , Node -> Maybe (Vector NodeIx)
children    :: Maybe (Vector NodeIx)
  , Node -> Maybe SkinIx
skin        :: Maybe SkinIx
  , Node -> Maybe NodeMatrix
matrix      :: Maybe NodeMatrix
  , Node -> Maybe MeshIx
mesh        :: Maybe MeshIx
  , Node -> Maybe (Float, Float, Float, Float)
rotation    :: Maybe (Float, Float, Float, Float)
  , Node -> Maybe (Float, Float, Float)
scale       :: Maybe (Float, Float, Float)
  , Node -> Maybe (Float, Float, Float)
translation :: Maybe (Float, Float, Float)
  , Node -> Maybe (Vector Float)
weights     :: Maybe (Vector Float)
  , Node -> Maybe Text
name        :: Maybe Text
  , Node -> Maybe Object
extensions  :: Maybe Object
  , Node -> Maybe Value
extras      :: Maybe Value
  } deriving (Node -> Node -> Bool
(Node -> Node -> Bool) -> (Node -> Node -> Bool) -> Eq Node
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Node -> Node -> Bool
$c/= :: Node -> Node -> Bool
== :: Node -> Node -> Bool
$c== :: Node -> Node -> Bool
Eq, Int -> Node -> ShowS
[Node] -> ShowS
Node -> String
(Int -> Node -> ShowS)
-> (Node -> String) -> ([Node] -> ShowS) -> Show Node
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Node] -> ShowS
$cshowList :: [Node] -> ShowS
show :: Node -> String
$cshow :: Node -> String
showsPrec :: Int -> Node -> ShowS
$cshowsPrec :: Int -> Node -> ShowS
Show, (forall x. Node -> Rep Node x)
-> (forall x. Rep Node x -> Node) -> Generic Node
forall x. Rep Node x -> Node
forall x. Node -> Rep Node x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Node x -> Node
$cfrom :: forall x. Node -> Rep Node x
Generic)

instance FromJSON Node
instance ToJSON Node

-- | A floating-point 4x4 transformation matrix stored in column-major order.
newtype NodeMatrix = NodeMatrix { NodeMatrix -> Vector Float
unNodeMatrix :: Vector Float }
  deriving (NodeMatrix -> NodeMatrix -> Bool
(NodeMatrix -> NodeMatrix -> Bool)
-> (NodeMatrix -> NodeMatrix -> Bool) -> Eq NodeMatrix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeMatrix -> NodeMatrix -> Bool
$c/= :: NodeMatrix -> NodeMatrix -> Bool
== :: NodeMatrix -> NodeMatrix -> Bool
$c== :: NodeMatrix -> NodeMatrix -> Bool
Eq, Eq NodeMatrix
Eq NodeMatrix
-> (NodeMatrix -> NodeMatrix -> Ordering)
-> (NodeMatrix -> NodeMatrix -> Bool)
-> (NodeMatrix -> NodeMatrix -> Bool)
-> (NodeMatrix -> NodeMatrix -> Bool)
-> (NodeMatrix -> NodeMatrix -> Bool)
-> (NodeMatrix -> NodeMatrix -> NodeMatrix)
-> (NodeMatrix -> NodeMatrix -> NodeMatrix)
-> Ord NodeMatrix
NodeMatrix -> NodeMatrix -> Bool
NodeMatrix -> NodeMatrix -> Ordering
NodeMatrix -> NodeMatrix -> NodeMatrix
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NodeMatrix -> NodeMatrix -> NodeMatrix
$cmin :: NodeMatrix -> NodeMatrix -> NodeMatrix
max :: NodeMatrix -> NodeMatrix -> NodeMatrix
$cmax :: NodeMatrix -> NodeMatrix -> NodeMatrix
>= :: NodeMatrix -> NodeMatrix -> Bool
$c>= :: NodeMatrix -> NodeMatrix -> Bool
> :: NodeMatrix -> NodeMatrix -> Bool
$c> :: NodeMatrix -> NodeMatrix -> Bool
<= :: NodeMatrix -> NodeMatrix -> Bool
$c<= :: NodeMatrix -> NodeMatrix -> Bool
< :: NodeMatrix -> NodeMatrix -> Bool
$c< :: NodeMatrix -> NodeMatrix -> Bool
compare :: NodeMatrix -> NodeMatrix -> Ordering
$ccompare :: NodeMatrix -> NodeMatrix -> Ordering
$cp1Ord :: Eq NodeMatrix
Ord, Int -> NodeMatrix -> ShowS
[NodeMatrix] -> ShowS
NodeMatrix -> String
(Int -> NodeMatrix -> ShowS)
-> (NodeMatrix -> String)
-> ([NodeMatrix] -> ShowS)
-> Show NodeMatrix
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeMatrix] -> ShowS
$cshowList :: [NodeMatrix] -> ShowS
show :: NodeMatrix -> String
$cshow :: NodeMatrix -> String
showsPrec :: Int -> NodeMatrix -> ShowS
$cshowsPrec :: Int -> NodeMatrix -> ShowS
Show, Value -> Parser [NodeMatrix]
Value -> Parser NodeMatrix
(Value -> Parser NodeMatrix)
-> (Value -> Parser [NodeMatrix]) -> FromJSON NodeMatrix
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [NodeMatrix]
$cparseJSONList :: Value -> Parser [NodeMatrix]
parseJSON :: Value -> Parser NodeMatrix
$cparseJSON :: Value -> Parser NodeMatrix
FromJSON, [NodeMatrix] -> Encoding
[NodeMatrix] -> Value
NodeMatrix -> Encoding
NodeMatrix -> Value
(NodeMatrix -> Value)
-> (NodeMatrix -> Encoding)
-> ([NodeMatrix] -> Value)
-> ([NodeMatrix] -> Encoding)
-> ToJSON NodeMatrix
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [NodeMatrix] -> Encoding
$ctoEncodingList :: [NodeMatrix] -> Encoding
toJSONList :: [NodeMatrix] -> Value
$ctoJSONList :: [NodeMatrix] -> Value
toEncoding :: NodeMatrix -> Encoding
$ctoEncoding :: NodeMatrix -> Encoding
toJSON :: NodeMatrix -> Value
$ctoJSON :: NodeMatrix -> Value
ToJSON, (forall x. NodeMatrix -> Rep NodeMatrix x)
-> (forall x. Rep NodeMatrix x -> NodeMatrix) -> Generic NodeMatrix
forall x. Rep NodeMatrix x -> NodeMatrix
forall x. NodeMatrix -> Rep NodeMatrix x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NodeMatrix x -> NodeMatrix
$cfrom :: forall x. NodeMatrix -> Rep NodeMatrix x
Generic)

newtype SkinIx = SkinIx { SkinIx -> Int
unSkinIx :: Int }
  deriving (SkinIx -> SkinIx -> Bool
(SkinIx -> SkinIx -> Bool)
-> (SkinIx -> SkinIx -> Bool) -> Eq SkinIx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SkinIx -> SkinIx -> Bool
$c/= :: SkinIx -> SkinIx -> Bool
== :: SkinIx -> SkinIx -> Bool
$c== :: SkinIx -> SkinIx -> Bool
Eq, Eq SkinIx
Eq SkinIx
-> (SkinIx -> SkinIx -> Ordering)
-> (SkinIx -> SkinIx -> Bool)
-> (SkinIx -> SkinIx -> Bool)
-> (SkinIx -> SkinIx -> Bool)
-> (SkinIx -> SkinIx -> Bool)
-> (SkinIx -> SkinIx -> SkinIx)
-> (SkinIx -> SkinIx -> SkinIx)
-> Ord SkinIx
SkinIx -> SkinIx -> Bool
SkinIx -> SkinIx -> Ordering
SkinIx -> SkinIx -> SkinIx
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SkinIx -> SkinIx -> SkinIx
$cmin :: SkinIx -> SkinIx -> SkinIx
max :: SkinIx -> SkinIx -> SkinIx
$cmax :: SkinIx -> SkinIx -> SkinIx
>= :: SkinIx -> SkinIx -> Bool
$c>= :: SkinIx -> SkinIx -> Bool
> :: SkinIx -> SkinIx -> Bool
$c> :: SkinIx -> SkinIx -> Bool
<= :: SkinIx -> SkinIx -> Bool
$c<= :: SkinIx -> SkinIx -> Bool
< :: SkinIx -> SkinIx -> Bool
$c< :: SkinIx -> SkinIx -> Bool
compare :: SkinIx -> SkinIx -> Ordering
$ccompare :: SkinIx -> SkinIx -> Ordering
$cp1Ord :: Eq SkinIx
Ord, Int -> SkinIx -> ShowS
[SkinIx] -> ShowS
SkinIx -> String
(Int -> SkinIx -> ShowS)
-> (SkinIx -> String) -> ([SkinIx] -> ShowS) -> Show SkinIx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SkinIx] -> ShowS
$cshowList :: [SkinIx] -> ShowS
show :: SkinIx -> String
$cshow :: SkinIx -> String
showsPrec :: Int -> SkinIx -> ShowS
$cshowsPrec :: Int -> SkinIx -> ShowS
Show, Value -> Parser [SkinIx]
Value -> Parser SkinIx
(Value -> Parser SkinIx)
-> (Value -> Parser [SkinIx]) -> FromJSON SkinIx
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [SkinIx]
$cparseJSONList :: Value -> Parser [SkinIx]
parseJSON :: Value -> Parser SkinIx
$cparseJSON :: Value -> Parser SkinIx
FromJSON, [SkinIx] -> Encoding
[SkinIx] -> Value
SkinIx -> Encoding
SkinIx -> Value
(SkinIx -> Value)
-> (SkinIx -> Encoding)
-> ([SkinIx] -> Value)
-> ([SkinIx] -> Encoding)
-> ToJSON SkinIx
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [SkinIx] -> Encoding
$ctoEncodingList :: [SkinIx] -> Encoding
toJSONList :: [SkinIx] -> Value
$ctoJSONList :: [SkinIx] -> Value
toEncoding :: SkinIx -> Encoding
$ctoEncoding :: SkinIx -> Encoding
toJSON :: SkinIx -> Value
$ctoJSON :: SkinIx -> Value
ToJSON, (forall x. SkinIx -> Rep SkinIx x)
-> (forall x. Rep SkinIx x -> SkinIx) -> Generic SkinIx
forall x. Rep SkinIx x -> SkinIx
forall x. SkinIx -> Rep SkinIx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SkinIx x -> SkinIx
$cfrom :: forall x. SkinIx -> Rep SkinIx x
Generic)

-- | Joints and matrices defining a skin.
data Skin = Skin
  { Skin -> Vector NodeIx
joints              :: Vector (NodeIx)
  , Skin -> Maybe NodeIx
skeleton            :: Maybe NodeIx
  , Skin -> Maybe AccessorIx
inverseBindMatrices :: Maybe AccessorIx
    -- ^ The index of the accessor containing the floating-point
    -- 4x4 inverse-bind matrices.
    -- The default is that each matrix is a 4x4 identity matrix,
    -- which implies that inverse-bind matrices were pre-applied.
  , Skin -> Maybe Text
name                :: Maybe Text
  , Skin -> Maybe Object
extensions          :: Maybe Object
  , Skin -> Maybe Value
extras              :: Maybe Value
  } deriving (Skin -> Skin -> Bool
(Skin -> Skin -> Bool) -> (Skin -> Skin -> Bool) -> Eq Skin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Skin -> Skin -> Bool
$c/= :: Skin -> Skin -> Bool
== :: Skin -> Skin -> Bool
$c== :: Skin -> Skin -> Bool
Eq, Int -> Skin -> ShowS
[Skin] -> ShowS
Skin -> String
(Int -> Skin -> ShowS)
-> (Skin -> String) -> ([Skin] -> ShowS) -> Show Skin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Skin] -> ShowS
$cshowList :: [Skin] -> ShowS
show :: Skin -> String
$cshow :: Skin -> String
showsPrec :: Int -> Skin -> ShowS
$cshowsPrec :: Int -> Skin -> ShowS
Show, (forall x. Skin -> Rep Skin x)
-> (forall x. Rep Skin x -> Skin) -> Generic Skin
forall x. Rep Skin x -> Skin
forall x. Skin -> Rep Skin x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Skin x -> Skin
$cfrom :: forall x. Skin -> Rep Skin x
Generic)

instance FromJSON Skin
instance ToJSON Skin