-- 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\\ClassManualObject.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. -- -- ClassManualObject.chs -- module HGamer3D.Bindings.Ogre.ClassManualObject 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\\ClassManualObject.chs" #-} import HGamer3D.Bindings.Ogre.ClassPtr {-# LINE 41 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} import HGamer3D.Bindings.Ogre.StructHG3DClass {-# LINE 42 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} import HGamer3D.Bindings.Ogre.EnumRenderOperationOperationType {-# LINE 43 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} import HGamer3D.Bindings.Ogre.StructVec3 {-# LINE 44 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} import HGamer3D.Bindings.Ogre.StructVec2 {-# LINE 45 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} import HGamer3D.Bindings.Ogre.StructColour {-# LINE 46 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} import HGamer3D.Bindings.Ogre.StructSharedPtr {-# LINE 47 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function ManualObject -} new :: String -> IO (HG3DClass) new a1 = withCString a1 $ \a1' -> alloca $ \a2' -> new'_ a1' a2' >>= \res -> peek a2'>>= \a2'' -> return (a2'') {-# LINE 53 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function ~ManualObject -} delete :: HG3DClass -> IO () delete a1 = withHG3DClass a1 $ \a1' -> delete'_ a1' >>= \res -> return () {-# LINE 57 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function clear -} clear :: HG3DClass -> IO () clear a1 = withHG3DClass a1 $ \a1' -> clear'_ a1' >>= \res -> return () {-# LINE 61 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function estimateVertexCount -} estimateVertexCount :: HG3DClass -> Int -> IO () estimateVertexCount a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromIntegral a2} in estimateVertexCount'_ a1' a2' >>= \res -> return () {-# LINE 66 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function estimateIndexCount -} estimateIndexCount :: HG3DClass -> Int -> IO () estimateIndexCount a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromIntegral a2} in estimateIndexCount'_ a1' a2' >>= \res -> return () {-# LINE 71 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function begin -} begin :: HG3DClass -> String -> EnumRenderOperationOperationType -> String -> IO () begin a1 a2 a3 a4 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> let {a3' = cIntFromEnum a3} in withCString a4 $ \a4' -> begin'_ a1' a2' a3' a4' >>= \res -> return () {-# LINE 78 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function setDynamic -} setDynamic :: HG3DClass -> Bool -> IO () setDynamic a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromBool a2} in setDynamic'_ a1' a2' >>= \res -> return () {-# LINE 83 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function getDynamic -} getDynamic :: HG3DClass -> IO (Bool) getDynamic a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getDynamic'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 88 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function beginUpdate -} beginUpdate :: HG3DClass -> Int -> IO () beginUpdate a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromIntegral a2} in beginUpdate'_ a1' a2' >>= \res -> return () {-# LINE 93 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function position -} position :: HG3DClass -> Vec3 -> IO () position a1 a2 = withHG3DClass a1 $ \a1' -> withVec3 a2 $ \a2' -> position'_ a1' a2' >>= \res -> return () {-# LINE 98 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function position2 -} position2 :: HG3DClass -> Float -> Float -> Float -> IO () position2 a1 a2 a3 a4 = withHG3DClass a1 $ \a1' -> let {a2' = realToFrac a2} in let {a3' = realToFrac a3} in let {a4' = realToFrac a4} in position2'_ a1' a2' a3' a4' >>= \res -> return () {-# LINE 105 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function normal -} normal :: HG3DClass -> Vec3 -> IO () normal a1 a2 = withHG3DClass a1 $ \a1' -> withVec3 a2 $ \a2' -> normal'_ a1' a2' >>= \res -> return () {-# LINE 110 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function normal2 -} normal2 :: HG3DClass -> Float -> Float -> Float -> IO () normal2 a1 a2 a3 a4 = withHG3DClass a1 $ \a1' -> let {a2' = realToFrac a2} in let {a3' = realToFrac a3} in let {a4' = realToFrac a4} in normal2'_ a1' a2' a3' a4' >>= \res -> return () {-# LINE 117 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function tangent -} tangent :: HG3DClass -> Vec3 -> IO () tangent a1 a2 = withHG3DClass a1 $ \a1' -> withVec3 a2 $ \a2' -> tangent'_ a1' a2' >>= \res -> return () {-# LINE 122 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function tangent2 -} tangent2 :: HG3DClass -> Float -> Float -> Float -> IO () tangent2 a1 a2 a3 a4 = withHG3DClass a1 $ \a1' -> let {a2' = realToFrac a2} in let {a3' = realToFrac a3} in let {a4' = realToFrac a4} in tangent2'_ a1' a2' a3' a4' >>= \res -> return () {-# LINE 129 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function textureCoord -} textureCoord :: HG3DClass -> Float -> IO () textureCoord a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = realToFrac a2} in textureCoord'_ a1' a2' >>= \res -> return () {-# LINE 134 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function textureCoord2 -} textureCoord2 :: HG3DClass -> Float -> Float -> IO () textureCoord2 a1 a2 a3 = withHG3DClass a1 $ \a1' -> let {a2' = realToFrac a2} in let {a3' = realToFrac a3} in textureCoord2'_ a1' a2' a3' >>= \res -> return () {-# LINE 140 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function textureCoord3 -} textureCoord3 :: HG3DClass -> Float -> Float -> Float -> IO () textureCoord3 a1 a2 a3 a4 = withHG3DClass a1 $ \a1' -> let {a2' = realToFrac a2} in let {a3' = realToFrac a3} in let {a4' = realToFrac a4} in textureCoord3'_ a1' a2' a3' a4' >>= \res -> return () {-# LINE 147 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function textureCoord4 -} textureCoord4 :: HG3DClass -> Float -> Float -> Float -> Float -> IO () textureCoord4 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 textureCoord4'_ a1' a2' a3' a4' a5' >>= \res -> return () {-# LINE 155 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function textureCoord5 -} textureCoord5 :: HG3DClass -> Vec2 -> IO () textureCoord5 a1 a2 = withHG3DClass a1 $ \a1' -> withVec2 a2 $ \a2' -> textureCoord5'_ a1' a2' >>= \res -> return () {-# LINE 160 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function textureCoord6 -} textureCoord6 :: HG3DClass -> Vec3 -> IO () textureCoord6 a1 a2 = withHG3DClass a1 $ \a1' -> withVec3 a2 $ \a2' -> textureCoord6'_ a1' a2' >>= \res -> return () {-# LINE 165 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function colour -} colour :: HG3DClass -> Colour -> IO () colour a1 a2 = withHG3DClass a1 $ \a1' -> withColour a2 $ \a2' -> colour'_ a1' a2' >>= \res -> return () {-# LINE 170 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function colour2 -} colour2 :: HG3DClass -> Float -> Float -> Float -> Float -> IO () colour2 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 colour2'_ a1' a2' a3' a4' a5' >>= \res -> return () {-# LINE 178 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function index -} index :: HG3DClass -> Int -> IO () index a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromIntegral a2} in index'_ a1' a2' >>= \res -> return () {-# LINE 183 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function triangle -} triangle :: HG3DClass -> Int -> Int -> Int -> IO () triangle a1 a2 a3 a4 = withHG3DClass a1 $ \a1' -> let {a2' = fromIntegral a2} in let {a3' = fromIntegral a3} in let {a4' = fromIntegral a4} in triangle'_ a1' a2' a3' a4' >>= \res -> return () {-# LINE 190 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function quad -} quad :: HG3DClass -> Int -> Int -> Int -> Int -> IO () quad a1 a2 a3 a4 a5 = withHG3DClass a1 $ \a1' -> let {a2' = fromIntegral a2} in let {a3' = fromIntegral a3} in let {a4' = fromIntegral a4} in let {a5' = fromIntegral a5} in quad'_ a1' a2' a3' a4' a5' >>= \res -> return () {-# LINE 198 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function getCurrentVertexCount -} getCurrentVertexCount :: HG3DClass -> IO (Int) getCurrentVertexCount a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getCurrentVertexCount'_ a1' a2' >>= \res -> peekIntConv a2'>>= \a2'' -> return (a2'') {-# LINE 203 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function getCurrentIndexCount -} getCurrentIndexCount :: HG3DClass -> IO (Int) getCurrentIndexCount a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getCurrentIndexCount'_ a1' a2' >>= \res -> peekIntConv a2'>>= \a2'' -> return (a2'') {-# LINE 208 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function end -} end :: HG3DClass -> IO (HG3DClass) end a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> end'_ a1' a2' >>= \res -> peek a2'>>= \a2'' -> return (a2'') {-# LINE 213 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function setMaterialName -} setMaterialName :: HG3DClass -> Int -> String -> String -> IO () setMaterialName a1 a2 a3 a4 = withHG3DClass a1 $ \a1' -> let {a2' = fromIntegral a2} in withCString a3 $ \a3' -> withCString a4 $ \a4' -> setMaterialName'_ a1' a2' a3' a4' >>= \res -> return () {-# LINE 220 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function convertToMesh -} convertToMesh :: HG3DClass -> String -> String -> IO (SharedPtr) convertToMesh a1 a2 a3 = withHG3DClass a1 $ \a1' -> withCString a2 $ \a2' -> withCString a3 $ \a3' -> alloca $ \a4' -> convertToMesh'_ a1' a2' a3' a4' >>= \res -> peekSharedPtr a4'>>= \a4'' -> return (a4'') {-# LINE 227 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function setUseIdentityProjection -} setUseIdentityProjection :: HG3DClass -> Bool -> IO () setUseIdentityProjection a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromBool a2} in setUseIdentityProjection'_ a1' a2' >>= \res -> return () {-# LINE 232 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function getUseIdentityProjection -} getUseIdentityProjection :: HG3DClass -> IO (Bool) getUseIdentityProjection a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getUseIdentityProjection'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 237 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function setUseIdentityView -} setUseIdentityView :: HG3DClass -> Bool -> IO () setUseIdentityView a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromBool a2} in setUseIdentityView'_ a1' a2' >>= \res -> return () {-# LINE 242 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function getUseIdentityView -} getUseIdentityView :: HG3DClass -> IO (Bool) getUseIdentityView a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getUseIdentityView'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 247 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function getSection -} getSection :: HG3DClass -> Int -> IO (HG3DClass) getSection a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromIntegral a2} in alloca $ \a3' -> getSection'_ a1' a2' a3' >>= \res -> peek a3'>>= \a3'' -> return (a3'') {-# LINE 253 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function getNumSections -} getNumSections :: HG3DClass -> IO (Int) getNumSections a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getNumSections'_ a1' a2' >>= \res -> peekIntConv a2'>>= \a2'' -> return (a2'') {-# LINE 258 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function setKeepDeclarationOrder -} setKeepDeclarationOrder :: HG3DClass -> Bool -> IO () setKeepDeclarationOrder a1 a2 = withHG3DClass a1 $ \a1' -> let {a2' = fromBool a2} in setKeepDeclarationOrder'_ a1' a2' >>= \res -> return () {-# LINE 263 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function getKeepDeclarationOrder -} getKeepDeclarationOrder :: HG3DClass -> IO (Bool) getKeepDeclarationOrder a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getKeepDeclarationOrder'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 268 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function getMovableType -} getMovableType :: HG3DClass -> IO (String) getMovableType a1 = withHG3DClass a1 $ \a1' -> alloc64k $ \a2' -> getMovableType'_ a1' a2' >>= \res -> peekCString a2'>>= \a2'' -> return (a2'') {-# LINE 273 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function getBoundingRadius -} getBoundingRadius :: HG3DClass -> IO (Float) getBoundingRadius a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> getBoundingRadius'_ a1' a2' >>= \res -> peekFloatConv a2'>>= \a2'' -> return (a2'') {-# LINE 278 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} {- function hasEdgeList -} hasEdgeList :: HG3DClass -> IO (Bool) hasEdgeList a1 = withHG3DClass a1 $ \a1' -> alloca $ \a2' -> hasEdgeList'_ a1' a2' >>= \res -> peekBoolUtil a2'>>= \a2'' -> return (a2'') {-# LINE 283 ".\\HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs" #-} foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_construct" new'_ :: ((Ptr CChar) -> ((HG3DClassPtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_destruct" delete'_ :: ((HG3DClassPtr) -> (IO ())) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_clear" clear'_ :: ((HG3DClassPtr) -> (IO ())) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_estimateVertexCount" estimateVertexCount'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_estimateIndexCount" estimateIndexCount'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_begin" begin'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (CInt -> ((Ptr CChar) -> (IO ()))))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_setDynamic" setDynamic'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_getDynamic" getDynamic'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_beginUpdate" beginUpdate'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_position" position'_ :: ((HG3DClassPtr) -> ((Vec3Ptr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_position2" position2'_ :: ((HG3DClassPtr) -> (CFloat -> (CFloat -> (CFloat -> (IO ()))))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_normal" normal'_ :: ((HG3DClassPtr) -> ((Vec3Ptr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_normal2" normal2'_ :: ((HG3DClassPtr) -> (CFloat -> (CFloat -> (CFloat -> (IO ()))))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_tangent" tangent'_ :: ((HG3DClassPtr) -> ((Vec3Ptr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_tangent2" tangent2'_ :: ((HG3DClassPtr) -> (CFloat -> (CFloat -> (CFloat -> (IO ()))))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_textureCoord" textureCoord'_ :: ((HG3DClassPtr) -> (CFloat -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_textureCoord2" textureCoord2'_ :: ((HG3DClassPtr) -> (CFloat -> (CFloat -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_textureCoord3" textureCoord3'_ :: ((HG3DClassPtr) -> (CFloat -> (CFloat -> (CFloat -> (IO ()))))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_textureCoord4" textureCoord4'_ :: ((HG3DClassPtr) -> (CFloat -> (CFloat -> (CFloat -> (CFloat -> (IO ())))))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_textureCoord5" textureCoord5'_ :: ((HG3DClassPtr) -> ((Vec2Ptr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_textureCoord6" textureCoord6'_ :: ((HG3DClassPtr) -> ((Vec3Ptr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_colour" colour'_ :: ((HG3DClassPtr) -> ((ColourPtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_colour2" colour2'_ :: ((HG3DClassPtr) -> (CFloat -> (CFloat -> (CFloat -> (CFloat -> (IO ())))))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_index" index'_ :: ((HG3DClassPtr) -> (CUInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_triangle" triangle'_ :: ((HG3DClassPtr) -> (CUInt -> (CUInt -> (CUInt -> (IO ()))))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_quad" quad'_ :: ((HG3DClassPtr) -> (CUInt -> (CUInt -> (CUInt -> (CUInt -> (IO ())))))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_getCurrentVertexCount" getCurrentVertexCount'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_getCurrentIndexCount" getCurrentIndexCount'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_end" end'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_setMaterialName" setMaterialName'_ :: ((HG3DClassPtr) -> (CInt -> ((Ptr CChar) -> ((Ptr CChar) -> (IO ()))))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_convertToMesh" convertToMesh'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> ((Ptr CChar) -> ((SharedPtrPtr) -> (IO ()))))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_setUseIdentityProjection" setUseIdentityProjection'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_getUseIdentityProjection" getUseIdentityProjection'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_setUseIdentityView" setUseIdentityView'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_getUseIdentityView" getUseIdentityView'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_getSection" getSection'_ :: ((HG3DClassPtr) -> (CUInt -> ((HG3DClassPtr) -> (IO ())))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_getNumSections" getNumSections'_ :: ((HG3DClassPtr) -> ((Ptr CUInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_setKeepDeclarationOrder" setKeepDeclarationOrder'_ :: ((HG3DClassPtr) -> (CInt -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_getKeepDeclarationOrder" getKeepDeclarationOrder'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_getMovableType" getMovableType'_ :: ((HG3DClassPtr) -> ((Ptr CChar) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_getBoundingRadius" getBoundingRadius'_ :: ((HG3DClassPtr) -> ((Ptr CFloat) -> (IO ()))) foreign import ccall safe "HGamer3D\\Bindings\\Ogre\\ClassManualObject.chs.h ogre_mno_hasEdgeList" hasEdgeList'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ())))