-- 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\\Bullet\\ClassDynamicsWorld.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.
-- 


-- ClassDynamicsWorld.chs

-- 

module HGamer3D.Bindings.Bullet.ClassDynamicsWorld 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.Bullet.Utils
{-# LINE 40 ".\\HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs" #-}
import HGamer3D.Bindings.Bullet.ClassPtr
{-# LINE 41 ".\\HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs" #-}
import HGamer3D.Bindings.Bullet.StructHG3DClass
{-# LINE 42 ".\\HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs" #-}
import HGamer3D.Bindings.Bullet.StructVec3
{-# LINE 43 ".\\HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs" #-}

{- function ~btDynamicsWorld -}
delete :: HG3DClass -> IO ()
delete a1 =
  withHG3DClass a1 $ \a1' -> 
  delete'_ a1' >>= \res ->
  return ()
{-# LINE 48 ".\\HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs" #-}

{- function stepSimulation -}
stepSimulation :: HG3DClass -> Float -> Int -> Float -> IO (Int)
stepSimulation a1 a2 a3 a4 =
  withHG3DClass a1 $ \a1' -> 
  let {a2' = realToFrac a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = realToFrac a4} in 
  alloca $ \a5' -> 
  stepSimulation'_ a1' a2' a3' a4' a5' >>= \res ->
  peekIntConv  a5'>>= \a5'' -> 
  return (a5'')
{-# LINE 56 ".\\HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs" #-}

{- function debugDrawWorld -}
debugDrawWorld :: HG3DClass -> IO ()
debugDrawWorld a1 =
  withHG3DClass a1 $ \a1' -> 
  debugDrawWorld'_ a1' >>= \res ->
  return ()
{-# LINE 60 ".\\HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs" #-}

{- function addAction -}
addAction :: HG3DClass -> HG3DClass -> IO ()
addAction a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  withHG3DClass a2 $ \a2' -> 
  addAction'_ a1' a2' >>= \res ->
  return ()
{-# LINE 65 ".\\HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs" #-}

{- function removeAction -}
removeAction :: HG3DClass -> HG3DClass -> IO ()
removeAction a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  withHG3DClass a2 $ \a2' -> 
  removeAction'_ a1' a2' >>= \res ->
  return ()
{-# LINE 70 ".\\HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs" #-}

{- function setGravity -}
setGravity :: HG3DClass -> Vec3 -> IO ()
setGravity a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  withVec3 a2 $ \a2' -> 
  setGravity'_ a1' a2' >>= \res ->
  return ()
{-# LINE 75 ".\\HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs" #-}

{- function getGravity -}
getGravity :: HG3DClass -> IO (Vec3)
getGravity a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  getGravity'_ a1' a2' >>= \res ->
  peekVec3  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 80 ".\\HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs" #-}

{- function synchronizeMotionStates -}
synchronizeMotionStates :: HG3DClass -> IO ()
synchronizeMotionStates a1 =
  withHG3DClass a1 $ \a1' -> 
  synchronizeMotionStates'_ a1' >>= \res ->
  return ()
{-# LINE 84 ".\\HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs" #-}

{- function addRigidBody -}
addRigidBody :: HG3DClass -> HG3DClass -> IO ()
addRigidBody a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  withHG3DClass a2 $ \a2' -> 
  addRigidBody'_ a1' a2' >>= \res ->
  return ()
{-# LINE 89 ".\\HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs" #-}

{- function removeRigidBody -}
removeRigidBody :: HG3DClass -> HG3DClass -> IO ()
removeRigidBody a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  withHG3DClass a2 $ \a2' -> 
  removeRigidBody'_ a1' a2' >>= \res ->
  return ()
{-# LINE 94 ".\\HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs" #-}

{- function getNumConstraints -}
getNumConstraints :: HG3DClass -> IO (Int)
getNumConstraints a1 =
  withHG3DClass a1 $ \a1' -> 
  alloca $ \a2' -> 
  getNumConstraints'_ a1' a2' >>= \res ->
  peekIntConv  a2'>>= \a2'' -> 
  return (a2'')
{-# LINE 99 ".\\HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs" #-}

{- function clearForces -}
clearForces :: HG3DClass -> IO ()
clearForces a1 =
  withHG3DClass a1 $ \a1' -> 
  clearForces'_ a1' >>= \res ->
  return ()
{-# LINE 103 ".\\HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs" #-}

{- function addVehicle -}
addVehicle :: HG3DClass -> HG3DClass -> IO ()
addVehicle a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  withHG3DClass a2 $ \a2' -> 
  addVehicle'_ a1' a2' >>= \res ->
  return ()
{-# LINE 108 ".\\HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs" #-}

{- function removeVehicle -}
removeVehicle :: HG3DClass -> HG3DClass -> IO ()
removeVehicle a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  withHG3DClass a2 $ \a2' -> 
  removeVehicle'_ a1' a2' >>= \res ->
  return ()
{-# LINE 113 ".\\HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs" #-}

{- function addCharacter -}
addCharacter :: HG3DClass -> HG3DClass -> IO ()
addCharacter a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  withHG3DClass a2 $ \a2' -> 
  addCharacter'_ a1' a2' >>= \res ->
  return ()
{-# LINE 118 ".\\HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs" #-}

{- function removeCharacter -}
removeCharacter :: HG3DClass -> HG3DClass -> IO ()
removeCharacter a1 a2 =
  withHG3DClass a1 $ \a1' -> 
  withHG3DClass a2 $ \a2' -> 
  removeCharacter'_ a1' a2' >>= \res ->
  return ()
{-# LINE 123 ".\\HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs" #-}


foreign import ccall safe "HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs.h bt_dnmcwrld_destruct"
  delete'_ :: ((HG3DClassPtr) -> (IO ()))

foreign import ccall safe "HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs.h bt_dnmcwrld_stepSimulation"
  stepSimulation'_ :: ((HG3DClassPtr) -> (CFloat -> (CInt -> (CFloat -> ((Ptr CInt) -> (IO ()))))))

foreign import ccall safe "HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs.h bt_dnmcwrld_debugDrawWorld"
  debugDrawWorld'_ :: ((HG3DClassPtr) -> (IO ()))

foreign import ccall safe "HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs.h bt_dnmcwrld_addAction"
  addAction'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs.h bt_dnmcwrld_removeAction"
  removeAction'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs.h bt_dnmcwrld_setGravity"
  setGravity'_ :: ((HG3DClassPtr) -> ((Vec3Ptr) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs.h bt_dnmcwrld_getGravity"
  getGravity'_ :: ((HG3DClassPtr) -> ((Vec3Ptr) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs.h bt_dnmcwrld_synchronizeMotionStates"
  synchronizeMotionStates'_ :: ((HG3DClassPtr) -> (IO ()))

foreign import ccall safe "HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs.h bt_dnmcwrld_addRigidBody"
  addRigidBody'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs.h bt_dnmcwrld_removeRigidBody"
  removeRigidBody'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs.h bt_dnmcwrld_getNumConstraints"
  getNumConstraints'_ :: ((HG3DClassPtr) -> ((Ptr CInt) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs.h bt_dnmcwrld_clearForces"
  clearForces'_ :: ((HG3DClassPtr) -> (IO ()))

foreign import ccall safe "HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs.h bt_dnmcwrld_addVehicle"
  addVehicle'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs.h bt_dnmcwrld_removeVehicle"
  removeVehicle'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs.h bt_dnmcwrld_addCharacter"
  addCharacter'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ())))

foreign import ccall safe "HGamer3D\\Bindings\\Bullet\\ClassDynamicsWorld.chs.h bt_dnmcwrld_removeCharacter"
  removeCharacter'_ :: ((HG3DClassPtr) -> ((HG3DClassPtr) -> (IO ())))