-- 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\\ClassSkeleton.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. -- -- ClassSkeleton.chs -- module HGamer3D.Bindings.Ogre.ClassSkeleton 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\\ClassSkeleton.chs" #-} import HGamer3D.Bindings.Ogre.ClassPtr {-# LINE 41 ".\\HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs" #-} import HGamer3D.Bindings.Ogre.StructHG3DClass {-# LINE 42 ".\\HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs" #-} import HGamer3D.Bindings.Ogre.EnumSkeletonAnimationBlendMode {-# LINE 43 ".\\HGamer3D\\Bindings\\Ogre\\ClassSkeleton.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 48 ".\\HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs" #-} -- | Creates a brand new BoneSkeletonThis method creates an unattached new BoneBoneBone::createChildNote that this method automatically generates a handle for the bone, which you can retrieve using Bone::getHandleBone createBone :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (HG3DClass) -- ^ createBone a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> createBone'_ a1' a2' >>= \res -> peek a2'>>= \a2'' -> return (a2'') {-# LINE 53 ".\\HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs" #-} -- | Creates a brand new BoneSkeletonThis method creates an unattached new BoneBoneBone::createChild createBone2 :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Int -- ^ handle - The handle to give to this new bone - must be unique within this skeleton. You should also ensure that all bone handles are eventually contiguous (this is to simplify their compilation into an indexed array of transformation matrices). For this reason it is advised that you use the simpler createBone method which automatically assigns a sequential handle starting from 0. -> IO (HG3DClass) -- ^ createBone2 a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromIntegral a2} in alloca $ \a3' -> createBone2'_ a1' a2' a3' >>= \res -> peek a3'>>= \a3'' -> return (a3'') {-# LINE 59 ".\\HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs" #-} -- | Creates a brand new BoneSkeletonThis method creates an unattached new BoneBoneBone::createChild createBone3 :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> String -- ^ name - The name to give to this new bone - must be unique within this skeleton. Note that the way OGRE looks up bones is via a numeric handle, so if you name a Bone this way it will be given an automatic sequential handle. The name is just for your convenience, although it is recommended that you only use the handle to retrieve the bone in performance-critical code. -> IO (HG3DClass) -- ^ createBone3 a1 a2 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> alloca $ \a3' -> createBone3'_ a1' a2' a3' >>= \res -> peek a3'>>= \a3'' -> return (a3'') {-# LINE 65 ".\\HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs" #-} -- | Creates a brand new BoneSkeletonThis method creates an unattached new BoneBoneBone::createChild createBone4 :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> String -- ^ name - The name to give to this new bone - must be unique within this skeleton. -> Int -- ^ handle - The handle to give to this new bone - must be unique within this skeleton. -> IO (HG3DClass) -- ^ createBone4 a1 a2 a3 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> let {a3' = fromIntegral a3} in alloca $ \a4' -> createBone4'_ a1' a2' a3' a4' >>= \res -> peek a4'>>= \a4'' -> return (a4'') {-# LINE 72 ".\\HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs" #-} -- | Returns the number of bones in this skeleton. getNumBones :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (Int) -- ^ getNumBones a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getNumBones'_ a1' a2' >>= \res -> peekIntConv a2'>>= \a2'' -> return (a2'') {-# LINE 77 ".\\HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs" #-} -- | Gets the root bone of the skeleton: deprecated in favour of getRootBoneIterator. The system derives the root bone the first time you ask for it. The root bone is the only bone in the skeleton which has no parent. The system locates it by taking the first bone in the list and going up the bone tree until there are no more parents, and saves this top bone as the root. If you are building the skeleton manually using createBone then you must ensure there is only one bone which is not a child of another bone, otherwise your skeleton will not work properly. If you use createBone only once, and then use Bone::createChild getRootBone :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (HG3DClass) -- ^ getRootBone a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getRootBone'_ a1' a2' >>= \res -> peek a2'>>= \a2'' -> return (a2'') {-# LINE 82 ".\\HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs" #-} -- | Gets a bone by it's handle. getBone :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Int -- ^ handle -> IO (HG3DClass) -- ^ getBone a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromIntegral a2} in alloca $ \a3' -> getBone'_ a1' a2' a3' >>= \res -> peek a3'>>= \a3'' -> return (a3'') {-# LINE 88 ".\\HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs" #-} -- | Gets a bone by it's name. getBone2 :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> String -- ^ name -> IO (HG3DClass) -- ^ getBone2 a1 a2 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> alloca $ \a3' -> getBone2'_ a1' a2' a3' >>= \res -> peek a3'>>= \a3'' -> return (a3'') {-# LINE 94 ".\\HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs" #-} -- | Returns whether this skeleton contains the named bone. hasBone :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> String -- ^ name -> IO (Bool) -- ^ hasBone a1 a2 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> alloca $ \a3' -> hasBone'_ a1' a2' a3' >>= \res -> peekBoolUtil a3'>>= \a3'' -> return (a3'') {-# LINE 100 ".\\HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs" #-} -- | Sets the current position / orientation to be the 'binding pose' i.e. the layout in which bones were originally bound to a mesh. setBindingPose :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO () -- ^ setBindingPose a1 = withHG3DClass a1 $ \a1' -> setBindingPose'_ a1' >>= \res -> return () {-# LINE 104 ".\\HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs" #-} -- | Resets the position and orientation of all bones in this skeleton to their original binding position. A skeleton is bound to a mesh in a binding pose. Bone reset :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Bool -- ^ resetManualBones - If set to true, causes the state of manual bones to be reset too, which is normally not done to allow the manual state to persist even when keyframe animation is applied. -> IO () -- ^ reset a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromBool a2} in reset'_ a1' a2' >>= \res -> return () {-# LINE 109 ".\\HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs" #-} -- | Creates a new Animation createAnimation :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> String -- ^ name - The name of this animation -> Float -- ^ length - The length of the animation in seconds -> IO (HG3DClass) -- ^ createAnimation a1 a2 a3 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> let {a3' = realToFrac a3} in alloca $ \a4' -> createAnimation'_ a1' a2' a3' a4' >>= \res -> peek a4'>>= \a4'' -> return (a4'') {-# LINE 116 ".\\HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs" #-} -- | Returns whether this skeleton contains the named animation. hasAnimation :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> String -- ^ name -> IO (Bool) -- ^ hasAnimation a1 a2 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> alloca $ \a3' -> hasAnimation'_ a1' a2' a3' >>= \res -> peekBoolUtil a3'>>= \a3'' -> return (a3'') {-# LINE 122 ".\\HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs" #-} -- | Removes an Animation removeAnimation :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> String -- ^ name -> IO () -- ^ removeAnimation a1 a2 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> removeAnimation'_ a1' a2' >>= \res -> return () {-# LINE 127 ".\\HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs" #-} -- | Changes the state of the skeleton to reflect the application of the passed in collection of animations. Animating a skeleton involves both interpolating between keyframes of a specific animation, and blending between the animations themselves. Calling this method sets the state of the skeleton so that it reflects the combination of all the passed in animations, at the time index specified for each, using the weights specified. Note that the weights between animations do not have to sum to 1.0, because some animations may affect only subsets of the skeleton. If the weights exceed 1.0 for the same area of the skeleton, the movement will just be exaggerated. setAnimationState :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> HG3DClass -- ^ animSet -> IO () -- ^ setAnimationState a1 a2 = withHG3DClass a1 $ \a1' -> withHG3DClass a2 $ \a2' -> setAnimationState'_ a1' a2' >>= \res -> return () {-# LINE 132 ".\\HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs" #-} -- | Gets the number of animations on this skeleton. getNumAnimations :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (Int) -- ^ getNumAnimations a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getNumAnimations'_ a1' a2' >>= \res -> peekIntConv a2'>>= \a2'' -> return (a2'') {-# LINE 137 ".\\HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs" #-} -- | Gets a single animation by index. Will NOT pick up animations in linked skeletons (addLinkedSkeletonAnimationSource getAnimation2 :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Int -- ^ index -> IO (HG3DClass) -- ^ getAnimation2 a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromIntegral a2} in alloca $ \a3' -> getAnimation2'_ a1' a2' a3' >>= \res -> peek a3'>>= \a3'' -> return (a3'') {-# LINE 143 ".\\HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs" #-} -- | Gets the animation blending mode which this skeleton will use. getBlendMode :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (EnumSkeletonAnimationBlendMode) -- ^ getBlendMode a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getBlendMode'_ a1' a2' >>= \res -> peekEnumUtil a2'>>= \a2'' -> return (a2'') {-# LINE 148 ".\\HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs" #-} -- | Sets the animation blending mode this skeleton will use. setBlendMode :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> EnumSkeletonAnimationBlendMode -- ^ state -> IO () -- ^ setBlendMode a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = cIntFromEnum a2} in setBlendMode'_ a1' a2' >>= \res -> return () {-# LINE 153 ".\\HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs" #-} -- | Optimise all of this skeleton's animations. Animation::optimise optimiseAllAnimations :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Bool -- ^ preservingIdentityNodeTracks - If true, don't destroy identity node tracks. -> IO () -- ^ optimiseAllAnimations a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromBool a2} in optimiseAllAnimations'_ a1' a2' >>= \res -> return () {-# LINE 158 ".\\HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs" #-} -- | Allows you to use the animations from another SkeletonIf you have skeletons of identical structure (that means identically named bones with identical handles, and with the same hierarchy), but slightly different proportions or binding poses, you can re-use animations from one in the other. Because animations are actually stored as changes to bones from their bind positions, it's possible to use the same animation data for different skeletons, provided the skeletal structure matches and the 'deltas' stored in the keyframes apply equally well to the other skeletons bind position (so they must be roughly similar, but don't have to be identical). You can use the 'scale' option to adjust the translation and scale keyframes where there are large differences in size between the skeletons. This method takes a skeleton name, rather than a more specific animation name, for two reasons; firstly it allows some validation of compatibility of skeletal structure, and secondly skeletons are the unit of loading. Linking a skeleton to another in this way means that the linkee will be prevented from being destroyed until the linker is destroyed. addLinkedSkeletonAnimationSource :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> String -- ^ skelName - Name of the skeleton to link animations from. This skeleton will be loaded immediately if this skeleton is already loaded, otherwise it will be loaded when this skeleton is. -> Float -- ^ scale - A scale factor to apply to translation and scaling elements of the keyframes in the other skeleton when applying the animations to this one. Compensates for skeleton size differences. -> IO () -- ^ addLinkedSkeletonAnimationSource a1 a2 a3 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> let {a3' = realToFrac a3} in addLinkedSkeletonAnimationSource'_ a1' a2' a3' >>= \res -> return () {-# LINE 164 ".\\HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs" #-} -- | Remove all links to other skeletons for the purposes of sharing animation. removeAllLinkedSkeletonAnimationSources :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO () -- ^ removeAllLinkedSkeletonAnimationSources a1 = withHG3DClass a1 $ \a1' -> removeAllLinkedSkeletonAnimationSources'_ a1' >>= \res -> return () {-# LINE 168 ".\\HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs" #-} -- | Have manual bones been modified since the skeleton was last updated? getManualBonesDirty :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (Bool) -- ^ getManualBonesDirty a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getManualBonesDirty'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 173 ".\\HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs" #-} -- | Are there any manually controlled bones? hasManualBones :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (Bool) -- ^ hasManualBones a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> hasManualBones'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 178 ".\\HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs" #-} foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs.h ogre_skl_destruct" delete'_ :: ((HG3DClassPtr) -> (IO ())) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs.h ogre_skl_createBone" createBone'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs.h ogre_skl_createBone2" createBone2'_ :: ((HG3DClassPtr) -> (CUShort -> ((HG3DClassPtr) -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs.h ogre_skl_createBone3" createBone3'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> ((HG3DClassPtr) -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs.h ogre_skl_createBone4" createBone4'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (CUShort -> ((HG3DClassPtr) -> (IO ()))))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs.h ogre_skl_getNumBones" getNumBones'_ :: ((HG3DClassPtr) -> ((Ptr CUShort) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs.h ogre_skl_getRootBone" getRootBone'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs.h ogre_skl_getBone" getBone'_ :: ((HG3DClassPtr) -> (CUShort -> ((HG3DClassPtr) -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs.h ogre_skl_getBone2" getBone2'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> ((HG3DClassPtr) -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs.h ogre_skl_hasBone" hasBone'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> ((Ptr CInt) -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs.h ogre_skl_setBindingPose" setBindingPose'_ :: ((HG3DClassPtr) -> (IO ())) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs.h ogre_skl_reset" reset'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs.h ogre_skl_createAnimation" createAnimation'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (CFloat -> ((HG3DClassPtr) -> (IO ()))))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs.h ogre_skl_hasAnimation" hasAnimation'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> ((Ptr CInt) -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs.h ogre_skl_removeAnimation" removeAnimation'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs.h ogre_skl_setAnimationState" setAnimationState'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs.h ogre_skl_getNumAnimations" getNumAnimations'_ :: ((HG3DClassPtr) -> ((Ptr CUShort) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs.h ogre_skl_getAnimation2" getAnimation2'_ :: ((HG3DClassPtr) -> (CUShort -> ((HG3DClassPtr) -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs.h ogre_skl_getBlendMode" getBlendMode'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs.h ogre_skl_setBlendMode" setBlendMode'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs.h ogre_skl_optimiseAllAnimations" optimiseAllAnimations'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs.h ogre_skl_addLinkedSkeletonAnimationSource" addLinkedSkeletonAnimationSource'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (CFloat -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs.h ogre_skl_removeAllLinkedSkeletonAnimationSources" removeAllLinkedSkeletonAnimationSources'_ :: ((HG3DClassPtr) -> (IO ())) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs.h ogre_skl_getManualBonesDirty" getManualBonesDirty'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassSkeleton.chs.h ogre_skl_hasManualBones" hasManualBones'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ())))