-- GENERATED by C->Haskell Compiler, version 0.16.3 Crystal Seed, 24 Jan 2009 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE TypeSynonymInstances #-}

-- This source file is part of HGamer3D
-- (A project to enable 3D game development in Haskell)
-- For the latest info, see http://www.althainz.de/HGamer3D.html
-- 

-- (c) 2011, 2012 Peter Althainz
-- 
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
-- 
--     http://www.apache.org/licenses/LICENSE-2.0
-- 
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.
-- 


-- ClassAnimation.chs

-- 

module HGamer3D.Bindings.Ogre.ClassAnimation where

import Foreign
import Foreign.Ptr
import Foreign.C

import HGamer3D.Data.HG3DClass
import HGamer3D.Data.Vector
import HGamer3D.Data.Colour
import HGamer3D.Data.Angle

import HGamer3D.Bindings.Ogre.Utils
{-# LINE 40 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}
import HGamer3D.Bindings.Ogre.ClassPtr
{-# LINE 41 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}
import HGamer3D.Bindings.Ogre.StructHG3DClass
{-# LINE 42 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}
import HGamer3D.Bindings.Ogre.EnumVertexAnimationType
{-# LINE 43 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}
import HGamer3D.Bindings.Ogre.EnumAnimationInterpolationMode
{-# LINE 44 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}
import HGamer3D.Bindings.Ogre.EnumAnimationRotationInterpolationMode
{-# LINE 45 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | 
delete :: HG3DClass  -- ^ classpointer - pointer of Class instance which is going to be deleted.
  ->  IO ()
 -- ^ 
delete a1 =
  withHG3DClass a1 $ \a1' -> 
  delete'_ a1' >>= \res ->
  return ()
{-# LINE 50 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Gets the name of this animation. 
getName :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (String)
 -- ^ 
getName a1 =
  withHG3DClass a1 $ \a1' -> 
  alloc64k $ \a2' -> 
  getName'_ a1' a2' >>= \res ->
  peekCString  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 55 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Gets the total length of the animation. 
getLength :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (Float)
 -- ^ 
getLength a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  getLength'_ a1' a2' >>= \res ->
  peekFloatConv  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 60 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Sets the length of the animation. Changing the length of an animation may invalidate existing AnimationState
setLength :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Float  -- ^ len
  ->  IO ()
 -- ^ 
setLength a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = realToFrac a2} in 
  setLength'_ a1' a2' >>= \res ->
  return ()
{-# LINE 65 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Creates a NodeAnimationTrackNode
createNodeTrack :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Int  -- ^ handle - Handle to give the track, used for accessing the track later. Must be unique within this Animation. 
  ->  IO (HG3DClass)
 -- ^ 
createNodeTrack a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  alloca $ \a3' -> 
  createNodeTrack'_ a1' a2' a3' >>= \res ->
  peek  a3'>>= \a3'' -> 
  return (a3'')
{-# LINE 71 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Creates a NumericAnimationTrack
createNumericTrack :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Int  -- ^ handle - Handle to give the track, used for accessing the track later. Must be unique within this Animation. 
  ->  IO (HG3DClass)
 -- ^ 
createNumericTrack a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  alloca $ \a3' -> 
  createNumericTrack'_ a1' a2' a3' >>= \res ->
  peek  a3'>>= \a3'' -> 
  return (a3'')
{-# LINE 77 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Creates a VertexAnimationTrack
createVertexTrack :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Int  -- ^ handle - Handle to give the track, used for accessing the track later. Must be unique within this Animation, and is used to identify the target. For example when applied to a Mesh, the handle must reference the index of the geometry being modified; 0 for the shared geometry, and 1+ for SubMesh geometry with the same index-1. 
  ->  EnumVertexAnimationType  -- ^ animType - Either morph or pose animation, 
  ->  IO (HG3DClass)
 -- ^ 
createVertexTrack a1 a2 a3 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  let {a3' = cIntFromEnum a3} in 
  alloca $ \a4' -> 
  createVertexTrack'_ a1' a2' a3' a4' >>= \res ->
  peek  a4'>>= \a4'' -> 
  return (a4'')
{-# LINE 84 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Creates a new AnimationTrackNodeThis method creates a standard AnimationTrackNode
createNodeTrack2 :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Int  -- ^ handle - Numeric handle to give the track, used for accessing the track later. Must be unique within this Animation. 
  ->  HG3DClass  -- ^ node - A pointer to the Node object which will be affected by this track 
  ->  IO (HG3DClass)
 -- ^ 
createNodeTrack2 a1 a2 a3 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  withHG3DClass a3 $ \a3' -> 
  alloca $ \a4' -> 
  createNodeTrack2'_ a1' a2' a3' a4' >>= \res ->
  peek  a4'>>= \a4'' -> 
  return (a4'')
{-# LINE 91 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Gets the number of NodeAnimationTrack
getNumNodeTracks :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (Int)
 -- ^ 
getNumNodeTracks a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  getNumNodeTracks'_ a1' a2' >>= \res ->
  peekIntConv  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 96 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Gets a node track by it's handle. 
getNodeTrack :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Int  -- ^ handle
  ->  IO (HG3DClass)
 -- ^ 
getNodeTrack a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  alloca $ \a3' -> 
  getNodeTrack'_ a1' a2' a3' >>= \res ->
  peek  a3'>>= \a3'' -> 
  return (a3'')
{-# LINE 102 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Does a track exist with the given handle? 
hasNodeTrack :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Int  -- ^ handle
  ->  IO (Bool)
 -- ^ 
hasNodeTrack a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  alloca $ \a3' -> 
  hasNodeTrack'_ a1' a2' a3' >>= \res ->
  peekBoolUtil  a3'>>= \a3'' -> 
  return (a3'')
{-# LINE 108 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Gets the number of NumericAnimationTrack
getNumNumericTracks :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (Int)
 -- ^ 
getNumNumericTracks a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  getNumNumericTracks'_ a1' a2' >>= \res ->
  peekIntConv  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 113 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Gets a numeric track by it's handle. 
getNumericTrack :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Int  -- ^ handle
  ->  IO (HG3DClass)
 -- ^ 
getNumericTrack a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  alloca $ \a3' -> 
  getNumericTrack'_ a1' a2' a3' >>= \res ->
  peek  a3'>>= \a3'' -> 
  return (a3'')
{-# LINE 119 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Does a track exist with the given handle? 
hasNumericTrack :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Int  -- ^ handle
  ->  IO (Bool)
 -- ^ 
hasNumericTrack a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  alloca $ \a3' -> 
  hasNumericTrack'_ a1' a2' a3' >>= \res ->
  peekBoolUtil  a3'>>= \a3'' -> 
  return (a3'')
{-# LINE 125 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Gets the number of VertexAnimationTrack
getNumVertexTracks :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (Int)
 -- ^ 
getNumVertexTracks a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  getNumVertexTracks'_ a1' a2' >>= \res ->
  peekIntConv  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 130 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Gets a Vertex track by it's handle. 
getVertexTrack :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Int  -- ^ handle
  ->  IO (HG3DClass)
 -- ^ 
getVertexTrack a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  alloca $ \a3' -> 
  getVertexTrack'_ a1' a2' a3' >>= \res ->
  peek  a3'>>= \a3'' -> 
  return (a3'')
{-# LINE 136 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Does a track exist with the given handle? 
hasVertexTrack :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Int  -- ^ handle
  ->  IO (Bool)
 -- ^ 
hasVertexTrack a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  alloca $ \a3' -> 
  hasVertexTrack'_ a1' a2' a3' >>= \res ->
  peekBoolUtil  a3'>>= \a3'' -> 
  return (a3'')
{-# LINE 142 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Destroys the node track with the given handle. 
destroyNodeTrack :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Int  -- ^ handle
  ->  IO ()
 -- ^ 
destroyNodeTrack a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  destroyNodeTrack'_ a1' a2' >>= \res ->
  return ()
{-# LINE 147 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Destroys the numeric track with the given handle. 
destroyNumericTrack :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Int  -- ^ handle
  ->  IO ()
 -- ^ 
destroyNumericTrack a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  destroyNumericTrack'_ a1' a2' >>= \res ->
  return ()
{-# LINE 152 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Destroys the Vertex track with the given handle. 
destroyVertexTrack :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Int  -- ^ handle
  ->  IO ()
 -- ^ 
destroyVertexTrack a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  destroyVertexTrack'_ a1' a2' >>= \res ->
  return ()
{-# LINE 157 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Removes and destroys all tracks making up this animation. 
destroyAllTracks :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO ()
 -- ^ 
destroyAllTracks a1 =
  withHG3DClass a1 $ \a1' -> 
  destroyAllTracks'_ a1' >>= \res ->
  return ()
{-# LINE 161 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Removes and destroys all tracks making up this animation. 
destroyAllNodeTracks :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO ()
 -- ^ 
destroyAllNodeTracks a1 =
  withHG3DClass a1 $ \a1' -> 
  destroyAllNodeTracks'_ a1' >>= \res ->
  return ()
{-# LINE 165 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Removes and destroys all tracks making up this animation. 
destroyAllNumericTracks :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO ()
 -- ^ 
destroyAllNumericTracks a1 =
  withHG3DClass a1 $ \a1' -> 
  destroyAllNumericTracks'_ a1' >>= \res ->
  return ()
{-# LINE 169 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Removes and destroys all tracks making up this animation. 
destroyAllVertexTracks :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO ()
 -- ^ 
destroyAllVertexTracks a1 =
  withHG3DClass a1 $ \a1' -> 
  destroyAllVertexTracks'_ a1' >>= \res ->
  return ()
{-# LINE 173 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Applies an animation given a specific time point and weight. Where you have associated animation tracks with objects, you can easily apply an animation to those objects by calling this method. 
apply :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Float  -- ^ timePos - The time position in the animation to apply. 
  ->  Float  -- ^ weight - The influence to give to this track, 1.0 for full influence, less to blend with other animations. 
  ->  Float  -- ^ scale - The scale to apply to translations and scalings, useful for adapting an animation to a different size target. 
  ->  IO ()
 -- ^ 
apply a1 a2 a3 a4 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = realToFrac a2} in 
  let {a3' = realToFrac a3} in 
  let {a4' = realToFrac a4} in 
  apply'_ a1' a2' a3' a4' >>= \res ->
  return ()
{-# LINE 180 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Applies all node tracks given a specific time point and weight to the specified node. It does not consider the actual node tracks are attached to. As such, it resembles the apply method for a given skeleton (see below). 
applyToNode :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  HG3DClass  -- ^ node
  ->  Float  -- ^ timePos - The time position in the animation to apply. 
  ->  Float  -- ^ weight - The influence to give to this track, 1.0 for full influence, less to blend with other animations. 
  ->  Float  -- ^ scale - The scale to apply to translations and scalings, useful for adapting an animation to a different size target. 
  ->  IO ()
 -- ^ 
applyToNode a1 a2 a3 a4 a5 =
  withHG3DClass a1 $ \a1' -> 
  withHG3DClass a2 $ \a2' -> 
  let {a3' = realToFrac a3} in 
  let {a4' = realToFrac a4} in 
  let {a5' = realToFrac a5} in 
  applyToNode'_ a1' a2' a3' a4' a5' >>= \res ->
  return ()
{-# LINE 188 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Applies all node tracks given a specific time point and weight to a given skeleton. Where you have associated animation tracks with Node
apply2 :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  HG3DClass  -- ^ skeleton
  ->  Float  -- ^ timePos - The time position in the animation to apply. 
  ->  Float  -- ^ weight - The influence to give to this track, 1.0 for full influence, less to blend with other animations. 
  ->  Float  -- ^ scale - The scale to apply to translations and scalings, useful for adapting an animation to a different size target. 
  ->  IO ()
 -- ^ 
apply2 a1 a2 a3 a4 a5 =
  withHG3DClass a1 $ \a1' -> 
  withHG3DClass a2 $ \a2' -> 
  let {a3' = realToFrac a3} in 
  let {a4' = realToFrac a4} in 
  let {a5' = realToFrac a5} in 
  apply2'_ a1' a2' a3' a4' a5' >>= \res ->
  return ()
{-# LINE 196 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Applies all vertex tracks given a specific time point and weight to a given entity. 
apply4 :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  HG3DClass  -- ^ entity - The Entity to which this animation should be applied 
  ->  Float  -- ^ timePos - The time position in the animation to apply. 
  ->  Float  -- ^ weight - The weight at which the animation should be applied (only affects pose animation) 
  ->  Bool  -- ^ software - Whether to populate the software morph vertex data 
  ->  Bool  -- ^ hardware - Whether to populate the hardware morph vertex data 
  ->  IO ()
 -- ^ 
apply4 a1 a2 a3 a4 a5 a6 =
  withHG3DClass a1 $ \a1' -> 
  withHG3DClass a2 $ \a2' -> 
  let {a3' = realToFrac a3} in 
  let {a4' = realToFrac a4} in 
  let {a5' = fromBool a5} in 
  let {a6' = fromBool a6} in 
  apply4'_ a1' a2' a3' a4' a5' a6' >>= \res ->
  return ()
{-# LINE 205 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Tells the animation how to interpolate between keyframes. By default, animations normally interpolate linearly between keyframes. This is fast, but when animations include quick changes in direction it can look a little unnatural because directions change instantly at keyframes. An alternative is to tell the animation to interpolate along a spline, which is more expensive in terms of calculation time, but looks smoother because major changes in direction are distributed around the keyframes rather than just at the keyframe. You can also change the default animation behaviour by calling Animation::setDefaultInterpolationMode
setInterpolationMode :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  EnumAnimationInterpolationMode  -- ^ im
  ->  IO ()
 -- ^ 
setInterpolationMode a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = cIntFromEnum a2} in 
  setInterpolationMode'_ a1' a2' >>= \res ->
  return ()
{-# LINE 210 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Gets the current interpolation mode of this animation. See setInterpolationMode for more info. 
getInterpolationMode :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (EnumAnimationInterpolationMode)
 -- ^ 
getInterpolationMode a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  getInterpolationMode'_ a1' a2' >>= \res ->
  peekEnumUtil  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 215 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Tells the animation how to interpolate rotations. By default, animations interpolate linearly between rotations. This is fast but not necessarily completely accurate. If you want more accurate interpolation, use spherical interpolation, but be aware that it will incur a higher cost. You can also change the default rotation behaviour by calling Animation::setDefaultRotationInterpolationMode
setRotationInterpolationMode :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  EnumAnimationRotationInterpolationMode  -- ^ im
  ->  IO ()
 -- ^ 
setRotationInterpolationMode a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = cIntFromEnum a2} in 
  setRotationInterpolationMode'_ a1' a2' >>= \res ->
  return ()
{-# LINE 220 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Gets the current rotation interpolation mode of this animation. See setRotationInterpolationMode for more info. 
getRotationInterpolationMode :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  IO (EnumAnimationRotationInterpolationMode)
 -- ^ 
getRotationInterpolationMode a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  getRotationInterpolationMode'_ a1' a2' >>= \res ->
  peekEnumUtil  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 225 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Optimise an animation by removing unnecessary tracks and keyframes. When you export an animation, it is possible that certain tracks have been keyframed but actually don't include anything useful - the keyframes include no transformation. These tracks can be completely eliminated from the animation and thus speed up the animation. In addition, if several keyframes in a row have the same value, then they are just adding overhead and can be removed. Since track-less and identity track has difference behavior for accumulate animation blending if corresponding track presenting at other animation that is non-identity, and in normally this method didn't known about the situation of other animation, it can't deciding whether or not discards identity tracks. So there have a parameter allow you choose what you want, in case you aren't sure how to do that, you should use Skeleton::optimiseAllAnimations
optimise :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  Bool  -- ^ discardIdentityNodeTracks - If true, discard identity node tracks. 
  ->  IO ()
 -- ^ 
optimise a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = fromBool a2} in 
  optimise'_ a1' a2' >>= \res ->
  return ()
{-# LINE 230 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Clone this animation. The pointer returned from this method is the only one recorded, thus it is up to the caller to arrange for the deletion of this object. 
clone :: HG3DClass  -- ^ classpointer - pointer of Class instance from which this methods is called.
  ->  String  -- ^ newName
  ->  IO (HG3DClass)
 -- ^ 
clone a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  withCString a2 $ \a2' -> 
  alloca $ \a3' -> 
  clone'_ a1' a2' a3' >>= \res ->
  peek  a3'>>= \a3'' -> 
  return (a3'')
{-# LINE 236 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Sets the default animation interpolation mode. Every animation created after this option is set will have the new interpolation mode specified. You can also change the mode per animation by calling the setInterpolationMode method on the instance in question. 
setDefaultInterpolationMode :: EnumAnimationInterpolationMode  -- ^ im
  ->  IO ()
 -- ^ 
setDefaultInterpolationMode a1 =
  let {a1' = cIntFromEnum a1} in 
  setDefaultInterpolationMode'_ a1' >>= \res ->
  return ()
{-# LINE 240 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Gets the default interpolation mode for all animations. 
getDefaultInterpolationMode :: IO (EnumAnimationInterpolationMode)
 -- ^ 
getDefaultInterpolationMode =
  alloca $ \a1' -> 
  getDefaultInterpolationMode'_ a1' >>= \res ->
  peekEnumUtil  a1'>>= \a1'' -> 
  return (a1'')
{-# LINE 244 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Sets the default rotation interpolation mode. Every animation created after this option is set will have the new interpolation mode specified. You can also change the mode per animation by calling the setInterpolationMode method on the instance in question. 
setDefaultRotationInterpolationMode :: EnumAnimationRotationInterpolationMode  -- ^ im
  ->  IO ()
 -- ^ 
setDefaultRotationInterpolationMode a1 =
  let {a1' = cIntFromEnum a1} in 
  setDefaultRotationInterpolationMode'_ a1' >>= \res ->
  return ()
{-# LINE 248 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}

-- | Gets the default rotation interpolation mode for all animations. 
getDefaultRotationInterpolationMode :: IO (EnumAnimationRotationInterpolationMode)
 -- ^ 
getDefaultRotationInterpolationMode =
  alloca $ \a1' -> 
  getDefaultRotationInterpolationMode'_ a1' >>= \res ->
  peekEnumUtil  a1'>>= \a1'' -> 
  return (a1'')
{-# LINE 252 ".\\HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs" #-}


foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_destruct"
  delete'_ :: ((HG3DClassPtr) -> (IO ()))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_getName"
  getName'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_getLength"
  getLength'_ :: ((HG3DClassPtr) -> ((Ptr CFloat) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_setLength"
  setLength'_ :: ((HG3DClassPtr) -> (CFloat -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_createNodeTrack"
  createNodeTrack'_ :: ((HG3DClassPtr) -> (CUShort -> ((HG3DClassPtr) -> (IO ()))))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_createNumericTrack"
  createNumericTrack'_ :: ((HG3DClassPtr) -> (CUShort -> ((HG3DClassPtr) -> (IO ()))))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_createVertexTrack"
  createVertexTrack'_ :: ((HG3DClassPtr) -> (CUShort -> (CInt -> ((HG3DClassPtr) -> (IO ())))))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_createNodeTrack2"
  createNodeTrack2'_ :: ((HG3DClassPtr) -> (CUShort -> ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ())))))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_getNumNodeTracks"
  getNumNodeTracks'_ :: ((HG3DClassPtr) -> ((Ptr CUShort) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_getNodeTrack"
  getNodeTrack'_ :: ((HG3DClassPtr) -> (CUShort -> ((HG3DClassPtr) -> (IO ()))))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_hasNodeTrack"
  hasNodeTrack'_ :: ((HG3DClassPtr) -> (CUShort -> ((Ptr CInt) -> (IO ()))))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_getNumNumericTracks"
  getNumNumericTracks'_ :: ((HG3DClassPtr) -> ((Ptr CUShort) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_getNumericTrack"
  getNumericTrack'_ :: ((HG3DClassPtr) -> (CUShort -> ((HG3DClassPtr) -> (IO ()))))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_hasNumericTrack"
  hasNumericTrack'_ :: ((HG3DClassPtr) -> (CUShort -> ((Ptr CInt) -> (IO ()))))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_getNumVertexTracks"
  getNumVertexTracks'_ :: ((HG3DClassPtr) -> ((Ptr CUShort) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_getVertexTrack"
  getVertexTrack'_ :: ((HG3DClassPtr) -> (CUShort -> ((HG3DClassPtr) -> (IO ()))))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_hasVertexTrack"
  hasVertexTrack'_ :: ((HG3DClassPtr) -> (CUShort -> ((Ptr CInt) -> (IO ()))))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_destroyNodeTrack"
  destroyNodeTrack'_ :: ((HG3DClassPtr) -> (CUShort -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_destroyNumericTrack"
  destroyNumericTrack'_ :: ((HG3DClassPtr) -> (CUShort -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_destroyVertexTrack"
  destroyVertexTrack'_ :: ((HG3DClassPtr) -> (CUShort -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_destroyAllTracks"
  destroyAllTracks'_ :: ((HG3DClassPtr) -> (IO ()))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_destroyAllNodeTracks"
  destroyAllNodeTracks'_ :: ((HG3DClassPtr) -> (IO ()))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_destroyAllNumericTracks"
  destroyAllNumericTracks'_ :: ((HG3DClassPtr) -> (IO ()))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_destroyAllVertexTracks"
  destroyAllVertexTracks'_ :: ((HG3DClassPtr) -> (IO ()))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_apply"
  apply'_ :: ((HG3DClassPtr) -> (CFloat -> (CFloat -> (CFloat -> (IO ())))))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_applyToNode"
  applyToNode'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (CFloat -> (CFloat -> (CFloat -> (IO ()))))))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_apply2"
  apply2'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (CFloat -> (CFloat -> (CFloat -> (IO ()))))))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_apply4"
  apply4'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (CFloat -> (CFloat -> (CInt -> (CInt -> (IO ())))))))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_setInterpolationMode"
  setInterpolationMode'_ :: ((HG3DClassPtr) -> (CInt -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_getInterpolationMode"
  getInterpolationMode'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_setRotationInterpolationMode"
  setRotationInterpolationMode'_ :: ((HG3DClassPtr) -> (CInt -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_getRotationInterpolationMode"
  getRotationInterpolationMode'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_optimise"
  optimise'_ :: ((HG3DClassPtr) -> (CInt -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_clone"
  clone'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> ((HG3DClassPtr) -> (IO ()))))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_setDefaultInterpolationMode"
  setDefaultInterpolationMode'_ :: (CInt -> (IO ()))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_getDefaultInterpolationMode"
  getDefaultInterpolationMode'_ :: ((Ptr CInt) -> (IO ()))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_setDefaultRotationInterpolationMode"
  setDefaultRotationInterpolationMode'_ :: (CInt -> (IO ()))

foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassAnimation.chs.h ogre_anm_getDefaultRotationInterpolationMode"
  getDefaultRotationInterpolationMode'_ :: ((Ptr CInt) -> (IO ()))