-- 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\\ClassNode.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. -- -- ClassNode.chs -- module HGamer3D.Bindings.Ogre.ClassNode 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\\ClassNode.chs" #-} import HGamer3D.Bindings.Ogre.ClassPtr {-# LINE 41 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} import HGamer3D.Bindings.Ogre.StructHG3DClass {-# LINE 42 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} import HGamer3D.Bindings.Ogre.StructQuaternion {-# LINE 43 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} import HGamer3D.Bindings.Ogre.StructVec3 {-# LINE 44 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} import HGamer3D.Bindings.Ogre.EnumNodeTransformSpace {-# LINE 45 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} import HGamer3D.Bindings.Ogre.StructRadians {-# LINE 46 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.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 51 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Returns the name of the node. 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 56 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Gets this node's parent (NULL if this is the root). getParent :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (HG3DClass) -- ^ getParent a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getParent'_ a1' a2' >>= \res -> peek a2'>>= \a2'' -> return (a2'') {-# LINE 61 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Returns a quaternion representing the nodes orientation. getOrientation :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (Quaternion) -- ^ getOrientation a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getOrientation'_ a1' a2' >>= \res -> peekQuaternion a2'>>= \a2'' -> return (a2'') {-# LINE 66 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Sets the orientation of this node via a quaternion. Orientations, unlike other transforms, are not always inherited by child nodes. Whether or not orientations affect the orientation of the child nodes depends on the setInheritOrientation option of the child. In some cases you want a orientating of a parent node to apply to a child node (e.g. where the child node is a part of the same object, so you want it to be the same relative orientation based on the parent's orientation), but not in other cases (e.g. where the child node is just for positioning another object, you want it to maintain it's own orientation). The default is to inherit as with other transforms. Note that rotations are oriented around the node's origin. setOrientation :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Quaternion -- ^ q -> IO () -- ^ setOrientation a1 a2 = withHG3DClass a1 $ \a1' -> withQuaternion a2 $ \a2' -> setOrientation'_ a1' a2' >>= \res -> return () {-# LINE 71 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Sets the orientation of this node via quaternion parameters. Orientations, unlike other transforms, are not always inherited by child nodes. Whether or not orientations affect the orientation of the child nodes depends on the setInheritOrientation option of the child. In some cases you want a orientating of a parent node to apply to a child node (e.g. where the child node is a part of the same object, so you want it to be the same relative orientation based on the parent's orientation), but not in other cases (e.g. where the child node is just for positioning another object, you want it to maintain it's own orientation). The default is to inherit as with other transforms. Note that rotations are oriented around the node's origin. setOrientation2 :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Float -- ^ w -> Float -- ^ x -> Float -- ^ y -> Float -- ^ z -> IO () -- ^ setOrientation2 a1 a2 a3 a4 a5 = withHG3DClass a1 $ \a1' -> let {a2' = realToFrac a2} in let {a3' = realToFrac a3} in let {a4' = realToFrac a4} in let {a5' = realToFrac a5} in setOrientation2'_ a1' a2' a3' a4' a5' >>= \res -> return () {-# LINE 79 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Resets the nodes orientation (local axes as world axes, no rotation). Orientations, unlike other transforms, are not always inherited by child nodes. Whether or not orientations affect the orientation of the child nodes depends on the setInheritOrientation option of the child. In some cases you want a orientating of a parent node to apply to a child node (e.g. where the child node is a part of the same object, so you want it to be the same relative orientation based on the parent's orientation), but not in other cases (e.g. where the child node is just for positioning another object, you want it to maintain it's own orientation). The default is to inherit as with other transforms. Note that rotations are oriented around the node's origin. resetOrientation :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO () -- ^ resetOrientation a1 = withHG3DClass a1 $ \a1' -> resetOrientation'_ a1' >>= \res -> return () {-# LINE 83 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Sets the position of the node relative to it's parent. setPosition :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Vec3 -- ^ pos -> IO () -- ^ setPosition a1 a2 = withHG3DClass a1 $ \a1' -> withVec3 a2 $ \a2' -> setPosition'_ a1' a2' >>= \res -> return () {-# LINE 88 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Sets the position of the node relative to it's parent. setPosition2 :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Float -- ^ x -> Float -- ^ y -> Float -- ^ z -> IO () -- ^ setPosition2 a1 a2 a3 a4 = withHG3DClass a1 $ \a1' -> let {a2' = realToFrac a2} in let {a3' = realToFrac a3} in let {a4' = realToFrac a4} in setPosition2'_ a1' a2' a3' a4' >>= \res -> return () {-# LINE 95 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Gets the position of the node relative to it's parent. getPosition :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (Vec3) -- ^ getPosition a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getPosition'_ a1' a2' >>= \res -> peekVec3 a2'>>= \a2'' -> return (a2'') {-# LINE 100 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Sets the scaling factor applied to this node. Scaling factors, unlike other transforms, are not always inherited by child nodes. Whether or not scalings affect the size of the child nodes depends on the setInheritScale option of the child. In some cases you want a scaling factor of a parent node to apply to a child node (e.g. where the child node is a part of the same object, so you want it to be the same relative size based on the parent's size), but not in other cases (e.g. where the child node is just for positioning another object, you want it to maintain it's own size). The default is to inherit as with other transforms. Note that like rotations, scalings are oriented around the node's origin. setScale :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Vec3 -- ^ scale -> IO () -- ^ setScale a1 a2 = withHG3DClass a1 $ \a1' -> withVec3 a2 $ \a2' -> setScale'_ a1' a2' >>= \res -> return () {-# LINE 105 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Sets the scaling factor applied to this node. Scaling factors, unlike other transforms, are not always inherited by child nodes. Whether or not scalings affect the size of the child nodes depends on the setInheritScale option of the child. In some cases you want a scaling factor of a parent node to apply to a child node (e.g. where the child node is a part of the same object, so you want it to be the same relative size based on the parent's size), but not in other cases (e.g. where the child node is just for positioning another object, you want it to maintain it's own size). The default is to inherit as with other transforms. Note that like rotations, scalings are oriented around the node's origin. setScale2 :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Float -- ^ x -> Float -- ^ y -> Float -- ^ z -> IO () -- ^ setScale2 a1 a2 a3 a4 = withHG3DClass a1 $ \a1' -> let {a2' = realToFrac a2} in let {a3' = realToFrac a3} in let {a4' = realToFrac a4} in setScale2'_ a1' a2' a3' a4' >>= \res -> return () {-# LINE 112 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Gets the scaling factor of this node. getScale :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (Vec3) -- ^ getScale a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getScale'_ a1' a2' >>= \res -> peekVec3 a2'>>= \a2'' -> return (a2'') {-# LINE 117 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Tells the node whether it should inherit orientation from it's parent node. Orientations, unlike other transforms, are not always inherited by child nodes. Whether or not orientations affect the orientation of the child nodes depends on the setInheritOrientation option of the child. In some cases you want a orientating of a parent node to apply to a child node (e.g. where the child node is a part of the same object, so you want it to be the same relative orientation based on the parent's orientation), but not in other cases (e.g. where the child node is just for positioning another object, you want it to maintain it's own orientation). The default is to inherit as with other transforms. setInheritOrientation :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Bool -- ^ inherit - If true, this node's orientation will be affected by its parent's orientation. If false, it will not be affected. -> IO () -- ^ setInheritOrientation a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromBool a2} in setInheritOrientation'_ a1' a2' >>= \res -> return () {-# LINE 122 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Returns true if this node is affected by orientation applied to the parent node. Orientations, unlike other transforms, are not always inherited by child nodes. Whether or not orientations affect the orientation of the child nodes depends on the setInheritOrientation option of the child. In some cases you want a orientating of a parent node to apply to a child node (e.g. where the child node is a part of the same object, so you want it to be the same relative orientation based on the parent's orientation), but not in other cases (e.g. where the child node is just for positioning another object, you want it to maintain it's own orientation). The default is to inherit as with other transforms. --See setInheritOrientation for more info. getInheritOrientation :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (Bool) -- ^ getInheritOrientation a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getInheritOrientation'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 127 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Tells the node whether it should inherit scaling factors from it's parent node. Scaling factors, unlike other transforms, are not always inherited by child nodes. Whether or not scalings affect the size of the child nodes depends on the setInheritScale option of the child. In some cases you want a scaling factor of a parent node to apply to a child node (e.g. where the child node is a part of the same object, so you want it to be the same relative size based on the parent's size), but not in other cases (e.g. where the child node is just for positioning another object, you want it to maintain it's own size). The default is to inherit as with other transforms. setInheritScale :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Bool -- ^ inherit - If true, this node's scale will be affected by its parent's scale. If false, it will not be affected. -> IO () -- ^ setInheritScale a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromBool a2} in setInheritScale'_ a1' a2' >>= \res -> return () {-# LINE 132 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Returns true if this node is affected by scaling factors applied to the parent node. See setInheritScale for more info. getInheritScale :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (Bool) -- ^ getInheritScale a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getInheritScale'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 137 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Scales the node, combining it's current scale with the passed in scaling factor. This method applies an extra scaling factor to the node's existing scale, (unlike setScale which overwrites it) combining it's current scale with the new one. E.g. calling this method twice with Vector3(2,2,2) would have the same effect as setScale(Vector3(4,4,4)) if the existing scale was 1. Note that like rotations, scalings are oriented around the node's origin. scale :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Vec3 -- ^ scale -> IO () -- ^ scale a1 a2 = withHG3DClass a1 $ \a1' -> withVec3 a2 $ \a2' -> scale'_ a1' a2' >>= \res -> return () {-# LINE 142 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Scales the node, combining it's current scale with the passed in scaling factor. This method applies an extra scaling factor to the node's existing scale, (unlike setScale which overwrites it) combining it's current scale with the new one. E.g. calling this method twice with Vector3(2,2,2) would have the same effect as setScale(Vector3(4,4,4)) if the existing scale was 1. Note that like rotations, scalings are oriented around the node's origin. scale2 :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Float -- ^ x -> Float -- ^ y -> Float -- ^ z -> IO () -- ^ scale2 a1 a2 a3 a4 = withHG3DClass a1 $ \a1' -> let {a2' = realToFrac a2} in let {a3' = realToFrac a3} in let {a4' = realToFrac a4} in scale2'_ a1' a2' a3' a4' >>= \res -> return () {-# LINE 149 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Moves the node along the Cartesian axes. This method moves the node by the supplied vector along the world Cartesian axes, i.e. along world x,y,z translate :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Vec3 -- ^ d - Vector with x,y,z values representing the translation. -> EnumNodeTransformSpace -- ^ relativeTo - The space which this transform is relative to. -> IO () -- ^ translate a1 a2 a3 = withHG3DClass a1 $ \a1' -> withVec3 a2 $ \a2' -> let {a3' = cIntFromEnum a3} in translate'_ a1' a2' a3' >>= \res -> return () {-# LINE 155 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Moves the node along the Cartesian axes. This method moves the node by the supplied vector along the world Cartesian axes, i.e. along world x,y,z translate2 :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Float -- ^ x -> Float -- ^ y -> Float -- ^ z - Real x, y and z values representing the translation. -> EnumNodeTransformSpace -- ^ relativeTo - The space which this transform is relative to. -> IO () -- ^ translate2 a1 a2 a3 a4 a5 = withHG3DClass a1 $ \a1' -> let {a2' = realToFrac a2} in let {a3' = realToFrac a3} in let {a4' = realToFrac a4} in let {a5' = cIntFromEnum a5} in translate2'_ a1' a2' a3' a4' a5' >>= \res -> return () {-# LINE 163 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Rotate the node around the Z-axis. roll :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Radians -- ^ angle -> EnumNodeTransformSpace -- ^ relativeTo -> IO () -- ^ roll a1 a2 a3 = withHG3DClass a1 $ \a1' -> withRadians a2 $ \a2' -> let {a3' = cIntFromEnum a3} in roll'_ a1' a2' a3' >>= \res -> return () {-# LINE 169 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Rotate the node around the X-axis. pitch :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Radians -- ^ angle -> EnumNodeTransformSpace -- ^ relativeTo -> IO () -- ^ pitch a1 a2 a3 = withHG3DClass a1 $ \a1' -> withRadians a2 $ \a2' -> let {a3' = cIntFromEnum a3} in pitch'_ a1' a2' a3' >>= \res -> return () {-# LINE 175 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Rotate the node around the Y-axis. yaw :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Radians -- ^ angle -> EnumNodeTransformSpace -- ^ relativeTo -> IO () -- ^ yaw a1 a2 a3 = withHG3DClass a1 $ \a1' -> withRadians a2 $ \a2' -> let {a3' = cIntFromEnum a3} in yaw'_ a1' a2' a3' >>= \res -> return () {-# LINE 181 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Rotate the node around an arbitrary axis. rotate :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Vec3 -- ^ axis -> Radians -- ^ angle -> EnumNodeTransformSpace -- ^ relativeTo -> IO () -- ^ rotate a1 a2 a3 a4 = withHG3DClass a1 $ \a1' -> withVec3 a2 $ \a2' -> withRadians a3 $ \a3' -> let {a4' = cIntFromEnum a4} in rotate'_ a1' a2' a3' a4' >>= \res -> return () {-# LINE 188 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Rotate the node around an aritrary axis using a Quarternion. rotate2 :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Quaternion -- ^ q -> EnumNodeTransformSpace -- ^ relativeTo -> IO () -- ^ rotate2 a1 a2 a3 = withHG3DClass a1 $ \a1' -> withQuaternion a2 $ \a2' -> let {a3' = cIntFromEnum a3} in rotate2'_ a1' a2' a3' >>= \res -> return () {-# LINE 194 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Creates an unnamed new Node createChild :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Vec3 -- ^ translate - Initial translation offset of child relative to parent -> Quaternion -- ^ rotate - Initial rotation relative to parent -> IO (HG3DClass) -- ^ createChild a1 a2 a3 = withHG3DClass a1 $ \a1' -> withVec3 a2 $ \a2' -> withQuaternion a3 $ \a3' -> alloca $ \a4' -> createChild'_ a1' a2' a3' a4' >>= \res -> peek a4'>>= \a4'' -> return (a4'') {-# LINE 201 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Creates a new named NodeThis creates a child node with a given name, which allows you to look the node up from the parent which holds this collection of nodes. createChild2 :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> String -- ^ name -> Vec3 -- ^ translate - Initial translation offset of child relative to parent -> Quaternion -- ^ rotate - Initial rotation relative to parent -> IO (HG3DClass) -- ^ createChild2 a1 a2 a3 a4 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> withVec3 a3 $ \a3' -> withQuaternion a4 $ \a4' -> alloca $ \a5' -> createChild2'_ a1' a2' a3' a4' a5' >>= \res -> peek a5'>>= \a5'' -> return (a5'') {-# LINE 209 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Adds a (precreated) child scene node to this node. If it is attached to another node, it must be detached first. addChild :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> HG3DClass -- ^ child - The Node which is to become a child node of this one -> IO () -- ^ addChild a1 a2 = withHG3DClass a1 $ \a1' -> withHG3DClass a2 $ \a2' -> addChild'_ a1' a2' >>= \res -> return () {-# LINE 214 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Reports the number of child nodes under this one. numChildren :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (Int) -- ^ numChildren a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> numChildren'_ a1' a2' >>= \res -> peekIntConv a2'>>= \a2'' -> return (a2'') {-# LINE 219 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Gets a pointer to a child node. There is an alternate getChild method which returns a named child. getChild :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Int -- ^ index -> IO (HG3DClass) -- ^ getChild a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromIntegral a2} in alloca $ \a3' -> getChild'_ a1' a2' a3' >>= \res -> peek a3'>>= \a3'' -> return (a3'') {-# LINE 225 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Gets a pointer to a named child node. getChild2 :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> String -- ^ name -> IO (HG3DClass) -- ^ getChild2 a1 a2 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> alloca $ \a3' -> getChild2'_ a1' a2' a3' >>= \res -> peek a3'>>= \a3'' -> return (a3'') {-# LINE 231 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Drops the specified child from this node. Does not delete the node, just detaches it from this parent, potentially to be reattached elsewhere. There is also an alternate version which drops a named child from this node. removeChild :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Int -- ^ index -> IO (HG3DClass) -- ^ removeChild a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromIntegral a2} in alloca $ \a3' -> removeChild'_ a1' a2' a3' >>= \res -> peek a3'>>= \a3'' -> return (a3'') {-# LINE 237 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Drops the specified child from this node. Does not delete the node, just detaches it from this parent, potentially to be reattached elsewhere. There is also an alternate version which drops a named child from this node. removeChild2 :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> HG3DClass -- ^ child -> IO (HG3DClass) -- ^ removeChild2 a1 a2 = withHG3DClass a1 $ \a1' -> withHG3DClass a2 $ \a2' -> alloca $ \a3' -> removeChild2'_ a1' a2' a3' >>= \res -> peek a3'>>= \a3'' -> return (a3'') {-# LINE 243 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Drops the named child from this node. Does not delete the node, just detaches it from this parent, potentially to be reattached elsewhere. removeChild3 :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> String -- ^ name -> IO (HG3DClass) -- ^ removeChild3 a1 a2 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> alloca $ \a3' -> removeChild3'_ a1' a2' a3' >>= \res -> peek a3'>>= \a3'' -> return (a3'') {-# LINE 249 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Removes all child Nodes attached to this node. Does not delete the nodes, just detaches them from this parent, potentially to be reattached elsewhere. removeAllChildren :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO () -- ^ removeAllChildren a1 = withHG3DClass a1 $ \a1' -> removeAllChildren'_ a1' >>= \res -> return () {-# LINE 253 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Sets the current transform of this node to be the 'initial state' ie that position / orientation / scale to be used as a basis for delta values used in keyframe animation. You never need to call this method unless you plan to animate this node. If you do plan to animate it, call this method once you've loaded the node with it's base state, ie the state on which all keyframes are based. If you never call this method, the initial state is the identity transform, ie do nothing. setInitialState :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO () -- ^ setInitialState a1 = withHG3DClass a1 $ \a1' -> setInitialState'_ a1' >>= \res -> return () {-# LINE 257 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Resets the position / orientation / scale of this node to it's initial state, see setInitialState for more info. resetToInitialState :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO () -- ^ resetToInitialState a1 = withHG3DClass a1 $ \a1' -> resetToInitialState'_ a1' >>= \res -> return () {-# LINE 261 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Gets the initial position of this node, see setInitialState for more info. Also resets the cumulative animation weight used for blending. getInitialPosition :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (Vec3) -- ^ getInitialPosition a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getInitialPosition'_ a1' a2' >>= \res -> peekVec3 a2'>>= \a2'' -> return (a2'') {-# LINE 266 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Gets the local position, relative to this node, of the given world-space position convertWorldToLocalPosition :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Vec3 -- ^ worldPos -> IO (Vec3) -- ^ convertWorldToLocalPosition a1 a2 = withHG3DClass a1 $ \a1' -> withVec3 a2 $ \a2' -> alloca $ \a3' -> convertWorldToLocalPosition'_ a1' a2' a3' >>= \res -> peekVec3 a3'>>= \a3'' -> return (a3'') {-# LINE 272 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Gets the world position of a point in the node local space useful for simple transforms that don't require a child node. convertLocalToWorldPosition :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Vec3 -- ^ localPos -> IO (Vec3) -- ^ convertLocalToWorldPosition a1 a2 = withHG3DClass a1 $ \a1' -> withVec3 a2 $ \a2' -> alloca $ \a3' -> convertLocalToWorldPosition'_ a1' a2' a3' >>= \res -> peekVec3 a3'>>= \a3'' -> return (a3'') {-# LINE 278 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Gets the local orientation, relative to this node, of the given world-space orientation convertWorldToLocalOrientation :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Quaternion -- ^ worldOrientation -> IO (Quaternion) -- ^ convertWorldToLocalOrientation a1 a2 = withHG3DClass a1 $ \a1' -> withQuaternion a2 $ \a2' -> alloca $ \a3' -> convertWorldToLocalOrientation'_ a1' a2' a3' >>= \res -> peekQuaternion a3'>>= \a3'' -> return (a3'') {-# LINE 284 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Gets the world orientation of an orientation in the node local space useful for simple transforms that don't require a child node. convertLocalToWorldOrientation :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Quaternion -- ^ localOrientation -> IO (Quaternion) -- ^ convertLocalToWorldOrientation a1 a2 = withHG3DClass a1 $ \a1' -> withQuaternion a2 $ \a2' -> alloca $ \a3' -> convertLocalToWorldOrientation'_ a1' a2' a3' >>= \res -> peekQuaternion a3'>>= \a3'' -> return (a3'') {-# LINE 290 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Gets the initial orientation of this node, see setInitialState for more info. getInitialOrientation :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (Quaternion) -- ^ getInitialOrientation a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getInitialOrientation'_ a1' a2' >>= \res -> peekQuaternion a2'>>= \a2'' -> return (a2'') {-# LINE 295 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Gets the initial position of this node, see setInitialState for more info. getInitialScale :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> IO (Vec3) -- ^ getInitialScale a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getInitialScale'_ a1' a2' >>= \res -> peekVec3 a2'>>= \a2'' -> return (a2'') {-# LINE 300 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Helper function, get the squared view depth. getSquaredViewDepth :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> HG3DClass -- ^ cam -> IO (Float) -- ^ getSquaredViewDepth a1 a2 = withHG3DClass a1 $ \a1' -> withHG3DClass a2 $ \a2' -> alloca $ \a3' -> getSquaredViewDepth'_ a1' a2' a3' >>= \res -> peekFloatConv a3'>>= \a3'' -> return (a3'') {-# LINE 306 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | To be called in the event of transform changes to this node that require it's recalculation. This not only tags the node state as being 'dirty', it also requests it's parent to know about it's dirtiness so it will get an update next time. needUpdate :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> Bool -- ^ forceParentUpdate - Even if the node thinks it has already told it's parent, tell it anyway -> IO () -- ^ needUpdate a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromBool a2} in needUpdate'_ a1' a2' >>= \res -> return () {-# LINE 311 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Called by children to notify their parent that they need an update. requestUpdate :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> HG3DClass -- ^ child -> Bool -- ^ forceParentUpdate - Even if the node thinks it has already told it's parent, tell it anyway -> IO () -- ^ requestUpdate a1 a2 a3 = withHG3DClass a1 $ \a1' -> withHG3DClass a2 $ \a2' -> let {a3' = fromBool a3} in requestUpdate'_ a1' a2' a3' >>= \res -> return () {-# LINE 317 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Called by children to notify their parent that they no longer need an update. cancelUpdate :: HG3DClass -- ^ classpointer - pointer of Class instance from which this methods is called. -> HG3DClass -- ^ child -> IO () -- ^ cancelUpdate a1 a2 = withHG3DClass a1 $ \a1' -> withHG3DClass a2 $ \a2' -> cancelUpdate'_ a1' a2' >>= \res -> return () {-# LINE 322 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Queue a 'needUpdate' call to a node safely. You can't call needUpdate()Node::Listener queueNeedUpdate :: HG3DClass -- ^ n -> IO () -- ^ queueNeedUpdate a1 = withHG3DClass a1 $ \a1' -> queueNeedUpdate'_ a1' >>= \res -> return () {-# LINE 326 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} -- | Process queued 'needUpdate' calls. processQueuedUpdates :: IO () -- ^ processQueuedUpdates = processQueuedUpdates'_ >>= \res -> return () {-# LINE 330 ".\\HGamer3D\\Bindings\\Ogre\\ClassNode.chs" #-} foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_destruct" delete'_ :: ((HG3DClassPtr) -> (IO ())) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_getName" getName'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_getParent" getParent'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_getOrientation" getOrientation'_ :: ((HG3DClassPtr) -> ((QuaternionPtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_setOrientation" setOrientation'_ :: ((HG3DClassPtr) -> ((QuaternionPtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_setOrientation2" setOrientation2'_ :: ((HG3DClassPtr) -> (CFloat -> (CFloat -> (CFloat -> (CFloat -> (IO ())))))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_resetOrientation" resetOrientation'_ :: ((HG3DClassPtr) -> (IO ())) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_setPosition" setPosition'_ :: ((HG3DClassPtr) -> ((Vec3Ptr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_setPosition2" setPosition2'_ :: ((HG3DClassPtr) -> (CFloat -> (CFloat -> (CFloat -> (IO ()))))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_getPosition" getPosition'_ :: ((HG3DClassPtr) -> ((Vec3Ptr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_setScale" setScale'_ :: ((HG3DClassPtr) -> ((Vec3Ptr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_setScale2" setScale2'_ :: ((HG3DClassPtr) -> (CFloat -> (CFloat -> (CFloat -> (IO ()))))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_getScale" getScale'_ :: ((HG3DClassPtr) -> ((Vec3Ptr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_setInheritOrientation" setInheritOrientation'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_getInheritOrientation" getInheritOrientation'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_setInheritScale" setInheritScale'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_getInheritScale" getInheritScale'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_scale" scale'_ :: ((HG3DClassPtr) -> ((Vec3Ptr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_scale2" scale2'_ :: ((HG3DClassPtr) -> (CFloat -> (CFloat -> (CFloat -> (IO ()))))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_translate" translate'_ :: ((HG3DClassPtr) -> ((Vec3Ptr) -> (CInt -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_translate2" translate2'_ :: ((HG3DClassPtr) -> (CFloat -> (CFloat -> (CFloat -> (CInt -> (IO ())))))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_roll" roll'_ :: ((HG3DClassPtr) -> ((RadiansPtr) -> (CInt -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_pitch" pitch'_ :: ((HG3DClassPtr) -> ((RadiansPtr) -> (CInt -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_yaw" yaw'_ :: ((HG3DClassPtr) -> ((RadiansPtr) -> (CInt -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_rotate" rotate'_ :: ((HG3DClassPtr) -> ((Vec3Ptr) -> ((RadiansPtr) -> (CInt -> (IO ()))))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_rotate2" rotate2'_ :: ((HG3DClassPtr) -> ((QuaternionPtr) -> (CInt -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_createChild" createChild'_ :: ((HG3DClassPtr) -> ((Vec3Ptr) -> ((QuaternionPtr) -> ((HG3DClassPtr) -> (IO ()))))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_createChild2" createChild2'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> ((Vec3Ptr) -> ((QuaternionPtr) -> ((HG3DClassPtr) -> (IO ())))))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_addChild" addChild'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_numChildren" numChildren'_ :: ((HG3DClassPtr) -> ((Ptr CUShort) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_getChild" getChild'_ :: ((HG3DClassPtr) -> (CUShort -> ((HG3DClassPtr) -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_getChild2" getChild2'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> ((HG3DClassPtr) -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_removeChild" removeChild'_ :: ((HG3DClassPtr) -> (CUShort -> ((HG3DClassPtr) -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_removeChild2" removeChild2'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_removeChild3" removeChild3'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> ((HG3DClassPtr) -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_removeAllChildren" removeAllChildren'_ :: ((HG3DClassPtr) -> (IO ())) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_setInitialState" setInitialState'_ :: ((HG3DClassPtr) -> (IO ())) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_resetToInitialState" resetToInitialState'_ :: ((HG3DClassPtr) -> (IO ())) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_getInitialPosition" getInitialPosition'_ :: ((HG3DClassPtr) -> ((Vec3Ptr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_convertWorldToLocalPosition" convertWorldToLocalPosition'_ :: ((HG3DClassPtr) -> ((Vec3Ptr) -> ((Vec3Ptr) -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_convertLocalToWorldPosition" convertLocalToWorldPosition'_ :: ((HG3DClassPtr) -> ((Vec3Ptr) -> ((Vec3Ptr) -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_convertWorldToLocalOrientation" convertWorldToLocalOrientation'_ :: ((HG3DClassPtr) -> ((QuaternionPtr) -> ((QuaternionPtr) -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_convertLocalToWorldOrientation" convertLocalToWorldOrientation'_ :: ((HG3DClassPtr) -> ((QuaternionPtr) -> ((QuaternionPtr) -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_getInitialOrientation" getInitialOrientation'_ :: ((HG3DClassPtr) -> ((QuaternionPtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_getInitialScale" getInitialScale'_ :: ((HG3DClassPtr) -> ((Vec3Ptr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_getSquaredViewDepth" getSquaredViewDepth'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> ((Ptr CFloat) -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_needUpdate" needUpdate'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_requestUpdate" requestUpdate'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (CInt -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_cancelUpdate" cancelUpdate'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_queueNeedUpdate" queueNeedUpdate'_ :: ((HG3DClassPtr) -> (IO ())) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassNode.chs.h ogre_nd_processQueuedUpdates" processQueuedUpdates'_ :: (IO ())