Animations.hs

module Graphics.Formats.Collada.Animations (attr, library_animations, animations, collada_array) where
import Text.XML.Light
import Graphics.Formats.Collada.ColladaTypes

attr :: String -> String -> (Element -> Element)
attr key value = add_attr (Attr (unqual key) value)

library_animations :: [(SID, AnimChannel)] -> [Element]
library_animations anims | (length as) > 0 = [unode "library_animations" $ as]
                         | otherwise = []
  where as = map animations anims

animations :: (SID, AnimChannel) -> Element
animations (sid,(Bezier (inID,inFloat,inAccessor)
                        (outID,outFloat,outAccessor)
                        (intangentID,intangentFloat,intangentAccessor)
                        (outtangentID,outtangentFloat,outtangentAccessor)
                        (interpID,interpString,interpAccessor)
                        targets )) =
                attr "id" sid $ unode "animation" $
                [ anim_source_input (sid ++ "-" ++ inID) inFloat inAccessor,
                  anim_source_output (sid ++ "-" ++ outID) outFloat outAccessor,
                  anim_source_intangents (sid ++ "-" ++ intangentID) intangentFloat intangentAccessor,
                  anim_source_outtangents (sid ++ "-" ++ outtangentID) outtangentFloat outtangentAccessor,
                  anim_source_interpolations (sid ++ "-" ++ interpID) interpString interpAccessor,
                  anim_source_sampler sid inID outID intangentID outtangentID interpID
                ]
                ++ (map (anim_source_channel sid) targets)

accessor acc = map (foldr (\(x,y) -> (attr x y)) (unode "param" "")) acc

collada_array list = concat (map (++" ") (map show list))

anim_source_input str ar acc =
                  attr "id" str $ unode "source"
                  [ attr "id" (str ++ "-array") $
                    attr "count" (show (length ar)) $
                    unode "float_array" (collada_array ar),
                    unode "technique_common" $
                    attr "source" ("#" ++ str ++ "-array") $
                    attr "count" (show (length ar)) $
                    attr "stride" "1" $
                    unode "accessor" $ accessor acc
                  ]

anim_source_output str ar acc = attr "id" str $ unode "source"
                            [ attr "id" (str ++ "-array") $
                              attr "count" (show (length ar)) $
                              unode "float_array" (collada_array ar),
                              unode "technique_common" $
                                attr "source" ("#" ++ str ++ "-array") $
                                attr "count" (show (length ar)) $
                                attr "stride" "1" $
                                  unode "accessor" $ accessor acc
                            ]

anim_source_intangents str ar acc =
                        attr "id" str $ unode "source"
                        [ attr "id" (str ++ "-array") $
                          attr "count" (show (length ar)) $
                          unode "float_array" (collada_array ar),
                          unode "technique_common" $
                            attr "source" ("#" ++ str ++ "-array") $
                            attr "count" (show ((length ar)`div`2)) $
                            attr "stride" "2" $
                              unode "accessor" $ accessor acc
                        ]

anim_source_outtangents str ar acc =
                        attr "id" str $ unode "source"
                        [ attr "id" (str ++ "-array") $
                          attr "count" (show (length ar)) $
                          unode "float_array" (collada_array ar),
                          unode "technique_common" $
                            attr "source" ("#" ++ str ++ "-array") $
                            attr "count" (show ((length ar)`div`2)) $
                            attr "stride" "2" $
                              unode "accessor" $ accessor acc
                        ]

anim_source_interpolations str ar acc =
                        attr "id" str $ unode "source"
                        [ attr "id" (str ++ "-array") $
                          attr "count" (show (length ar)) $
                          unode "Name_array" (concat ar),
                          unode "technique_common" $
                            attr "source" ("#" ++ str ++ "-array") $
                            attr "count" (show (length ar)) $
                            attr "stride" "1" $
                              unode "accessor" $ accessor acc
                        ]

anim_source_sampler str inID outID intangentID outtangentID interpID =
                  attr "id" (str ++ "-sampler") $
                  unode "sampler" 
                  [
                    attr "semantic" "INPUT" $ attr "source" ("#" ++ str ++ "-" ++ inID) $
                      unode "input" (),
                    attr "semantic" "OUTPUT" $ attr "source" ("#" ++ str ++ "-" ++ outID) $
                      unode "input" (),
                    attr "semantic" "IN_TANGENT" $ attr "source" ("#" ++ str ++ "-" ++ intangentID) $
                      unode "input" (),
                    attr "semantic" "OUT_TANGENT" $ attr "source" ("#" ++ str ++ "-" ++ outtangentID) $
                      unode "input" (),
                    attr "semantic" "INTERPOLATION" $ attr "source" ("#" ++ str ++ "-" ++ interpID) $
                      unode "input" ()
                  ]

anim_source_channel s0 (targetID,accessorName) =
                     attr "source" ("#" ++ s0 ++ "-sampler") $
                     attr "target" (targetID ++ "." ++ accessorName) $
                       unode "channel" ()