HODE (empty) → 2008.10.27
raw patch · 25 files changed
+2129/−0 lines, 25 filesdep +arraydep +basesetup-changed
Dependencies added: array, base
Files
- HODE.cabal +45/−0
- LICENSE +35/−0
- Setup.hs +2/−0
- generateBinding.sh +26/−0
- src/Physics/ODE.hs +82/−0
- src/Physics/ODE/Body.hs +261/−0
- src/Physics/ODE/Body.th +157/−0
- src/Physics/ODE/Collision.hs +43/−0
- src/Physics/ODE/Geom.hs +149/−0
- src/Physics/ODE/Geom.th +96/−0
- src/Physics/ODE/Hsc.hsc +207/−0
- src/Physics/ODE/Joint.hs +170/−0
- src/Physics/ODE/Joint.th +104/−0
- src/Physics/ODE/Mass.hs +50/−0
- src/Physics/ODE/Mass.th +65/−0
- src/Physics/ODE/Objects.hs +113/−0
- src/Physics/ODE/Objects.th +61/−0
- src/Physics/ODE/Overloading.hs +30/−0
- src/Physics/ODE/Rotation.hs +38/−0
- src/Physics/ODE/Space.hs +100/−0
- src/Physics/ODE/Space.th +57/−0
- src/Physics/ODE/Types.hsc +109/−0
- src/Physics/ODE/Utilities.hs +32/−0
- src/Physics/ODE/World.hs +56/−0
- src/Physics/ODE/World.th +41/−0
+ HODE.cabal view
@@ -0,0 +1,45 @@+Name: HODE+Version: 2008.10.27+Maintainer: Lemmih (lemmih@gmail.com)+Author: Lemmih (lemmih@gmail.com)+Copyright: 2005-2008, Lemmih+License-File: LICENSE+License: BSD3+Build-Type: Simple+Build-Depends: base, array+Category: Game, Physics+Synopsis: Binding to libODE+Description: ODE is an open source, high performance library for simulating rigid body dynamics.+ It has advanced joint types and integrated collision detection with friction.+ ODE is useful for simulating vehicles, objects in virtual reality environments+ and virtual creatures. It is currently used in many computer games, 3D authoring+ tools and simulation tools. See http://www.ode.org/+Extensions: CPP, ForeignFunctionInterface, EmptyDataDecls+Exposed-Modules:+ Physics.ODE.Types,+ Physics.ODE.Mass,+ Physics.ODE.World,+ Physics.ODE.Body,+ Physics.ODE.Joint,+ Physics.ODE.Geom,+ Physics.ODE.Space,+ Physics.ODE.Objects,+ Physics.ODE.Collision,+ Physics.ODE.Rotation,+ Physics.ODE.Overloading,+ Physics.ODE+Other-modules:+ Physics.ODE.Utilities,+ Physics.ODE.Hsc+Includes: ode/ode.h+Extra-libraries: ode+Hs-Source-Dirs: src+GHC-Options: -fwarn-duplicate-exports -fwarn-incomplete-patterns -fwarn-missing-signatures -fwarn-unused-binds -fwarn-unused-imports+Extra-Source-Files: generateBinding.sh,+ src/Physics/ODE/Body.th,+ src/Physics/ODE/Geom.th,+ src/Physics/ODE/Joint.th,+ src/Physics/ODE/Mass.th,+ src/Physics/ODE/Objects.th,+ src/Physics/ODE/Space.th,+ src/Physics/ODE/World.th
+ LICENSE view
@@ -0,0 +1,35 @@+Copyright (c) 2004-2008, David Himmelstrup+All rights reserved.++Redistribution and use in source and binary forms,+with or without modification, are permitted provided+that the following conditions are met:++ * Redistributions of source code must retain+ the above copyright notice, this list of+ conditions and the following disclaimer.+ * Redistributions in binary form must reproduce+ the above copyright notice, this list of+ conditions and the following disclaimer in the+ documentation and/or other materials provided+ with the distribution.+ * Neither the name of David Himmelstrup nor the+ names of other contributors may be used to+ endorse or promote products derived from this+ software without specific prior written permission.+++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND+CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES+OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER+OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,+BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE+USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY+OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ generateBinding.sh view
@@ -0,0 +1,26 @@+#!/usr/bin/env sh++BASE_DIR=src/Physics/ODE+GHC_FLAGS="-lode -fglasgow-exts -ignore-package HODE -cpp -isrc"++# The order of these matters+MODULES="Mass World Body Geom Joint Objects Space"+HSCFILES="Types.hsc Hsc.hsc"+++ZEROTH=zeroth+++for hsc in $HSCFILES; do+ hsc2hs $BASE_DIR/$hsc+done++for module in $MODULES; do+ hsFile=$BASE_DIR/$module.hs+ thFile=$BASE_DIR/$module.th+ if test ! -e $hsFile || test $hsFile -ot $thFile+ then+ echo Preprocessing: $thFile+ $ZEROTH --input=$thFile --output=$hsFile "--ghc-args=$GHC_FLAGS"+ fi+done
+ src/Physics/ODE.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE TypeSynonymInstances #-}+module Physics.ODE+ ( module Physics.ODE.Overloading+ , module Physics.ODE.Types + ) where++import Physics.ODE.Overloading+import Physics.ODE.Types ( World, Space, Body, Geom, Joint, JointGroup, Mass+ , ContactGeom (..), ContactInfo (..), Surface (..)+ , JointType (..), BodyIndex (..), GeomClass (..)+ , ODEreal )+import Physics.ODE.World as World+import Physics.ODE.Body as Body+import Physics.ODE.Geom as Geom+import Physics.ODE.Joint as Joint+import Physics.ODE.Space as Space+import Physics.ODE.Mass as Mass++instance HasDestroy World where+ destroy = World.destroyWorld+instance HasDestroy Geom where+ destroy = Geom.destroyGeom+instance HasDestroy Space where+ destroy = Space.destroySpace+instance HasDestroy Body where+ destroy = Body.destroyBody+instance HasDestroy Joint where+ destroy = Joint.destroyJoint+instance HasDestroy JointGroup where+ destroy = Joint.destroyGroup+instance HasDestroy Mass where+ destroy = Mass.destroyMass++instance IsPlaceable Body where+ getPosition = Body.getBodyPosition+ setPosition = Body.setBodyPosition+ getQuaternion = Body.getBodyQuaternion+ setQuaternion = Body.setBodyQuaternion+ getRotation = Body.getBodyRotation+ setRotation = Body.setBodyRotation+instance IsPlaceable Geom where+ getPosition = Geom.getGeomPosition+ setPosition = Geom.setGeomPosition+ getQuaternion = Geom.getGeomQuaternion+ setQuaternion = Geom.setGeomQuaternion+ getRotation = Geom.getGeomRotation+ setRotation = Geom.setGeomRotation++instance HasData Body where+ setRawData = Body.setRawBodyData+ setData = Body.setBodyData+ setSafeData = Body.setSafeBodyData+ getRawData = Body.getRawBodyData+ getData = Body.getBodyData+ getSafeData = Body.getSafeBodyData+ tryGetSafeData = Body.tryGetSafeBodyData+instance HasData Geom where+ setRawData = Geom.setRawGeomData+ setData = Geom.setGeomData+ setSafeData = Geom.setSafeGeomData+ getRawData = Geom.getRawGeomData+ getData = Geom.getGeomData+ getSafeData = Geom.getSafeGeomData+ tryGetSafeData = Geom.tryGetSafeGeomData+instance HasData Joint where+ setRawData = Joint.setRawJointData+ setData = Joint.setJointData+ setSafeData = Joint.setSafeJointData+ getRawData = Joint.getRawJointData+ getData = Joint.getJointData+ getSafeData = Joint.getSafeJointData+ tryGetSafeData = Joint.tryGetSafeJointData++instance HasEnable Body where+ enable = Body.enableBody+ disable = Body.disableBody+ isEnabled =Body.isBodyEnabled+instance HasEnable Geom where+ enable = Geom.enableGeom+ disable = Geom.disableGeom+ isEnabled = Geom.isGeomEnabled+
+ src/Physics/ODE/Body.hs view
@@ -0,0 +1,261 @@+module Physics.ODE.Body+ (create, destroyBody, setBodyPosition, getBodyPosition,+ setBodyQuaternion, getBodyQuaternion, setBodyRotation,+ getBodyRotation, setLinearVel, getLinearVel, setAngularVel,+ getAngularVel, setMass, getMass, addForce, setForce, getForce,+ addTorque, setTorque, getTorque, enableBody, disableBody,+ isBodyEnabled, setRawBodyData, setBodyData, setSafeBodyData,+ getRawBodyData, getBodyData, tryGetSafeBodyData, getSafeBodyData,+ setFiniteRotationMode, getFiniteRotationMode, getNumJoints,+ getJoint, setGravityMode, getGravityMode)+ where+import Foreign+import Data.Typeable+import Data.Maybe+import qualified Physics.ODE.Mass as Mass (create)+import Physics.ODE.Types+import Physics.ODE.Utilities+ +foreign import ccall unsafe "dBodyGetMass" cGetMass ::+ Ptr BodyStruct -> Ptr MassStruct -> IO ()+ +getMass :: Body -> IO Mass+getMass body+ = Mass.create >>=+ \ mass ->+ withForeignPtr mass $ \ cMass -> cGetMass body cMass >> return mass+ +foreign import ccall unsafe "dBodySetData" setRawBodyData ::+ Ptr BodyStruct -> Ptr a -> IO ()+ +setBodyData :: Body -> a -> IO ()+setBodyData body d+ = newStablePtr d >>=+ \ stablePtr -> setRawBodyData body (castStablePtrToPtr stablePtr)+ +setSafeBodyData :: (Typeable a) => Body -> a -> IO ()+setSafeBodyData body d = setBodyData body (typeOf d, d)+ +foreign import ccall unsafe "dBodyGetData" getRawBodyData ::+ Ptr BodyStruct -> IO (Ptr a)+ +getBodyData :: Body -> IO a+getBodyData body+ = getRawBodyData body >>= deRefStablePtr . castPtrToStablePtr+ +tryGetSafeBodyData :: (Typeable a) => Body -> IO (Maybe a)+tryGetSafeBodyData body+ = getBodyData body >>=+ \ (t, d) ->+ if t == typeOf d then return (Just d) else return Nothing+ +getSafeBodyData :: (Typeable a) => Body -> IO a+getSafeBodyData+ = fmap (fromMaybe (error errMsg)) . tryGetSafeBodyData+ where errMsg = "Physics.ODE.Body.getSafeBodyData: invalid type."+ +setFiniteRotationMode :: Body -> RotationMode -> IO ()+setFiniteRotationMode body (Infinitesimal)+ = setFiniteRotationMode_ body 0+setFiniteRotationMode body (Finite x y z)+ = do setFiniteRotationMode_ body 1+ setFiniteRotationAxis_ body x y z+ +getFiniteRotationMode :: Body -> IO RotationMode+getFiniteRotationMode body+ = do n <- getFiniteRotationMode_ body+ if n == 0 then return Infinitesimal else+ do (x, y, z) <- getFiniteRotationAxis_ body+ return $ Finite x y z+create :: World -> IO Body+create = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- createdBodyCreate marshaledArg_2+ return (ret_3))+foreign import ccall unsafe "dBodyCreate" createdBodyCreate :: World ->+ IO Body+destroyBody :: Body -> IO ()+destroyBody = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- destroyBodydBodyDestroy marshaledArg_2+ case () of+ () -> do return ())+foreign import ccall unsafe "dBodyDestroy" destroyBodydBodyDestroy :: Body ->+ IO ()+setBodyPosition :: Body -> ODEreal -> ODEreal -> ODEreal -> IO ()+setBodyPosition = \arg_0 arg_1 arg_2 arg_3 -> (\action_4 -> action_4 arg_0) (\marshaledArg_5 -> (\action_6 -> action_6 arg_1) (\marshaledArg_7 -> (\action_8 -> action_8 arg_2) (\marshaledArg_9 -> (\action_10 -> action_10 arg_3) (\marshaledArg_11 -> do ret_12 <- setBodyPositiondBodySetPosition marshaledArg_5 marshaledArg_7 marshaledArg_9 marshaledArg_11+ case () of+ () -> do return ()))))+foreign import ccall unsafe "dBodySetPosition" setBodyPositiondBodySetPosition :: Body ->+ ODEreal ->+ ODEreal ->+ ODEreal -> IO ()+getBodyPosition :: Body -> IO ((ODEreal, ODEreal, ODEreal))+getBodyPosition = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- getBodyPositiondBodyGetPosition marshaledArg_2+ peekVector3 (ret_3))+foreign import ccall unsafe "dBodyGetPosition" getBodyPositiondBodyGetPosition :: Body ->+ IO (Ptr ODEreal)+setBodyQuaternion :: Body ->+ (ODEreal, ODEreal, ODEreal, ODEreal) -> IO ()+setBodyQuaternion = \arg_0 arg_1 -> (\action_2 -> action_2 arg_0) (\marshaledArg_3 -> (\action_4 -> allocaArray 4 (\ptr_5 -> (>>) (pokeArray ptr_5 (case arg_1 of+ (a_6,+ b_7,+ c_8,+ d_9) -> [a_6,+ b_7,+ c_8,+ d_9])) (action_4 ptr_5))) (\marshaledArg_10 -> do ret_11 <- setBodyQuaterniondBodySetQuaternion marshaledArg_3 marshaledArg_10+ case () of+ () -> do return ()))+foreign import ccall unsafe "dBodySetQuaternion" setBodyQuaterniondBodySetQuaternion :: Body ->+ Ptr ODEreal ->+ IO ()+getBodyQuaternion :: Body ->+ IO ((ODEreal, ODEreal, ODEreal, ODEreal))+getBodyQuaternion = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- getBodyQuaterniondBodyGetQuaternion marshaledArg_2+ peekVector4 (ret_3))+foreign import ccall unsafe "dBodyGetQuaternion" getBodyQuaterniondBodyGetQuaternion :: Body ->+ IO (Ptr ODEreal)+setBodyRotation :: Body -> Matrix3 -> IO ()+setBodyRotation = \arg_0 arg_1 -> (\action_2 -> action_2 arg_0) (\marshaledArg_3 -> (\action_4 -> action_4 arg_1) (\marshaledArg_5 -> do ret_6 <- setBodyRotationdBodySetRotation marshaledArg_3 marshaledArg_5+ case () of+ () -> do return ()))+foreign import ccall unsafe "dBodySetRotation" setBodyRotationdBodySetRotation :: Body ->+ Matrix3 -> IO ()+getBodyRotation :: Body -> IO Matrix3+getBodyRotation = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- getBodyRotationdBodyGetRotation marshaledArg_2+ return (ret_3))+foreign import ccall unsafe "dBodyGetRotation" getBodyRotationdBodyGetRotation :: Body ->+ IO Matrix3+setLinearVel :: Body -> ODEreal -> ODEreal -> ODEreal -> IO ()+setLinearVel = \arg_0 arg_1 arg_2 arg_3 -> (\action_4 -> action_4 arg_0) (\marshaledArg_5 -> (\action_6 -> action_6 arg_1) (\marshaledArg_7 -> (\action_8 -> action_8 arg_2) (\marshaledArg_9 -> (\action_10 -> action_10 arg_3) (\marshaledArg_11 -> do ret_12 <- setLinearVeldBodySetLinearVel marshaledArg_5 marshaledArg_7 marshaledArg_9 marshaledArg_11+ case () of+ () -> do return ()))))+foreign import ccall unsafe "dBodySetLinearVel" setLinearVeldBodySetLinearVel :: Body ->+ ODEreal ->+ ODEreal ->+ ODEreal -> IO ()+getLinearVel :: Body -> IO ((ODEreal, ODEreal, ODEreal))+getLinearVel = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- getLinearVeldBodyGetLinearVel marshaledArg_2+ peekVector3 (ret_3))+foreign import ccall unsafe "dBodyGetLinearVel" getLinearVeldBodyGetLinearVel :: Body ->+ IO (Ptr ODEreal)+setAngularVel :: Body -> ODEreal -> ODEreal -> ODEreal -> IO ()+setAngularVel = \arg_0 arg_1 arg_2 arg_3 -> (\action_4 -> action_4 arg_0) (\marshaledArg_5 -> (\action_6 -> action_6 arg_1) (\marshaledArg_7 -> (\action_8 -> action_8 arg_2) (\marshaledArg_9 -> (\action_10 -> action_10 arg_3) (\marshaledArg_11 -> do ret_12 <- setAngularVeldBodySetAngularVel marshaledArg_5 marshaledArg_7 marshaledArg_9 marshaledArg_11+ case () of+ () -> do return ()))))+foreign import ccall unsafe "dBodySetAngularVel" setAngularVeldBodySetAngularVel :: Body ->+ ODEreal ->+ ODEreal ->+ ODEreal -> IO ()+getAngularVel :: Body -> IO ((ODEreal, ODEreal, ODEreal))+getAngularVel = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- getAngularVeldBodyGetAngularVel marshaledArg_2+ peekVector3 (ret_3))+foreign import ccall unsafe "dBodyGetAngularVel" getAngularVeldBodyGetAngularVel :: Body ->+ IO (Ptr ODEreal)+setMass :: Body -> Mass -> IO ()+setMass = \arg_0 arg_1 -> (\action_2 -> action_2 arg_0) (\marshaledArg_3 -> withForeignPtr arg_1 (\marshaledArg_4 -> do ret_5 <- setMassdBodySetMass marshaledArg_3 marshaledArg_4+ case () of+ () -> do return ()))+foreign import ccall unsafe "dBodySetMass" setMassdBodySetMass :: Body ->+ Ptr MassStruct -> IO ()+addForce :: Body -> ODEreal -> ODEreal -> ODEreal -> IO ()+addForce = \arg_0 arg_1 arg_2 arg_3 -> (\action_4 -> action_4 arg_0) (\marshaledArg_5 -> (\action_6 -> action_6 arg_1) (\marshaledArg_7 -> (\action_8 -> action_8 arg_2) (\marshaledArg_9 -> (\action_10 -> action_10 arg_3) (\marshaledArg_11 -> do ret_12 <- addForcedBodyAddForce marshaledArg_5 marshaledArg_7 marshaledArg_9 marshaledArg_11+ case () of+ () -> do return ()))))+foreign import ccall unsafe "dBodyAddForce" addForcedBodyAddForce :: Body ->+ ODEreal ->+ ODEreal -> ODEreal -> IO ()+setForce :: Body -> ODEreal -> ODEreal -> ODEreal -> IO ()+setForce = \arg_0 arg_1 arg_2 arg_3 -> (\action_4 -> action_4 arg_0) (\marshaledArg_5 -> (\action_6 -> action_6 arg_1) (\marshaledArg_7 -> (\action_8 -> action_8 arg_2) (\marshaledArg_9 -> (\action_10 -> action_10 arg_3) (\marshaledArg_11 -> do ret_12 <- setForcedBodySetForce marshaledArg_5 marshaledArg_7 marshaledArg_9 marshaledArg_11+ case () of+ () -> do return ()))))+foreign import ccall unsafe "dBodySetForce" setForcedBodySetForce :: Body ->+ ODEreal ->+ ODEreal -> ODEreal -> IO ()+getForce :: Body -> IO ((ODEreal, ODEreal, ODEreal))+getForce = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- getForcedBodyGetForce marshaledArg_2+ peekVector3 (ret_3))+foreign import ccall unsafe "dBodyGetForce" getForcedBodyGetForce :: Body ->+ IO (Ptr ODEreal)+addTorque :: Body -> ODEreal -> ODEreal -> ODEreal -> IO ()+addTorque = \arg_0 arg_1 arg_2 arg_3 -> (\action_4 -> action_4 arg_0) (\marshaledArg_5 -> (\action_6 -> action_6 arg_1) (\marshaledArg_7 -> (\action_8 -> action_8 arg_2) (\marshaledArg_9 -> (\action_10 -> action_10 arg_3) (\marshaledArg_11 -> do ret_12 <- addTorquedBodyAddTorque marshaledArg_5 marshaledArg_7 marshaledArg_9 marshaledArg_11+ case () of+ () -> do return ()))))+foreign import ccall unsafe "dBodyAddTorque" addTorquedBodyAddTorque :: Body ->+ ODEreal ->+ ODEreal -> ODEreal -> IO ()+setTorque :: Body -> ODEreal -> ODEreal -> ODEreal -> IO ()+setTorque = \arg_0 arg_1 arg_2 arg_3 -> (\action_4 -> action_4 arg_0) (\marshaledArg_5 -> (\action_6 -> action_6 arg_1) (\marshaledArg_7 -> (\action_8 -> action_8 arg_2) (\marshaledArg_9 -> (\action_10 -> action_10 arg_3) (\marshaledArg_11 -> do ret_12 <- setTorquedBodySetTorque marshaledArg_5 marshaledArg_7 marshaledArg_9 marshaledArg_11+ case () of+ () -> do return ()))))+foreign import ccall unsafe "dBodySetTorque" setTorquedBodySetTorque :: Body ->+ ODEreal ->+ ODEreal -> ODEreal -> IO ()+getTorque :: Body -> IO ((ODEreal, ODEreal, ODEreal))+getTorque = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- getTorquedBodyGetTorque marshaledArg_2+ peekVector3 (ret_3))+foreign import ccall unsafe "dBodyGetTorque" getTorquedBodyGetTorque :: Body ->+ IO (Ptr ODEreal)+enableBody :: Body -> IO ()+enableBody = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- enableBodydBodyEnable marshaledArg_2+ case () of+ () -> do return ())+foreign import ccall unsafe "dBodyEnable" enableBodydBodyEnable :: Body ->+ IO ()+disableBody :: Body -> IO ()+disableBody = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- disableBodydBodyDisable marshaledArg_2+ case () of+ () -> do return ())+foreign import ccall unsafe "dBodyDisable" disableBodydBodyDisable :: Body ->+ IO ()+isBodyEnabled :: Body -> IO Bool+isBodyEnabled = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- isBodyEnableddBodyIsEnabled marshaledArg_2+ return (toBool (ret_3)))+foreign import ccall unsafe "dBodyIsEnabled" isBodyEnableddBodyIsEnabled :: Body ->+ IO Int+setFiniteRotationMode_ :: Body -> Int -> IO ()+setFiniteRotationMode_ = \arg_0 arg_1 -> (\action_2 -> action_2 arg_0) (\marshaledArg_3 -> (\action_4 -> action_4 arg_1) (\marshaledArg_5 -> do ret_6 <- setFiniteRotationMode_dBodySetFiniteRotationMode marshaledArg_3 marshaledArg_5+ case () of+ () -> do return ()))+foreign import ccall unsafe "dBodySetFiniteRotationMode" setFiniteRotationMode_dBodySetFiniteRotationMode :: Body ->+ Int ->+ IO ()+getFiniteRotationMode_ :: Body -> IO Int+getFiniteRotationMode_ = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- getFiniteRotationMode_dBodyGetFiniteRotationMode marshaledArg_2+ return (ret_3))+foreign import ccall unsafe "dBodyGetFiniteRotationMode" getFiniteRotationMode_dBodyGetFiniteRotationMode :: Body ->+ IO Int+setFiniteRotationAxis_ :: Body ->+ ODEreal -> ODEreal -> ODEreal -> IO ()+setFiniteRotationAxis_ = \arg_0 arg_1 arg_2 arg_3 -> (\action_4 -> action_4 arg_0) (\marshaledArg_5 -> (\action_6 -> action_6 arg_1) (\marshaledArg_7 -> (\action_8 -> action_8 arg_2) (\marshaledArg_9 -> (\action_10 -> action_10 arg_3) (\marshaledArg_11 -> do ret_12 <- setFiniteRotationAxis_dBodySetFiniteRotationAxis marshaledArg_5 marshaledArg_7 marshaledArg_9 marshaledArg_11+ case () of+ () -> do return ()))))+foreign import ccall unsafe "dBodySetFiniteRotationAxis" setFiniteRotationAxis_dBodySetFiniteRotationAxis :: Body ->+ ODEreal ->+ ODEreal ->+ ODEreal ->+ IO ()+getFiniteRotationAxis_ :: Body -> IO ((ODEreal, ODEreal, ODEreal))+getFiniteRotationAxis_ = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> allocaArray 4 (\marshaledArg_3 -> do ret_4 <- getFiniteRotationAxis_dBodyGetFiniteRotationAxis marshaledArg_2 marshaledArg_3+ peekVector3 (marshaledArg_3)))+foreign import ccall unsafe "dBodyGetFiniteRotationAxis" getFiniteRotationAxis_dBodyGetFiniteRotationAxis :: Body ->+ Ptr ODEreal ->+ IO ()+getNumJoints :: Body -> IO Int+getNumJoints = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- getNumJointsdBodyGetNumJoints marshaledArg_2+ return (ret_3))+foreign import ccall unsafe "dBodyGetNumJoints" getNumJointsdBodyGetNumJoints :: Body ->+ IO Int+getJoint :: Body -> Int -> IO Joint+getJoint = \arg_0 arg_1 -> (\action_2 -> action_2 arg_0) (\marshaledArg_3 -> (\action_4 -> action_4 arg_1) (\marshaledArg_5 -> do ret_6 <- getJointdBodyGetJoint marshaledArg_3 marshaledArg_5+ return (ret_6)))+foreign import ccall unsafe "dBodyGetJoint" getJointdBodyGetJoint :: Body ->+ Int -> IO Joint+setGravityMode :: Body -> Bool -> IO ()+setGravityMode = \arg_0 arg_1 -> (\action_2 -> action_2 arg_0) (\marshaledArg_3 -> (\action_4 -> action_4 (fromBool arg_1)) (\marshaledArg_5 -> do ret_6 <- setGravityModedBodySetGravityMode marshaledArg_3 marshaledArg_5+ case () of+ () -> do return ()))+foreign import ccall unsafe "dBodySetGravityMode" setGravityModedBodySetGravityMode :: Body ->+ Int -> IO ()+getGravityMode :: Body -> IO Bool+getGravityMode = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- getGravityModedBodyGetGravityMode marshaledArg_2+ return (toBool (ret_3)))+foreign import ccall unsafe "dBodyGetGravityMode" getGravityModedBodyGetGravityMode :: Body ->+ IO Int
+ src/Physics/ODE/Body.th view
@@ -0,0 +1,157 @@+module Physics.ODE.Body+ ( create+ , destroyBody+ , setBodyPosition+ , getBodyPosition+ , setBodyQuaternion+ , getBodyQuaternion+ , setBodyRotation+ , getBodyRotation+ , setLinearVel+ , getLinearVel+ , setAngularVel+ , getAngularVel+ , setMass+ , getMass+ , addForce+ , setForce+ , getForce+ , addTorque+ , setTorque+ , getTorque+ , enableBody+ , disableBody+ , isBodyEnabled+ , setRawBodyData+ , setBodyData+ , setSafeBodyData+ , getRawBodyData+ , getBodyData+ , tryGetSafeBodyData+ , getSafeBodyData+ , setFiniteRotationMode+ , getFiniteRotationMode+ , getNumJoints+ , getJoint+ , setGravityMode+ , getGravityMode+ ) where+++import Foreign+import Data.Typeable+import Data.Maybe++import qualified Physics.ODE.Mass as Mass ( create )+import Physics.ODE.Types+import Physics.ODE.Utilities++#ifdef HASTH+import Foreign.HacanonLight.DIS+import Foreign.HacanonLight.Generate+import Physics.ODE.DIS+#endif++$(bind "create" "dBodyCreate" [world,body])++$(bind "destroyBody" "dBodyDestroy" [body,unit])++$(bind "setBodyPosition" "dBodySetPosition" [body,ode,ode,ode,unit])++$(bind "getBodyPosition" "dBodyGetPosition" [body,vector3Out])++$(bind "setBodyQuaternion" "dBodySetQuaternion" [body,vector4,unit])++$(bind "getBodyQuaternion" "dBodyGetQuaternion" [body,vector4Out])++$(bind "setBodyRotation" "dBodySetRotation" [body,matrix3,unit])++$(bind "getBodyRotation" "dBodyGetRotation" [body,matrix3])++$(bind "setLinearVel" "dBodySetLinearVel" [body,ode,ode,ode,unit])++$(bind "getLinearVel" "dBodyGetLinearVel" [body,vector3Out])++$(bind "setAngularVel" "dBodySetAngularVel" [body,ode,ode,ode,unit])++$(bind "getAngularVel" "dBodyGetAngularVel" [body,vector3Out])++$(bind "setMass" "dBodySetMass" [body,mass,unit])+++foreign import ccall unsafe "dBodyGetMass" cGetMass :: Ptr BodyStruct -> Ptr MassStruct -> IO ()+getMass :: Body -> IO Mass+getMass body+ = Mass.create >>= \mass ->+ withForeignPtr mass $ \cMass ->+ cGetMass body cMass >> return mass++$(bind "addForce" "dBodyAddForce" [body,ode,ode,ode,unit])++$(bind "setForce" "dBodySetForce" [body,ode,ode,ode,unit])++$(bind "getForce" "dBodyGetForce" [body,vector3Out])++$(bind "addTorque" "dBodyAddTorque" [body,ode,ode,ode,unit])++$(bind "setTorque" "dBodySetTorque" [body,ode,ode,ode,unit])++$(bind "getTorque" "dBodyGetTorque" [body,vector3Out])++$(bind "enableBody" "dBodyEnable" [body,unit])++$(bind "disableBody" "dBodyDisable" [body,unit])++$(bind "isBodyEnabled" "dBodyIsEnabled" [body,bool])++foreign import ccall unsafe "dBodySetData" setRawBodyData :: Ptr BodyStruct -> Ptr a -> IO ()++setBodyData :: Body -> a -> IO ()+setBodyData body d = newStablePtr d >>= \stablePtr ->+ setRawBodyData body (castStablePtrToPtr stablePtr)++setSafeBodyData :: Typeable a => Body -> a -> IO ()+setSafeBodyData body d = setBodyData body (typeOf d,d)++foreign import ccall unsafe "dBodyGetData" getRawBodyData :: Ptr BodyStruct -> IO (Ptr a)++getBodyData :: Body -> IO a+getBodyData body = getRawBodyData body >>= deRefStablePtr.castPtrToStablePtr++tryGetSafeBodyData :: Typeable a => Body -> IO (Maybe a)+tryGetSafeBodyData body = getBodyData body >>= \(t,d) ->+ if t == typeOf d+ then return (Just d)+ else return Nothing++getSafeBodyData :: Typeable a => Body -> IO a+getSafeBodyData = fmap (fromMaybe (error errMsg)).tryGetSafeBodyData+ where errMsg = "Physics.ODE.Body.getSafeBodyData: invalid type."++$(bind "setFiniteRotationMode_" "dBodySetFiniteRotationMode" [body, int, unit])+$(bind "getFiniteRotationMode_" "dBodyGetFiniteRotationMode" [body, int])++$(bind "setFiniteRotationAxis_" "dBodySetFiniteRotationAxis" [body, ode, ode, ode, unit])+$(bind "getFiniteRotationAxis_" "dBodyGetFiniteRotationAxis" [body, vector3Out, unit])++setFiniteRotationMode :: Body -> RotationMode -> IO ()+setFiniteRotationMode body Infinitesimal = setFiniteRotationMode_ body 0+setFiniteRotationMode body (Finite x y z) = do setFiniteRotationMode_ body 1+ setFiniteRotationAxis_ body x y z++getFiniteRotationMode :: Body -> IO RotationMode+getFiniteRotationMode body+ = do n <- getFiniteRotationMode_ body+ if n == 0+ then return Infinitesimal+ else do (x,y,z) <- getFiniteRotationAxis_ body+ return $ Finite x y z++$(bind "getNumJoints" "dBodyGetNumJoints" [body,int])++$(bind "getJoint" "dBodyGetJoint" [body,int,joint])++$(bind "setGravityMode" "dBodySetGravityMode" [body,bool,unit])++$(bind "getGravityMode" "dBodyGetGravityMode" [body,bool])+
+ src/Physics/ODE/Collision.hs view
@@ -0,0 +1,43 @@+module Physics.ODE.Collision+ ( collide+ , spaceCollide+ ) where++import Foreign++import Physics.ODE.Types+import Physics.ODE.Hsc+-- import Physics.ODE.Utilities++foreign import ccall unsafe "memset" cMemset :: Ptr a -> Int -> Int -> IO (Ptr a)++foreign import ccall unsafe "dCollide" rawCollide+ :: Ptr GeomStruct -> Ptr GeomStruct -> Int -> Ptr ContactGeom -> Int -> IO Int++collide :: Geom -> Geom -> Int -> IO [ContactInfo]+collide geom1 geom2 nElems+ = allocaArray nElems $ \points ->+ do cMemset points 0 (sizeOfContactInfo * nElems)+ ret <- rawCollide geom1 geom2 nElems (addressOfGeom points) sizeOfContactInfo+ peekArray ret points+ where sizeOfContactInfo = sizeOf (undefined :: ContactInfo)++type RawCallback = Ptr () -> Ptr GeomStruct -> Ptr GeomStruct -> IO ()+type Callback = Geom -> Geom -> IO ()++foreign import ccall unsafe "wrapper" mkRawCallback :: RawCallback -> IO (FunPtr RawCallback)+mkCallback :: Callback -> IO (FunPtr RawCallback)+mkCallback cb+ = mkRawCallback rawCb+ where rawCb _data geom1 geom2+ = cb geom1 geom2++foreign import ccall safe "dSpaceCollide" cSpaceCollide+ :: Ptr SpaceStruct -> Ptr () -> FunPtr RawCallback -> IO ()++spaceCollide :: Space -> Callback -> IO ()+spaceCollide space callback+ = mkCallback callback >>= \rawCallback ->+ cSpaceCollide space nullPtr rawCallback >>+ freeHaskellFunPtr rawCallback+
+ src/Physics/ODE/Geom.hs view
@@ -0,0 +1,149 @@+module Physics.ODE.Geom+ (destroyGeom, setRawGeomData, setGeomData, setSafeGeomData,+ getRawGeomData, getGeomData, getSafeGeomData, tryGetSafeGeomData,+ setBody, getBodyUnsafe, getBody, setGeomPosition, getGeomPosition,+ setGeomQuaternion, getGeomQuaternion, setGeomRotation,+ getGeomRotation, isSpace, getSpace, getClass, enableGeom,+ disableGeom, isGeomEnabled)+ where+import Foreign+import Data.Typeable+import Data.Maybe+import Physics.ODE.Types+import Physics.ODE.Utilities+import Physics.ODE.Hsc+ +foreign import ccall unsafe "dGeomSetData" setRawGeomData ::+ Ptr GeomStruct -> Ptr a -> IO ()+ +setGeomData :: Geom -> a -> IO ()+setGeomData body d+ = newStablePtr d >>=+ \ stablePtr -> setRawGeomData body (castStablePtrToPtr stablePtr)+ +setSafeGeomData :: (Typeable a) => Geom -> a -> IO ()+setSafeGeomData body d = setGeomData body (typeOf d, d)+ +foreign import ccall unsafe "dGeomGetData" getRawGeomData ::+ Ptr GeomStruct -> IO (Ptr a)+ +getGeomData :: Geom -> IO a+getGeomData body+ = getRawGeomData body >>= deRefStablePtr . castPtrToStablePtr+ +tryGetSafeGeomData :: (Typeable a) => Geom -> IO (Maybe a)+tryGetSafeGeomData body+ = getGeomData body >>=+ \ (t, d) ->+ if t == typeOf d then return (Just d) else return Nothing+ +getSafeGeomData :: (Typeable a) => Geom -> IO a+getSafeGeomData+ = fmap (fromMaybe (error errMsg)) . tryGetSafeGeomData+ where errMsg = "Physics.ODE.Geom.getSafeGeomData: invalid type."+destroyGeom :: Geom -> IO ()+destroyGeom = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- destroyGeomdGeomDestroy marshaledArg_2+ case () of+ () -> do return ())+foreign import ccall unsafe "dGeomDestroy" destroyGeomdGeomDestroy :: Geom ->+ IO ()+setBody :: Geom -> Maybe Body -> IO ()+setBody = \arg_0 arg_1 -> (\action_2 -> action_2 arg_0) (\marshaledArg_3 -> (case arg_1 of+ Data.Maybe.Just a_4 -> \action_5 -> action_5 a_4+ Data.Maybe.Nothing -> \action_6 -> action_6 nullPtr) (\marshaledArg_7 -> do ret_8 <- setBodydGeomSetBody marshaledArg_3 marshaledArg_7+ case () of+ () -> do return ()))+foreign import ccall unsafe "dGeomSetBody" setBodydGeomSetBody :: Geom ->+ Body -> IO ()+getBodyUnsafe :: Geom -> IO Body+getBodyUnsafe = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- getBodyUnsafedGeomGetBody marshaledArg_2+ return (ret_3))+foreign import ccall unsafe "dGeomGetBody" getBodyUnsafedGeomGetBody :: Geom ->+ IO Body+getBody :: Geom -> IO (Maybe Body)+getBody = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- getBodydGeomGetBody marshaledArg_2+ if (ret_3) == nullPtr+ then return Nothing+ else fmap Just (return (ret_3)))+foreign import ccall unsafe "dGeomGetBody" getBodydGeomGetBody :: Geom ->+ IO Body+setGeomPosition :: Geom -> ODEreal -> ODEreal -> ODEreal -> IO ()+setGeomPosition = \arg_0 arg_1 arg_2 arg_3 -> (\action_4 -> action_4 arg_0) (\marshaledArg_5 -> (\action_6 -> action_6 arg_1) (\marshaledArg_7 -> (\action_8 -> action_8 arg_2) (\marshaledArg_9 -> (\action_10 -> action_10 arg_3) (\marshaledArg_11 -> do ret_12 <- setGeomPositiondGeomSetPosition marshaledArg_5 marshaledArg_7 marshaledArg_9 marshaledArg_11+ case () of+ () -> do return ()))))+foreign import ccall unsafe "dGeomSetPosition" setGeomPositiondGeomSetPosition :: Geom ->+ ODEreal ->+ ODEreal ->+ ODEreal -> IO ()+getGeomPosition :: Geom -> IO ((ODEreal, ODEreal, ODEreal))+getGeomPosition = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- getGeomPositiondGeomGetPosition marshaledArg_2+ peekVector3 (ret_3))+foreign import ccall unsafe "dGeomGetPosition" getGeomPositiondGeomGetPosition :: Geom ->+ IO (Ptr ODEreal)+setGeomQuaternion :: Geom ->+ (ODEreal, ODEreal, ODEreal, ODEreal) -> IO ()+setGeomQuaternion = \arg_0 arg_1 -> (\action_2 -> action_2 arg_0) (\marshaledArg_3 -> (\action_4 -> allocaArray 4 (\ptr_5 -> (>>) (pokeArray ptr_5 (case arg_1 of+ (a_6,+ b_7,+ c_8,+ d_9) -> [a_6,+ b_7,+ c_8,+ d_9])) (action_4 ptr_5))) (\marshaledArg_10 -> do ret_11 <- setGeomQuaterniondGeomSetQuaternion marshaledArg_3 marshaledArg_10+ case () of+ () -> do return ()))+foreign import ccall unsafe "dGeomSetQuaternion" setGeomQuaterniondGeomSetQuaternion :: Geom ->+ Ptr ODEreal ->+ IO ()+getGeomQuaternion :: Geom ->+ IO ((ODEreal, ODEreal, ODEreal, ODEreal))+getGeomQuaternion = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> allocaArray 4 (\marshaledArg_3 -> do ret_4 <- getGeomQuaterniondGeomGetQuaternion marshaledArg_2 marshaledArg_3+ peekVector4 (marshaledArg_3)))+foreign import ccall unsafe "dGeomGetQuaternion" getGeomQuaterniondGeomGetQuaternion :: Geom ->+ Ptr ODEreal ->+ IO ()+setGeomRotation :: Geom -> Matrix3 -> IO ()+setGeomRotation = \arg_0 arg_1 -> (\action_2 -> action_2 arg_0) (\marshaledArg_3 -> (\action_4 -> action_4 arg_1) (\marshaledArg_5 -> do ret_6 <- setGeomRotationdGeomSetRotation marshaledArg_3 marshaledArg_5+ case () of+ () -> do return ()))+foreign import ccall unsafe "dGeomSetRotation" setGeomRotationdGeomSetRotation :: Geom ->+ Matrix3 -> IO ()+getGeomRotation :: Geom -> IO Matrix3+getGeomRotation = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- getGeomRotationdGeomGetRotation marshaledArg_2+ return (ret_3))+foreign import ccall unsafe "dGeomGetRotation" getGeomRotationdGeomGetRotation :: Geom ->+ IO Matrix3+isSpace :: Geom -> IO Bool+isSpace = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- isSpacedGeomIsSpace marshaledArg_2+ return (toBool (ret_3)))+foreign import ccall unsafe "dGeomIsSpace" isSpacedGeomIsSpace :: Geom ->+ IO Int+getSpace :: Geom -> IO (Maybe Space)+getSpace = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- getSpacedGeomGetSpace marshaledArg_2+ if (ret_3) == nullPtr+ then return Nothing+ else fmap Just (return (ret_3)))+foreign import ccall unsafe "dGeomGetSpace" getSpacedGeomGetSpace :: Geom ->+ IO Space+getClass :: Geom -> IO GeomClass+getClass = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- getClassdGeomGetClass marshaledArg_2+ return (toGeomClass (ret_3)))+foreign import ccall unsafe "dGeomGetClass" getClassdGeomGetClass :: Geom ->+ IO Int+enableGeom :: Geom -> IO ()+enableGeom = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- enableGeomdGeomEnable marshaledArg_2+ case () of+ () -> do return ())+foreign import ccall unsafe "dGeomEnable" enableGeomdGeomEnable :: Geom ->+ IO ()+disableGeom :: Geom -> IO ()+disableGeom = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- disableGeomdGeomDisable marshaledArg_2+ case () of+ () -> do return ())+foreign import ccall unsafe "dGeomDisable" disableGeomdGeomDisable :: Geom ->+ IO ()+isGeomEnabled :: Geom -> IO Bool+isGeomEnabled = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- isGeomEnableddGeomIsEnabled marshaledArg_2+ return (toBool (ret_3)))+foreign import ccall unsafe "dGeomIsEnabled" isGeomEnableddGeomIsEnabled :: Geom ->+ IO Int
+ src/Physics/ODE/Geom.th view
@@ -0,0 +1,96 @@+module Physics.ODE.Geom+ ( destroyGeom+ , setRawGeomData+ , setGeomData+ , setSafeGeomData+ , getRawGeomData+ , getGeomData+ , getSafeGeomData+ , tryGetSafeGeomData+ , setBody+ , getBodyUnsafe+ , getBody+ , setGeomPosition+ , getGeomPosition+ , setGeomQuaternion+ , getGeomQuaternion+ , setGeomRotation+ , getGeomRotation+ , isSpace+ , getSpace+ , getClass+ , enableGeom+ , disableGeom+ , isGeomEnabled+ ) where++import Foreign+import Data.Typeable+import Data.Maybe++import Physics.ODE.Types+import Physics.ODE.Utilities+import Physics.ODE.Hsc++#ifdef HASTH+import Foreign.HacanonLight.DIS+import Foreign.HacanonLight.Generate+import Physics.ODE.DIS+#endif++$(bind "destroyGeom" "dGeomDestroy" [geom,unit])++foreign import ccall unsafe "dGeomSetData" setRawGeomData :: Ptr GeomStruct -> Ptr a -> IO ()++setGeomData :: Geom -> a -> IO ()+setGeomData body d = newStablePtr d >>= \stablePtr ->+ setRawGeomData body (castStablePtrToPtr stablePtr)++setSafeGeomData :: Typeable a => Geom -> a -> IO ()+setSafeGeomData body d = setGeomData body (typeOf d,d)++foreign import ccall unsafe "dGeomGetData" getRawGeomData :: Ptr GeomStruct -> IO (Ptr a)++getGeomData :: Geom -> IO a+getGeomData body = getRawGeomData body >>= deRefStablePtr.castPtrToStablePtr++tryGetSafeGeomData :: Typeable a => Geom -> IO (Maybe a)+tryGetSafeGeomData body = getGeomData body >>= \(t,d) ->+ if t == typeOf d+ then return (Just d)+ else return Nothing++getSafeGeomData :: Typeable a => Geom -> IO a+getSafeGeomData = fmap (fromMaybe (error errMsg)).tryGetSafeGeomData+ where errMsg = "Physics.ODE.Geom.getSafeGeomData: invalid type."++$(bind "setBody" "dGeomSetBody" [geom,maybePtr body,unit])++$(bind "getBodyUnsafe" "dGeomGetBody" [geom,body])+$(bind "getBody" "dGeomGetBody" [geom,maybePtr body])++$(bind "setGeomPosition" "dGeomSetPosition" [geom,ode,ode,ode,unit])++$(bind "getGeomPosition" "dGeomGetPosition" [geom,vector3])++$(bind "setGeomQuaternion" "dGeomSetQuaternion" [geom,vector4,unit])++$(bind "getGeomQuaternion" "dGeomGetQuaternion" [geom,vector4Out,unit])++$(bind "setGeomRotation" "dGeomSetRotation" [geom,matrix3,unit])++$(bind "getGeomRotation" "dGeomGetRotation" [geom,matrix3])++$(bind "isSpace" "dGeomIsSpace" [geom,bool])++$(bind "getSpace" "dGeomGetSpace" [geom,maybePtr space])++$(bind "getClass" "dGeomGetClass" [geom,geomClass])++$(bind "enableGeom" "dGeomEnable" [geom,unit])++$(bind "disableGeom" "dGeomDisable" [geom,unit])++$(bind "isGeomEnabled" "dGeomIsEnabled" [geom,bool])++
+ src/Physics/ODE/Hsc.hsc view
@@ -0,0 +1,207 @@+#include <ode/ode.h>+module Physics.ODE.Hsc+ ( addressOfGeom+ , toBitmask+ , fromBitmask+ , sizeOfMass+ , sizeOfMatrix3+ , sizeOfMatrix4+ , peekMass+ , toSurfaceMode+ , fromSurfaceMode+ , toJointType+ , fromJointType+ , toBodyIndex+ , fromBodyIndex+ , toGeomClass+ , fromGeomClass+ ) where++import Physics.ODE.Types+import Physics.ODE.Utilities+import Foreign++import Control.Monad+import Data.Maybe++instance Storable ContactGeom where+ sizeOf _ = #{size struct dContactGeom}+ alignment _ = 4+ peek ptr+ = do pos <- peekVector3 (#{ptr struct dContactGeom, pos} ptr)+ normal <- peekVector3 (#{ptr struct dContactGeom, normal} ptr)+ depth <- peek (#{ptr struct dContactGeom, depth} ptr)+ obj1 <- peek (#{ptr struct dContactGeom, g1} ptr)+ obj2 <- peek (#{ptr struct dContactGeom, g2} ptr)+ return (ContactGeom pos normal depth (obj1,obj2))+ poke ptr cGeom+ = do pokeVector3 (#{ptr struct dContactGeom, pos} ptr) (contactPos cGeom)+ pokeVector3 (#{ptr struct dContactGeom, normal} ptr) (contactNormal cGeom)+ #{poke struct dContactGeom, depth} ptr (contactDepth cGeom)+ #{poke struct dContactGeom, g1} ptr (fst (contactObjects cGeom))+ #{poke struct dContactGeom, g2} ptr (snd (contactObjects cGeom))++instance Storable ContactInfo where+ sizeOf _ = #{size struct dContact}+ alignment _ = alignment (undefined :: ODEreal)+ peek ptr+ = do surface <- #{peek struct dContact, surface} ptr+ geom <- #{peek struct dContact, geom} ptr+ fdir <- peekVector3 (#{ptr struct dContact, fdir1} ptr)+ return (ContactInfo surface geom fdir)+ poke ptr info+ = do #{poke struct dContact, surface} ptr (contactSurface info)+ #{poke struct dContact, geom} ptr (contactGeom info)+ pokeVector3 (#{ptr struct dContact,fdir1} ptr) (contactFDir1 info)++instance Storable Surface where+ sizeOf _ = #{size struct dSurfaceParameters}+ alignment _ = alignment (undefined :: ODEreal)+ peek ptr+ = do mode <- fmap (fromBitmask fromSurfaceMode) (#{peek struct dSurfaceParameters, mode} ptr)+ let mbPeek flag action+ | flag `elem` mode = fmap Just action+ | otherwise = return Nothing+ mu <- #{peek struct dSurfaceParameters, mu} ptr+ mu2 <- mbPeek HaveMu2 $ #{peek struct dSurfaceParameters, mu2} ptr+ bounce <- mbPeek HaveBounce $ liftM2 (,) (#{peek struct dSurfaceParameters, bounce} ptr)+ (#{peek struct dSurfaceParameters, bounce_vel} ptr)+ softERP <- mbPeek HaveSoftERP $ #{peek struct dSurfaceParameters, soft_erp} ptr+ softCFM <- mbPeek HaveSoftCFM $ #{peek struct dSurfaceParameters, soft_cfm} ptr+ motion1 <- mbPeek HaveMotion1 $ #{peek struct dSurfaceParameters, motion1} ptr+ motion2 <- mbPeek HaveMotion2 $ #{peek struct dSurfaceParameters, motion2} ptr+ slip1 <- mbPeek HaveSlip1 $ #{peek struct dSurfaceParameters, slip1} ptr+ slip2 <- mbPeek HaveSlip2 $ #{peek struct dSurfaceParameters, slip2} ptr+ return (Surface mu mu2 bounce softERP softCFM motion1 motion2 slip1 slip2)+ poke ptr surface+ = do #{poke struct dSurfaceParameters, mode} ptr (toBitmask fromSurfaceMode flags)+ #{poke struct dSurfaceParameters, mu} ptr (surfaceMu surface)+ mbPoke surfaceMu2 $ #{poke struct dSurfaceParameters, mu2} ptr+ mbPoke surfaceBounce $ \(bounce,vel) -> #{poke struct dSurfaceParameters, bounce} ptr bounce >>+ #{poke struct dSurfaceParameters, bounce_vel} ptr vel+ mbPoke surfaceSoftERP $ #{poke struct dSurfaceParameters, soft_erp} ptr+ mbPoke surfaceSoftCFM $ #{poke struct dSurfaceParameters, soft_cfm} ptr+ mbPoke surfaceMotion1 $ #{poke struct dSurfaceParameters, motion1} ptr+ mbPoke surfaceMotion2 $ #{poke struct dSurfaceParameters, motion2} ptr+ mbPoke surfaceSlip1 $ #{poke struct dSurfaceParameters, slip1} ptr+ mbPoke surfaceSlip2 $ #{poke struct dSurfaceParameters, slip2} ptr+ where flags = foldr mkFlag (maybe [] (const [HaveBounce]) (surfaceBounce surface))+ (zip (HaveMu2 : [ HaveSoftERP .. HaveApprox12])+ [ surfaceMu2, surfaceSoftERP+ , surfaceSoftCFM, surfaceMotion1, surfaceMotion2+ , surfaceSlip1, surfaceSlip2 ])+ mkFlag (flag,fn)+ | isJust (fn surface) = (:) flag+ | otherwise = id+ mbPoke fn action+ = case fn surface of+ Just val -> action val+ Nothing -> return ()++addressOfGeom :: Ptr ContactInfo -> Ptr ContactGeom+addressOfGeom = #{ptr struct dContact, geom}++toBitmask :: Bits b => (a -> b) -> [a] -> b+toBitmask from = foldr (.|.) 0 . map from++fromBitmask :: (Enum a, Bounded a,Bits b) => (a -> b) -> b -> [a]+fromBitmask from mask = foldr worker [] lst+ where lst = [minBound .. maxBound]+ worker v+ = if (mask .&. from v) /= 0+ then (:) v+ else id++toSurfaceMode :: Int -> SurfaceMode+toSurfaceMode #{const dContactMu2} = HaveMu2+toSurfaceMode #{const dContactFDir1} = HaveFDir1+toSurfaceMode #{const dContactBounce} = HaveBounce+toSurfaceMode #{const dContactSoftERP} = HaveSoftERP+toSurfaceMode #{const dContactSoftCFM} = HaveSoftCFM+toSurfaceMode #{const dContactMotion1} = HaveMotion1+toSurfaceMode #{const dContactMotion2} = HaveMotion2+toSurfaceMode #{const dContactSlip1} = HaveSlip1+toSurfaceMode #{const dContactSlip2} = HaveSlip2+toSurfaceMode #{const dContactApprox1_1} = HaveApprox11+toSurfaceMode #{const dContactApprox1_2} = HaveApprox12+toSurfaceMode _ = error "Physics.ODE.Hsc.toSurfaceMode: bad argument"++fromSurfaceMode :: SurfaceMode -> Int+fromSurfaceMode HaveMu2 = #{const dContactMu2}+fromSurfaceMode HaveFDir1 = #{const dContactFDir1}+fromSurfaceMode HaveBounce = #{const dContactBounce}+fromSurfaceMode HaveSoftERP = #{const dContactSoftERP}+fromSurfaceMode HaveSoftCFM = #{const dContactSoftCFM}+fromSurfaceMode HaveMotion1 = #{const dContactMotion1}+fromSurfaceMode HaveMotion2 = #{const dContactMotion2}+fromSurfaceMode HaveSlip1 = #{const dContactSlip1}+fromSurfaceMode HaveSlip2 = #{const dContactSlip2}+fromSurfaceMode HaveApprox11 = #{const dContactApprox1_1}+fromSurfaceMode HaveApprox12 = #{const dContactApprox1_2}++sizeOfMass :: Int+sizeOfMass = #{size struct dMass}++sizeOfMatrix3 :: Int+sizeOfMatrix3 = sizeOf (undefined::ODEreal)*4*3++sizeOfMatrix4 :: Int+sizeOfMatrix4 = sizeOf (undefined::ODEreal)*4*4++peekMass :: Ptr MassStruct -> IO ODEreal+peekMass = #{peek struct dMass, mass}++toJointType :: Int -> JointType+toJointType #{const dJointTypeBall} = Ball+toJointType #{const dJointTypeHinge} = Hinge+toJointType #{const dJointTypeSlider} = Slider+toJointType #{const dJointTypeContact} = Contact+toJointType #{const dJointTypeUniversal} = Universal+toJointType #{const dJointTypeHinge2} = Hinge2+toJointType #{const dJointTypeFixed} = Fixed+toJointType #{const dJointTypeAMotor} = AMotor+toJointType _ = error "Physics.ODE.Hsc.toJointType: bad argument"++fromJointType :: JointType -> Int+fromJointType Ball = #{const dJointTypeBall}+fromJointType Hinge = #{const dJointTypeHinge}+fromJointType Slider = #{const dJointTypeSlider}+fromJointType Contact = #{const dJointTypeContact}+fromJointType Universal = #{const dJointTypeUniversal}+fromJointType Hinge2 = #{const dJointTypeHinge2}+fromJointType Fixed = #{const dJointTypeFixed}+fromJointType AMotor = #{const dJointTypeAMotor}++toBodyIndex :: Int -> BodyIndex+toBodyIndex 0 = First+toBodyIndex 1 = Second+toBodyIndex _ = error "Physics.ODE.Hsc.toBodyIndex: bad argument"++fromBodyIndex :: BodyIndex -> Int+fromBodyIndex First = 0+fromBodyIndex Second = 1++toGeomClass :: Int -> GeomClass+toGeomClass #{const dSphereClass} = Sphere+toGeomClass #{const dBoxClass} = Box+toGeomClass #{const dCCylinderClass} = CappedCylinder+toGeomClass #{const dCylinderClass} = Cylinder+toGeomClass #{const dPlaneClass} = Plane+toGeomClass #{const dGeomTransformClass} = GeomTransform+toGeomClass #{const dRayClass} = Ray+toGeomClass #{const dTriMeshClass} = TriangleMesh+toGeomClass #{const dSimpleSpaceClass} = SimpleSpace+toGeomClass #{const dHashSpaceClass} = HashSpace+toGeomClass _ = error "Physics.ODE.Hsc.toGeomClass: bad argument"++fromGeomClass :: GeomClass -> Int+fromGeomClass Sphere = #{const dSphereClass}+fromGeomClass Box = #{const dBoxClass}+fromGeomClass CappedCylinder = #{const dCCylinderClass}+fromGeomClass Cylinder = #{const dCylinderClass}+fromGeomClass Plane = #{const dPlaneClass}+fromGeomClass GeomTransform = #{const dGeomTransformClass}+fromGeomClass Ray = #{const dRayClass}+fromGeomClass TriangleMesh = #{const dTriMeshClass}+fromGeomClass SimpleSpace = #{const dSimpleSpaceClass}+fromGeomClass HashSpace = #{const dHashSpaceClass}
+ src/Physics/ODE/Joint.hs view
@@ -0,0 +1,170 @@+module Physics.ODE.Joint+ (createBall, createHinge, createSlider, createContact, createGroup,+ destroyJoint, destroyGroup, emptyGroup, attach, setRawJointData,+ setJointData, setSafeJointData, getRawJointData, getJointData,+ getSafeJointData, tryGetSafeJointData, getType, getBody,+ areConnected, areConnectedExcluding, setBallAnchor, getBallAnchor,+ setHingeAnchor, setHingeAxis)+ where+import Foreign+import Data.Typeable+import Data.Maybe+import Physics.ODE.Types+import Physics.ODE.Utilities+import Physics.ODE.Hsc+ +createGroup :: IO JointGroup+createGroup = createGroup' 0+ +foreign import ccall unsafe "dJointSetData" setRawJointData ::+ Ptr JointStruct -> Ptr a -> IO ()+ +setJointData :: Joint -> a -> IO ()+setJointData body d+ = newStablePtr d >>=+ \ stablePtr -> setRawJointData body (castStablePtrToPtr stablePtr)+ +setSafeJointData :: (Typeable a) => Joint -> a -> IO ()+setSafeJointData body d = setJointData body (typeOf d, d)+ +foreign import ccall unsafe "dJointGetData" getRawJointData ::+ Ptr JointStruct -> IO (Ptr a)+ +getJointData :: Joint -> IO a+getJointData body+ = getRawJointData body >>= deRefStablePtr . castPtrToStablePtr+ +tryGetSafeJointData :: (Typeable a) => Joint -> IO (Maybe a)+tryGetSafeJointData body+ = getJointData body >>=+ \ (t, d) ->+ if t == typeOf d then return (Just d) else return Nothing+ +getSafeJointData :: (Typeable a) => Joint -> IO a+getSafeJointData+ = fmap (fromMaybe (error errMsg)) . tryGetSafeJointData+ where errMsg = "Physics.ODE.Joint.getSafeJointData: invalid type."+-- import qualified Physics.ODE.Mass as Mass ( create )+createBall :: World -> Maybe JointGroup -> IO Joint+createBall = \arg_0 arg_1 -> (\action_2 -> action_2 arg_0) (\marshaledArg_3 -> (case arg_1 of+ Data.Maybe.Just a_4 -> \action_5 -> action_5 a_4+ Data.Maybe.Nothing -> \action_6 -> action_6 nullPtr) (\marshaledArg_7 -> do ret_8 <- createBalldJointCreateBall marshaledArg_3 marshaledArg_7+ return (ret_8)))+foreign import ccall unsafe "dJointCreateBall" createBalldJointCreateBall :: World ->+ JointGroup -> IO Joint+createHinge :: World -> Maybe JointGroup -> IO Joint+createHinge = \arg_0 arg_1 -> (\action_2 -> action_2 arg_0) (\marshaledArg_3 -> (case arg_1 of+ Data.Maybe.Just a_4 -> \action_5 -> action_5 a_4+ Data.Maybe.Nothing -> \action_6 -> action_6 nullPtr) (\marshaledArg_7 -> do ret_8 <- createHingedJointCreateHinge marshaledArg_3 marshaledArg_7+ return (ret_8)))+foreign import ccall unsafe "dJointCreateHinge" createHingedJointCreateHinge :: World ->+ JointGroup ->+ IO Joint+createSlider :: World -> Maybe JointGroup -> IO Joint+createSlider = \arg_0 arg_1 -> (\action_2 -> action_2 arg_0) (\marshaledArg_3 -> (case arg_1 of+ Data.Maybe.Just a_4 -> \action_5 -> action_5 a_4+ Data.Maybe.Nothing -> \action_6 -> action_6 nullPtr) (\marshaledArg_7 -> do ret_8 <- createSliderdJointCreateSlider marshaledArg_3 marshaledArg_7+ return (ret_8)))+foreign import ccall unsafe "dJointCreateSlider" createSliderdJointCreateSlider :: World ->+ JointGroup ->+ IO Joint+createContact :: World ->+ Maybe JointGroup -> ContactInfo -> IO Joint+createContact = \arg_0 arg_1 arg_2 -> (\action_3 -> action_3 arg_0) (\marshaledArg_4 -> (case arg_1 of+ Data.Maybe.Just a_5 -> \action_6 -> action_6 a_5+ Data.Maybe.Nothing -> \action_7 -> action_7 nullPtr) (\marshaledArg_8 -> (\action_9 -> alloca (\ptr_10 -> do poke ptr_10 arg_2+ action_9 ptr_10)) (\marshaledArg_11 -> do ret_12 <- createContactdJointCreateContact marshaledArg_4 marshaledArg_8 marshaledArg_11+ return (ret_12))))+foreign import ccall unsafe "dJointCreateContact" createContactdJointCreateContact :: World ->+ JointGroup ->+ Ptr ContactInfo ->+ IO Joint+createGroup' :: Int -> IO JointGroup+createGroup' = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- createGroup'dJointGroupCreate marshaledArg_2+ return (ret_3))+foreign import ccall unsafe "dJointGroupCreate" createGroup'dJointGroupCreate :: Int ->+ IO JointGroup+destroyJoint :: Joint -> IO ()+destroyJoint = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- destroyJointdJointDestroy marshaledArg_2+ case () of+ () -> do return ())+foreign import ccall unsafe "dJointDestroy" destroyJointdJointDestroy :: Joint ->+ IO ()+destroyGroup :: JointGroup -> IO ()+destroyGroup = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- destroyGroupdJointGroupDestroy marshaledArg_2+ case () of+ () -> do return ())+foreign import ccall unsafe "dJointGroupDestroy" destroyGroupdJointGroupDestroy :: JointGroup ->+ IO ()+emptyGroup :: JointGroup -> IO ()+emptyGroup = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- emptyGroupdJointGroupEmpty marshaledArg_2+ case () of+ () -> do return ())+foreign import ccall unsafe "dJointGroupEmpty" emptyGroupdJointGroupEmpty :: JointGroup ->+ IO ()+attach :: Joint -> Maybe Body -> Maybe Body -> IO ()+attach = \arg_0 arg_1 arg_2 -> (\action_3 -> action_3 arg_0) (\marshaledArg_4 -> (case arg_1 of+ Data.Maybe.Just a_5 -> \action_6 -> action_6 a_5+ Data.Maybe.Nothing -> \action_7 -> action_7 nullPtr) (\marshaledArg_8 -> (case arg_2 of+ Data.Maybe.Just a_9 -> \action_10 -> action_10 a_9+ Data.Maybe.Nothing -> \action_11 -> action_11 nullPtr) (\marshaledArg_12 -> do ret_13 <- attachdJointAttach marshaledArg_4 marshaledArg_8 marshaledArg_12+ case () of+ () -> do return ())))+foreign import ccall unsafe "dJointAttach" attachdJointAttach :: Joint ->+ Body -> Body -> IO ()+getType :: Joint -> IO JointType+getType = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- getTypedJointGetType marshaledArg_2+ return (toJointType (ret_3)))+foreign import ccall unsafe "dJointGetType" getTypedJointGetType :: Joint ->+ IO Int+getBody :: Joint -> BodyIndex -> IO Body+getBody = \arg_0 arg_1 -> (\action_2 -> action_2 arg_0) (\marshaledArg_3 -> (\action_4 -> action_4 (fromBodyIndex arg_1)) (\marshaledArg_5 -> do ret_6 <- getBodydJointGetBody marshaledArg_3 marshaledArg_5+ return (ret_6)))+foreign import ccall unsafe "dJointGetBody" getBodydJointGetBody :: Joint ->+ Int -> IO Body+areConnected :: Body -> Body -> IO Bool+areConnected = \arg_0 arg_1 -> (\action_2 -> action_2 arg_0) (\marshaledArg_3 -> (\action_4 -> action_4 arg_1) (\marshaledArg_5 -> do ret_6 <- areConnecteddAreConnected marshaledArg_3 marshaledArg_5+ return (toBool (ret_6))))+foreign import ccall unsafe "dAreConnected" areConnecteddAreConnected :: Body ->+ Body -> IO Int+areConnectedExcluding :: Body -> Body -> JointType -> IO Bool+areConnectedExcluding = \arg_0 arg_1 arg_2 -> (\action_3 -> action_3 arg_0) (\marshaledArg_4 -> (\action_5 -> action_5 arg_1) (\marshaledArg_6 -> (\action_7 -> action_7 (fromJointType arg_2)) (\marshaledArg_8 -> do ret_9 <- areConnectedExcludingdAreConnectedExcluding marshaledArg_4 marshaledArg_6 marshaledArg_8+ return (toBool (ret_9)))))+foreign import ccall unsafe "dAreConnectedExcluding" areConnectedExcludingdAreConnectedExcluding :: Body ->+ Body ->+ Int ->+ IO Int+setBallAnchor :: Joint -> ODEreal -> ODEreal -> ODEreal -> IO ()+setBallAnchor = \arg_0 arg_1 arg_2 arg_3 -> (\action_4 -> action_4 arg_0) (\marshaledArg_5 -> (\action_6 -> action_6 arg_1) (\marshaledArg_7 -> (\action_8 -> action_8 arg_2) (\marshaledArg_9 -> (\action_10 -> action_10 arg_3) (\marshaledArg_11 -> do ret_12 <- setBallAnchordJointSetBallAnchor marshaledArg_5 marshaledArg_7 marshaledArg_9 marshaledArg_11+ case () of+ () -> do return ()))))+foreign import ccall unsafe "dJointSetBallAnchor" setBallAnchordJointSetBallAnchor :: Joint ->+ ODEreal ->+ ODEreal ->+ ODEreal ->+ IO ()+getBallAnchor :: Joint -> IO ((ODEreal, ODEreal, ODEreal))+getBallAnchor = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> allocaArray 4 (\marshaledArg_3 -> do ret_4 <- getBallAnchordJointGetBallAnchor marshaledArg_2 marshaledArg_3+ peekVector3 (marshaledArg_3)))+foreign import ccall unsafe "dJointGetBallAnchor" getBallAnchordJointGetBallAnchor :: Joint ->+ Ptr ODEreal ->+ IO ()+-- -------------------------------------------+-- Hinge joint+setHingeAnchor :: Joint -> ODEreal -> ODEreal -> ODEreal -> IO ()+setHingeAnchor = \arg_0 arg_1 arg_2 arg_3 -> (\action_4 -> action_4 arg_0) (\marshaledArg_5 -> (\action_6 -> action_6 arg_1) (\marshaledArg_7 -> (\action_8 -> action_8 arg_2) (\marshaledArg_9 -> (\action_10 -> action_10 arg_3) (\marshaledArg_11 -> do ret_12 <- setHingeAnchordJointSetHingeAnchor marshaledArg_5 marshaledArg_7 marshaledArg_9 marshaledArg_11+ case () of+ () -> do return ()))))+foreign import ccall unsafe "dJointSetHingeAnchor" setHingeAnchordJointSetHingeAnchor :: Joint ->+ ODEreal ->+ ODEreal ->+ ODEreal ->+ IO ()+setHingeAxis :: Joint -> ODEreal -> ODEreal -> ODEreal -> IO ()+setHingeAxis = \arg_0 arg_1 arg_2 arg_3 -> (\action_4 -> action_4 arg_0) (\marshaledArg_5 -> (\action_6 -> action_6 arg_1) (\marshaledArg_7 -> (\action_8 -> action_8 arg_2) (\marshaledArg_9 -> (\action_10 -> action_10 arg_3) (\marshaledArg_11 -> do ret_12 <- setHingeAxisdJointSetHingeAxis marshaledArg_5 marshaledArg_7 marshaledArg_9 marshaledArg_11+ case () of+ () -> do return ()))))+foreign import ccall unsafe "dJointSetHingeAxis" setHingeAxisdJointSetHingeAxis :: Joint ->+ ODEreal ->+ ODEreal ->+ ODEreal -> IO ()
+ src/Physics/ODE/Joint.th view
@@ -0,0 +1,104 @@+module Physics.ODE.Joint+ ( createBall+ , createHinge+ , createSlider+ , createContact+ , createGroup+ , destroyJoint+ , destroyGroup+ , emptyGroup+ , attach+ , setRawJointData+ , setJointData+ , setSafeJointData+ , getRawJointData+ , getJointData+ , getSafeJointData+ , tryGetSafeJointData+ , getType+ , getBody+ , areConnected+ , areConnectedExcluding+ , setBallAnchor+ , getBallAnchor+ , setHingeAnchor+ , setHingeAxis+ ) where++import Foreign+import Data.Typeable+import Data.Maybe++-- import qualified Physics.ODE.Mass as Mass ( create )+import Physics.ODE.Types+import Physics.ODE.Utilities+import Physics.ODE.Hsc++#ifdef HASTH+import Foreign.HacanonLight.DIS+import Foreign.HacanonLight.Generate+import Physics.ODE.DIS+#endif++$(bind "createBall" "dJointCreateBall" [world,maybePtr jointGroup,joint])+$(bind "createHinge" "dJointCreateHinge" [world,maybePtr jointGroup,joint])+$(bind "createSlider" "dJointCreateSlider" [world,maybePtr jointGroup,joint])+$(bind "createContact" "dJointCreateContact" [world,maybePtr jointGroup,contact,joint])++$(bind "createGroup'" "dJointGroupCreate" [int,jointGroup])++createGroup :: IO JointGroup+createGroup = createGroup' 0++$(bind "destroyJoint" "dJointDestroy" [joint,unit])++$(bind "destroyGroup" "dJointGroupDestroy" [jointGroup,unit])++$(bind "emptyGroup" "dJointGroupEmpty" [jointGroup,unit])++$(bind "attach" "dJointAttach" [joint,maybePtr body,maybePtr body,unit])++foreign import ccall unsafe "dJointSetData" setRawJointData :: Ptr JointStruct -> Ptr a -> IO ()++setJointData :: Joint -> a -> IO ()+setJointData body d = newStablePtr d >>= \stablePtr ->+ setRawJointData body (castStablePtrToPtr stablePtr)++setSafeJointData :: Typeable a => Joint -> a -> IO ()+setSafeJointData body d = setJointData body (typeOf d,d)++foreign import ccall unsafe "dJointGetData" getRawJointData :: Ptr JointStruct -> IO (Ptr a)++getJointData :: Joint -> IO a+getJointData body = getRawJointData body >>= deRefStablePtr.castPtrToStablePtr++tryGetSafeJointData :: Typeable a => Joint -> IO (Maybe a)+tryGetSafeJointData body = getJointData body >>= \(t,d) ->+ if t == typeOf d+ then return (Just d)+ else return Nothing++getSafeJointData :: Typeable a => Joint -> IO a+getSafeJointData = fmap (fromMaybe (error errMsg)).tryGetSafeJointData+ where errMsg = "Physics.ODE.Joint.getSafeJointData: invalid type."++$(bind "getType" "dJointGetType" [joint,jointType])++$(bind "getBody" "dJointGetBody" [joint,bodyIndex,body])++$(bind "areConnected" "dAreConnected" [body,body,bool])++$(bind "areConnectedExcluding" "dAreConnectedExcluding" [body,body,jointType,bool])++$(bind "setBallAnchor" "dJointSetBallAnchor" [joint,ode,ode,ode,unit])++$(bind "getBallAnchor" "dJointGetBallAnchor" [joint,vector3Out,unit])++---------------------------------------------+-- Hinge joint++$(bind "setHingeAnchor" "dJointSetHingeAnchor" [joint,ode,ode,ode,unit])++$(bind "setHingeAxis" "dJointSetHingeAxis" [joint,ode,ode,ode,unit])++
+ src/Physics/ODE/Mass.hs view
@@ -0,0 +1,50 @@+module Physics.ODE.Mass+ (create, destroyMass, mass, setZero, adjust) where+import Foreign+import Physics.ODE.Types+import Physics.ODE.Utilities+import Physics.ODE.Hsc+ +create :: IO Mass+create = mallocForeignPtrBytes sizeOfMass+ +destroyMass :: Mass -> IO ()+destroyMass = forceFinalization+ +mass :: Mass -> IO ODEreal+mass m = withForeignPtr m peekMass+-- void dMassSetZero (dMass *);+setZero :: Mass -> IO ()+setZero = \arg_0 -> withForeignPtr arg_0 (\marshaledArg_1 -> do ret_2 <- setZerodMassSetZero marshaledArg_1+ case () of+ () -> do return ())+foreign import ccall unsafe "dMassSetZero" setZerodMassSetZero :: Ptr MassStruct ->+ IO ()+-- void dMassSetParameters (dMass *, dReal themass,+-- dReal cgx, dReal cgy, dReal cgz,+-- dReal I11, dReal I22, dReal I33,+-- dReal I12, dReal I13, dReal I23);+-- void dMassSetSphere (dMass *, dReal density, dReal radius);+-- void dMassSetSphereTotal (dMass *, dReal total_mass, dReal radius);+-- void dMassSetCappedCylinder (dMass *, dReal density, int direction,+-- dReal radius, dReal length);+-- void dMassSetCappedCylinderTotal (dMass *, dReal total_mass, int direction,+-- dReal radius, dReal length);+-- void dMassSetCylinder (dMass *, dReal density, int direction,+-- dReal radius, dReal length);+-- void dMassSetCylinderTotal (dMass *, dReal total_mass, int direction,+-- dReal radius, dReal length);+-- void dMassSetBox (dMass *, dReal density,+-- dReal lx, dReal ly, dReal lz);+-- void dMassSetBoxTotal (dMass *, dReal total_mass,+-- dReal lx, dReal ly, dReal lz);+-- void dMassAdjust (dMass *, dReal newmass);+adjust :: Mass -> ODEreal -> IO ()+adjust = \arg_0 arg_1 -> withForeignPtr arg_0 (\marshaledArg_2 -> (\action_3 -> action_3 arg_1) (\marshaledArg_4 -> do ret_5 <- adjustdMassAdjust marshaledArg_2 marshaledArg_4+ case () of+ () -> do return ()))+foreign import ccall unsafe "dMassAdjust" adjustdMassAdjust :: Ptr MassStruct ->+ ODEreal -> IO ()+-- void dMassTranslate (dMass *, dReal x, dReal y, dReal z);+-- void dMassRotate (dMass *, const dMatrix3 R);+-- void dMassAdd (dMass *a, const dMass *b);
+ src/Physics/ODE/Mass.th view
@@ -0,0 +1,65 @@+module Physics.ODE.Mass+ ( create+ , destroyMass+ , mass+ , setZero+ , adjust+ ) where++import Foreign++import Physics.ODE.Types+import Physics.ODE.Utilities+import Physics.ODE.Hsc++#ifdef HASTH+import Foreign.HacanonLight.DIS+import Foreign.HacanonLight.Generate+import Physics.ODE.DIS+#endif++create :: IO Mass+create = mallocForeignPtrBytes sizeOfMass++destroyMass :: Mass -> IO ()+destroyMass = forceFinalization++mass :: Mass -> IO ODEreal+mass m+ = withForeignPtr m peekMass++-- void dMassSetZero (dMass *);+$(bind "setZero" "dMassSetZero" [mass,unit])+++-- void dMassSetParameters (dMass *, dReal themass,+-- dReal cgx, dReal cgy, dReal cgz,+-- dReal I11, dReal I22, dReal I33,+-- dReal I12, dReal I13, dReal I23);++-- void dMassSetSphere (dMass *, dReal density, dReal radius);+-- void dMassSetSphereTotal (dMass *, dReal total_mass, dReal radius);++-- void dMassSetCappedCylinder (dMass *, dReal density, int direction,+-- dReal radius, dReal length);+-- void dMassSetCappedCylinderTotal (dMass *, dReal total_mass, int direction,+-- dReal radius, dReal length);++-- void dMassSetCylinder (dMass *, dReal density, int direction,+-- dReal radius, dReal length);+-- void dMassSetCylinderTotal (dMass *, dReal total_mass, int direction,+-- dReal radius, dReal length);++-- void dMassSetBox (dMass *, dReal density,+-- dReal lx, dReal ly, dReal lz);+-- void dMassSetBoxTotal (dMass *, dReal total_mass,+-- dReal lx, dReal ly, dReal lz);++-- void dMassAdjust (dMass *, dReal newmass);+$(bind "adjust" "dMassAdjust" [mass,ode,unit])++-- void dMassTranslate (dMass *, dReal x, dReal y, dReal z);++-- void dMassRotate (dMass *, const dMatrix3 R);++-- void dMassAdd (dMass *a, const dMass *b);
+ src/Physics/ODE/Objects.hs view
@@ -0,0 +1,113 @@+module Physics.ODE.Objects+ (createSphere, sphereSetRadius, sphereGetRadius, spherePointDepth,+ createBox, boxSetLengths, boxGetLengths, boxPointDepth,+ createPlane, planeSetParams, planeGetParams, planePointDepth)+ where+import Foreign+import Data.Maybe+import Physics.ODE.Types+import Physics.ODE.Utilities+-- foreign import ccall unsafe "&dGeomDestroy" cDestroy :: FinalizerPtr GeomStruct+-- -------------------------------------------+-- Sphere class+createSphere :: Maybe Space -> ODEreal -> IO Geom+createSphere = \arg_0 arg_1 -> (case arg_0 of+ Data.Maybe.Just a_2 -> \action_3 -> action_3 a_2+ Data.Maybe.Nothing -> \action_4 -> action_4 nullPtr) (\marshaledArg_5 -> (\action_6 -> action_6 arg_1) (\marshaledArg_7 -> do ret_8 <- createSpheredCreateSphere marshaledArg_5 marshaledArg_7+ return (ret_8)))+foreign import ccall unsafe "dCreateSphere" createSpheredCreateSphere :: Space ->+ ODEreal -> IO Geom+sphereSetRadius :: Geom -> ODEreal -> IO ()+sphereSetRadius = \arg_0 arg_1 -> (\action_2 -> action_2 arg_0) (\marshaledArg_3 -> (\action_4 -> action_4 arg_1) (\marshaledArg_5 -> do ret_6 <- sphereSetRadiusdGeomSphereSetRadius marshaledArg_3 marshaledArg_5+ case () of+ () -> do return ()))+foreign import ccall unsafe "dGeomSphereSetRadius" sphereSetRadiusdGeomSphereSetRadius :: Geom ->+ ODEreal ->+ IO ()+sphereGetRadius :: Geom -> IO ODEreal+sphereGetRadius = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- sphereGetRadiusdGeomSphereGetRadius marshaledArg_2+ return (ret_3))+foreign import ccall unsafe "dGeomSphereGetRadius" sphereGetRadiusdGeomSphereGetRadius :: Geom ->+ IO ODEreal+spherePointDepth :: Geom ->+ ODEreal -> ODEreal -> ODEreal -> IO ODEreal+spherePointDepth = \arg_0 arg_1 arg_2 arg_3 -> (\action_4 -> action_4 arg_0) (\marshaledArg_5 -> (\action_6 -> action_6 arg_1) (\marshaledArg_7 -> (\action_8 -> action_8 arg_2) (\marshaledArg_9 -> (\action_10 -> action_10 arg_3) (\marshaledArg_11 -> do ret_12 <- spherePointDepthdGeomSpherePointDepth marshaledArg_5 marshaledArg_7 marshaledArg_9 marshaledArg_11+ return (ret_12)))))+foreign import ccall unsafe "dGeomSpherePointDepth" spherePointDepthdGeomSpherePointDepth :: Geom ->+ ODEreal ->+ ODEreal ->+ ODEreal ->+ IO ODEreal+-- -------------------------------------------+-- Box class+createBox :: Maybe Space ->+ ODEreal -> ODEreal -> ODEreal -> IO Geom+createBox = \arg_0 arg_1 arg_2 arg_3 -> (case arg_0 of+ Data.Maybe.Just a_4 -> \action_5 -> action_5 a_4+ Data.Maybe.Nothing -> \action_6 -> action_6 nullPtr) (\marshaledArg_7 -> (\action_8 -> action_8 arg_1) (\marshaledArg_9 -> (\action_10 -> action_10 arg_2) (\marshaledArg_11 -> (\action_12 -> action_12 arg_3) (\marshaledArg_13 -> do ret_14 <- createBoxdCreateBox marshaledArg_7 marshaledArg_9 marshaledArg_11 marshaledArg_13+ return (ret_14)))))+foreign import ccall unsafe "dCreateBox" createBoxdCreateBox :: Space ->+ ODEreal ->+ ODEreal -> ODEreal -> IO Geom+boxSetLengths :: Geom -> ODEreal -> ODEreal -> ODEreal -> IO ()+boxSetLengths = \arg_0 arg_1 arg_2 arg_3 -> (\action_4 -> action_4 arg_0) (\marshaledArg_5 -> (\action_6 -> action_6 arg_1) (\marshaledArg_7 -> (\action_8 -> action_8 arg_2) (\marshaledArg_9 -> (\action_10 -> action_10 arg_3) (\marshaledArg_11 -> do ret_12 <- boxSetLengthsdGeomBoxSetLengths marshaledArg_5 marshaledArg_7 marshaledArg_9 marshaledArg_11+ case () of+ () -> do return ()))))+foreign import ccall unsafe "dGeomBoxSetLengths" boxSetLengthsdGeomBoxSetLengths :: Geom ->+ ODEreal ->+ ODEreal ->+ ODEreal -> IO ()+boxGetLengths :: Geom -> IO ((ODEreal, ODEreal, ODEreal))+boxGetLengths = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> allocaArray 4 (\marshaledArg_3 -> do ret_4 <- boxGetLengthsdGeomBoxGetLengths marshaledArg_2 marshaledArg_3+ peekVector3 (marshaledArg_3)))+foreign import ccall unsafe "dGeomBoxGetLengths" boxGetLengthsdGeomBoxGetLengths :: Geom ->+ Ptr ODEreal ->+ IO ()+boxPointDepth :: Geom ->+ ODEreal -> ODEreal -> ODEreal -> IO ODEreal+boxPointDepth = \arg_0 arg_1 arg_2 arg_3 -> (\action_4 -> action_4 arg_0) (\marshaledArg_5 -> (\action_6 -> action_6 arg_1) (\marshaledArg_7 -> (\action_8 -> action_8 arg_2) (\marshaledArg_9 -> (\action_10 -> action_10 arg_3) (\marshaledArg_11 -> do ret_12 <- boxPointDepthdGeomBoxPointDepth marshaledArg_5 marshaledArg_7 marshaledArg_9 marshaledArg_11+ return (ret_12)))))+foreign import ccall unsafe "dGeomBoxPointDepth" boxPointDepthdGeomBoxPointDepth :: Geom ->+ ODEreal ->+ ODEreal ->+ ODEreal ->+ IO ODEreal+-- -------------------------------------------+-- Plane class+createPlane :: Maybe Space ->+ ODEreal -> ODEreal -> ODEreal -> ODEreal -> IO Geom+createPlane = \arg_0 arg_1 arg_2 arg_3 arg_4 -> (case arg_0 of+ Data.Maybe.Just a_5 -> \action_6 -> action_6 a_5+ Data.Maybe.Nothing -> \action_7 -> action_7 nullPtr) (\marshaledArg_8 -> (\action_9 -> action_9 arg_1) (\marshaledArg_10 -> (\action_11 -> action_11 arg_2) (\marshaledArg_12 -> (\action_13 -> action_13 arg_3) (\marshaledArg_14 -> (\action_15 -> action_15 arg_4) (\marshaledArg_16 -> do ret_17 <- createPlanedCreatePlane marshaledArg_8 marshaledArg_10 marshaledArg_12 marshaledArg_14 marshaledArg_16+ return (ret_17))))))+foreign import ccall unsafe "dCreatePlane" createPlanedCreatePlane :: Space ->+ ODEreal ->+ ODEreal ->+ ODEreal -> ODEreal -> IO Geom+planeSetParams :: Geom ->+ ODEreal -> ODEreal -> ODEreal -> ODEreal -> IO ()+planeSetParams = \arg_0 arg_1 arg_2 arg_3 arg_4 -> (\action_5 -> action_5 arg_0) (\marshaledArg_6 -> (\action_7 -> action_7 arg_1) (\marshaledArg_8 -> (\action_9 -> action_9 arg_2) (\marshaledArg_10 -> (\action_11 -> action_11 arg_3) (\marshaledArg_12 -> (\action_13 -> action_13 arg_4) (\marshaledArg_14 -> do ret_15 <- planeSetParamsdGeomPlaneSetParams marshaledArg_6 marshaledArg_8 marshaledArg_10 marshaledArg_12 marshaledArg_14+ case () of+ () -> do return ())))))+foreign import ccall unsafe "dGeomPlaneSetParams" planeSetParamsdGeomPlaneSetParams :: Geom ->+ ODEreal ->+ ODEreal ->+ ODEreal ->+ ODEreal ->+ IO ()+planeGetParams :: Geom -> IO ((ODEreal, ODEreal, ODEreal, ODEreal))+planeGetParams = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> allocaArray 4 (\marshaledArg_3 -> do ret_4 <- planeGetParamsdGeomPlaneGetParams marshaledArg_2 marshaledArg_3+ peekVector4 (marshaledArg_3)))+foreign import ccall unsafe "dGeomPlaneGetParams" planeGetParamsdGeomPlaneGetParams :: Geom ->+ Ptr ODEreal ->+ IO ()+planePointDepth :: Geom ->+ ODEreal -> ODEreal -> ODEreal -> IO ODEreal+planePointDepth = \arg_0 arg_1 arg_2 arg_3 -> (\action_4 -> action_4 arg_0) (\marshaledArg_5 -> (\action_6 -> action_6 arg_1) (\marshaledArg_7 -> (\action_8 -> action_8 arg_2) (\marshaledArg_9 -> (\action_10 -> action_10 arg_3) (\marshaledArg_11 -> do ret_12 <- planePointDepthdGeomPlanePointDepth marshaledArg_5 marshaledArg_7 marshaledArg_9 marshaledArg_11+ return (ret_12)))))+foreign import ccall unsafe "dGeomPlanePointDepth" planePointDepthdGeomPlanePointDepth :: Geom ->+ ODEreal ->+ ODEreal ->+ ODEreal ->+ IO ODEreal+-- FIXME: Do the rest.
+ src/Physics/ODE/Objects.th view
@@ -0,0 +1,61 @@+module Physics.ODE.Objects+ ( -- * Sphere class+ createSphere+ , sphereSetRadius+ , sphereGetRadius+ , spherePointDepth+ -- * Box class+ , createBox+ , boxSetLengths+ , boxGetLengths+ , boxPointDepth+ -- * Plane class+ , createPlane+ , planeSetParams+ , planeGetParams+ , planePointDepth+ ) where++import Foreign+import Data.Maybe++import Physics.ODE.Types+import Physics.ODE.Utilities++#ifdef HASTH+import Foreign.HacanonLight.DIS+import Foreign.HacanonLight.Generate+import Physics.ODE.DIS+#endif++--foreign import ccall unsafe "&dGeomDestroy" cDestroy :: FinalizerPtr GeomStruct++---------------------------------------------+-- Sphere class++$(bind "createSphere" "dCreateSphere" [maybePtr space,ode,geom])++$(bind "sphereSetRadius" "dGeomSphereSetRadius" [geom,ode,unit])+$(bind "sphereGetRadius" "dGeomSphereGetRadius" [geom,ode])+$(bind "spherePointDepth" "dGeomSpherePointDepth" [geom,ode,ode,ode,ode])++---------------------------------------------+-- Box class++$(bind "createBox" "dCreateBox" [maybePtr space,ode,ode,ode,geom])++$(bind "boxSetLengths" "dGeomBoxSetLengths" [geom,ode,ode,ode,unit])+$(bind "boxGetLengths" "dGeomBoxGetLengths" [geom,vector3Out,unit])+$(bind "boxPointDepth" "dGeomBoxPointDepth" [geom,ode,ode,ode,ode])++---------------------------------------------+-- Plane class++$(bind "createPlane" "dCreatePlane" [maybePtr space,ode,ode,ode,ode,geom])++$(bind "planeSetParams" "dGeomPlaneSetParams" [geom,ode,ode,ode,ode,unit])+$(bind "planeGetParams" "dGeomPlaneGetParams" [geom,vector4Out,unit])+$(bind "planePointDepth" "dGeomPlanePointDepth" [geom,ode,ode,ode,ode])+++-- FIXME: Do the rest.
+ src/Physics/ODE/Overloading.hs view
@@ -0,0 +1,30 @@+module Physics.ODE.Overloading where++import Physics.ODE.Types+import Data.Typeable+import Foreign++class HasDestroy a where+ destroy :: a -> IO ()++class IsPlaceable a where+ getPosition :: a -> IO (ODEreal, ODEreal, ODEreal)+ setPosition :: a -> ODEreal -> ODEreal -> ODEreal -> IO ()+ getQuaternion :: a -> IO (ODEreal, ODEreal, ODEreal, ODEreal)+ setQuaternion :: a -> (ODEreal, ODEreal, ODEreal, ODEreal) -> IO ()+ getRotation :: a -> IO Matrix3+ setRotation :: a -> Matrix3 -> IO ()++class HasData a where+ setRawData :: a -> Ptr b -> IO ()+ setData :: a -> b -> IO ()+ setSafeData :: Typeable b => a -> b -> IO ()+ getRawData :: a -> IO (Ptr b)+ getData :: a -> IO b+ getSafeData :: Typeable b => a -> IO b+ tryGetSafeData :: Typeable b => a -> IO (Maybe b)++class HasEnable a where+ enable :: a -> IO ()+ disable :: a -> IO ()+ isEnabled :: a -> IO Bool
+ src/Physics/ODE/Rotation.hs view
@@ -0,0 +1,38 @@+module Physics.ODE.Rotation+ ( createMatrix3+ , setIdentity+ , fromAxisAndAngle+ , fromEulerAngles+-- , rToQ+ , peekMatrix3+ ) where++import Foreign++import Physics.ODE.Types+import Physics.ODE.Hsc++createMatrix3 :: IO Matrix3+createMatrix3 = do matrix <- mallocBytes sizeOfMatrix3+ setIdentity matrix+ return matrix++foreign import ccall unsafe "dRSetIdentity" setIdentity :: Matrix3 -> IO ()+foreign import ccall unsafe "dRFromAxisAndAngle" fromAxisAndAngle+ :: Matrix3 -> ODEreal -> ODEreal -> ODEreal -> ODEreal -> IO ()+foreign import ccall unsafe "dRFromEulerAngles" fromEulerAngles+ :: Matrix3 -> ODEreal -> ODEreal -> ODEreal -> IO ()++{-foreign import ccall unsafe "dRtoQ" dRtoQ+ :: Matrix3 -> Ptr ODEreal -> IO ()++rToQ :: Matrix3 -> IO Quaternion+rToQ matrix+ = allocaArray 4 $ \ptr ->+ do dRtoQ matrix ptr+ [a,b,c,d] <- peekArray 4 ptr+ return (a,b,c,d) -}+++peekMatrix3 :: Matrix3 -> IO [ODEreal]+peekMatrix3 = peekArray (3*4)
+ src/Physics/ODE/Space.hs view
@@ -0,0 +1,100 @@+module Physics.ODE.Space+ (createSimple, createHash, destroySpace, setLevels, getLevels,+ setCleanup, getCleanup, add, remove, query, getNumGeoms,+ getGeomUnsafe, tryGetGeom, getGeom)+ where+import Foreign+import Data.Maybe+import Physics.ODE.Types+ +tryGetGeom :: Space -> Int -> IO (Maybe Geom)+tryGetGeom space nth+ = do num <- getNumGeoms space+ if nth > num - 1 then return Nothing else+ fmap Just (getGeomUnsafe space nth)+ +getGeom :: Space -> Int -> IO Geom+getGeom space nth+ = fmap (fromMaybe (error msg)) (tryGetGeom space nth)+ where msg+ = "Physics.ODE.Space.getGeom: Index (" ++ show nth +++ ") out of range."+createSimple :: Maybe Space -> IO Space+createSimple = \arg_0 -> (case arg_0 of+ Data.Maybe.Just a_1 -> \action_2 -> action_2 a_1+ Data.Maybe.Nothing -> \action_3 -> action_3 nullPtr) (\marshaledArg_4 -> do ret_5 <- createSimpledSimpleSpaceCreate marshaledArg_4+ return (ret_5))+foreign import ccall unsafe "dSimpleSpaceCreate" createSimpledSimpleSpaceCreate :: Space ->+ IO Space+createHash :: Maybe Space -> IO Space+createHash = \arg_0 -> (case arg_0 of+ Data.Maybe.Just a_1 -> \action_2 -> action_2 a_1+ Data.Maybe.Nothing -> \action_3 -> action_3 nullPtr) (\marshaledArg_4 -> do ret_5 <- createHashdHashSpaceCreate marshaledArg_4+ return (ret_5))+foreign import ccall unsafe "dHashSpaceCreate" createHashdHashSpaceCreate :: Space ->+ IO Space+destroySpace :: Space -> IO ()+destroySpace = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- destroySpacedSpaceDestroy marshaledArg_2+ case () of+ () -> do return ())+foreign import ccall unsafe "dSpaceDestroy" destroySpacedSpaceDestroy :: Space ->+ IO ()+setLevels :: Space -> Int -> Int -> IO ()+setLevels = \arg_0 arg_1 arg_2 -> (\action_3 -> action_3 arg_0) (\marshaledArg_4 -> (\action_5 -> action_5 arg_1) (\marshaledArg_6 -> (\action_7 -> action_7 arg_2) (\marshaledArg_8 -> do ret_9 <- setLevelsdHashSpaceSetLevels marshaledArg_4 marshaledArg_6 marshaledArg_8+ case () of+ () -> do return ())))+foreign import ccall unsafe "dHashSpaceSetLevels" setLevelsdHashSpaceSetLevels :: Space ->+ Int ->+ Int -> IO ()+getLevels :: Space -> IO ((Int, Int))+getLevels = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> alloca (\marshaledArg_3 -> alloca (\marshaledArg_4 -> do ret_5 <- getLevelsdHashSpaceGetLevels marshaledArg_2 marshaledArg_3 marshaledArg_4+ case (marshaledArg_3,+ marshaledArg_4) of+ (tuplePart_6,+ tuplePart_7) -> do returnVariable_8 <- do n_9 <- peek tuplePart_6+ return n_9+ returnVariable_10 <- do n_11 <- peek tuplePart_7+ return n_11+ return (returnVariable_8,+ returnVariable_10))))+foreign import ccall unsafe "dHashSpaceGetLevels" getLevelsdHashSpaceGetLevels :: Space ->+ Ptr Int ->+ Ptr Int -> IO ()+setCleanup :: Space -> Bool -> IO ()+setCleanup = \arg_0 arg_1 -> (\action_2 -> action_2 arg_0) (\marshaledArg_3 -> (\action_4 -> action_4 (fromBool arg_1)) (\marshaledArg_5 -> do ret_6 <- setCleanupdSpaceSetCleanup marshaledArg_3 marshaledArg_5+ case () of+ () -> do return ()))+foreign import ccall unsafe "dSpaceSetCleanup" setCleanupdSpaceSetCleanup :: Space ->+ Int -> IO ()+getCleanup :: Space -> IO Bool+getCleanup = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- getCleanupdSpaceGetCleanup marshaledArg_2+ return (toBool (ret_3)))+foreign import ccall unsafe "dSpaceGetCleanup" getCleanupdSpaceGetCleanup :: Space ->+ IO Int+add :: Space -> Geom -> IO ()+add = \arg_0 arg_1 -> (\action_2 -> action_2 arg_0) (\marshaledArg_3 -> (\action_4 -> action_4 arg_1) (\marshaledArg_5 -> do ret_6 <- adddSpaceAdd marshaledArg_3 marshaledArg_5+ case () of+ () -> do return ()))+foreign import ccall unsafe "dSpaceAdd" adddSpaceAdd :: Space ->+ Geom -> IO ()+remove :: Space -> Geom -> IO ()+remove = \arg_0 arg_1 -> (\action_2 -> action_2 arg_0) (\marshaledArg_3 -> (\action_4 -> action_4 arg_1) (\marshaledArg_5 -> do ret_6 <- removedSpaceRemove marshaledArg_3 marshaledArg_5+ case () of+ () -> do return ()))+foreign import ccall unsafe "dSpaceRemove" removedSpaceRemove :: Space ->+ Geom -> IO ()+query :: Space -> Geom -> IO Bool+query = \arg_0 arg_1 -> (\action_2 -> action_2 arg_0) (\marshaledArg_3 -> (\action_4 -> action_4 arg_1) (\marshaledArg_5 -> do ret_6 <- querydSpaceQuery marshaledArg_3 marshaledArg_5+ return (toBool (ret_6))))+foreign import ccall unsafe "dSpaceQuery" querydSpaceQuery :: Space ->+ Geom -> IO Int+getNumGeoms :: Space -> IO Int+getNumGeoms = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- getNumGeomsdSpaceGetNumGeoms marshaledArg_2+ return (ret_3))+foreign import ccall unsafe "dSpaceGetNumGeoms" getNumGeomsdSpaceGetNumGeoms :: Space ->+ IO Int+getGeomUnsafe :: Space -> Int -> IO Geom+getGeomUnsafe = \arg_0 arg_1 -> (\action_2 -> action_2 arg_0) (\marshaledArg_3 -> (\action_4 -> action_4 arg_1) (\marshaledArg_5 -> do ret_6 <- getGeomUnsafedSpaceGetGeom marshaledArg_3 marshaledArg_5+ return (ret_6)))+foreign import ccall unsafe "dSpaceGetGeom" getGeomUnsafedSpaceGetGeom :: Space ->+ Int -> IO Geom
+ src/Physics/ODE/Space.th view
@@ -0,0 +1,57 @@+module Physics.ODE.Space+ ( createSimple+ , createHash+ , destroySpace+ , setLevels+ , getLevels+ , setCleanup+ , getCleanup+ , add+ , remove+ , query+ , getNumGeoms+ , getGeomUnsafe+ , tryGetGeom+ , getGeom+ ) where++import Foreign+import Data.Maybe++import Physics.ODE.Types++#ifdef HASTH+import Foreign.HacanonLight.DIS+import Foreign.HacanonLight.Generate+import Physics.ODE.DIS+#endif++$(bind "createSimple" "dSimpleSpaceCreate" [maybePtr space,space])+$(bind "createHash" "dHashSpaceCreate" [maybePtr space,space])++$(bind "destroySpace" "dSpaceDestroy" [space,unit])++$(bind "setLevels" "dHashSpaceSetLevels" [space,int,int,unit])+$(bind "getLevels" "dHashSpaceGetLevels" [space,mkOut int,mkOut int,unit])++$(bind "setCleanup" "dSpaceSetCleanup" [space,bool,unit])+$(bind "getCleanup" "dSpaceGetCleanup" [space,bool])++$(bind "add" "dSpaceAdd" [space,geom,unit])+$(bind "remove" "dSpaceRemove" [space,geom,unit])+$(bind "query" "dSpaceQuery" [space,geom,bool])++$(bind "getNumGeoms" "dSpaceGetNumGeoms" [space,int])+$(bind "getGeomUnsafe" "dSpaceGetGeom" [space,int,geom])++tryGetGeom :: Space -> Int -> IO (Maybe Geom)+tryGetGeom space nth+ = do num <- getNumGeoms space+ if nth > num-1+ then return Nothing+ else fmap Just (getGeomUnsafe space nth)++getGeom :: Space -> Int -> IO Geom+getGeom space nth+ = fmap (fromMaybe (error msg)) (tryGetGeom space nth)+ where msg = "Physics.ODE.Space.getGeom: Index ("++show nth++") out of range."
+ src/Physics/ODE/Types.hsc view
@@ -0,0 +1,109 @@+{-# LANGUAGE EmptyDataDecls #-}+#include <ode/ode.h>+module Physics.ODE.Types where++import Foreign++type ODEreal = #{type dReal}++type Matrix3 = Ptr ODEreal+type Quaternion = (ODEreal, ODEreal, ODEreal, ODEreal)++data WorldStruct+type World = Ptr WorldStruct++data SpaceStruct+type Space = Ptr SpaceStruct++data BodyStruct+type Body = Ptr BodyStruct++data GeomStruct+type Geom = Ptr GeomStruct++data JointStruct+type Joint = Ptr JointStruct++data JointGroupStruct+type JointGroup = Ptr JointGroupStruct++data MassStruct+type Mass = ForeignPtr MassStruct++data ContactGeom+ = ContactGeom+ { contactPos :: (ODEreal, ODEreal, ODEreal)+ , contactNormal :: (ODEreal, ODEreal, ODEreal)+ , contactDepth :: ODEreal+ , contactObjects:: (Geom,Geom)+ } deriving (Show)++data ContactInfo+ = ContactInfo+ { contactSurface :: Surface+ , contactGeom :: ContactGeom+ , contactFDir1 :: (ODEreal,ODEreal,ODEreal)+ } deriving (Show)++data Surface+ = Surface+ { surfaceMu :: ODEreal+ , surfaceMu2 :: Maybe ODEreal+ , surfaceBounce :: Maybe (ODEreal,ODEreal)+ , surfaceSoftERP :: Maybe ODEreal+ , surfaceSoftCFM :: Maybe ODEreal+ , surfaceMotion1 :: Maybe ODEreal+ , surfaceMotion2 :: Maybe ODEreal+ , surfaceSlip1 :: Maybe ODEreal+ , surfaceSlip2 :: Maybe ODEreal+ } deriving (Show,Eq)++++data SurfaceMode+ = HaveMu2+ | HaveFDir1+ | HaveBounce+ | HaveSoftERP+ | HaveSoftCFM+ | HaveMotion1+ | HaveMotion2+ | HaveSlip1+ | HaveSlip2+ | HaveApprox11+ | HaveApprox12+ deriving (Show,Eq,Enum,Bounded)++data JointType+ = Ball+ | Hinge+ | Slider+ | Contact+ | Universal+ | Hinge2+ | Fixed+ | AMotor+ deriving (Show,Eq,Ord)++data BodyIndex+ = First+ | Second+ deriving (Show,Eq,Ord)++data GeomClass+ = Sphere+ | Box+ | CappedCylinder+ | Cylinder+ | Plane+ | GeomTransform+ | Ray+ | TriangleMesh+ | SimpleSpace+ | HashSpace+ deriving (Show,Eq,Ord)++data RotationMode+ = Infinitesimal+ | Finite ODEreal ODEreal ODEreal+ deriving (Show,Eq,Ord)
+ src/Physics/ODE/Utilities.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE ParallelListComp #-}+module Physics.ODE.Utilities where++import Foreign++import Data.Array++forceFinalization :: ForeignPtr a -> IO ()+#ifdef __GLASGOW_HASKELL__+forceFinalization = finalizeForeignPtr+#else+forceFinalization _ = return ()+#endif++peekVector3 :: Storable a => Ptr a -> IO (a,a,a)+peekVector3 ptr+ = do [x,y,z] <- peekArray 3 ptr+ return (x,y,z)++pokeVector3 :: Storable a => Ptr a -> (a,a,a) -> IO ()+pokeVector3 ptr (x,y,z)+ = pokeArray ptr [x,y,z]++peekVector4 :: Storable a => Ptr a -> IO (a,a,a,a)+peekVector4 ptr+ = do [x,y,z,n] <- peekArray 4 ptr+ return (x,y,z,n)++peekMatrix :: Storable a => (Int,Int) -> Ptr a -> IO (Array (Int,Int) a)+peekMatrix (x,y) ptr+ = do elts <- peekArray (x*y) ptr+ return (array ((0,0),(x,y)) [((a,b),e) | e <- elts | a <- [0..x-1], b <- [0..y-1]])
+ src/Physics/ODE/World.hs view
@@ -0,0 +1,56 @@+module Physics.ODE.World+ (create, destroyWorld, setGravity, getGravity, closeODE, step,+ quickStep, setContactSurfaceLayer, getContactSurfaceLayer)+ where+import Foreign+import Physics.ODE.Types+import Physics.ODE.Utilities+ +foreign import ccall unsafe "dCloseODE" closeODE :: IO ()+create :: IO World+create = do ret_0 <- createdWorldCreate+ return (ret_0)+foreign import ccall unsafe "dWorldCreate" createdWorldCreate :: IO World+destroyWorld :: World -> IO ()+destroyWorld = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- destroyWorlddWorldDestroy marshaledArg_2+ case () of+ () -> do return ())+foreign import ccall unsafe "dWorldDestroy" destroyWorlddWorldDestroy :: World ->+ IO ()+setGravity :: World -> ODEreal -> ODEreal -> ODEreal -> IO ()+setGravity = \arg_0 arg_1 arg_2 arg_3 -> (\action_4 -> action_4 arg_0) (\marshaledArg_5 -> (\action_6 -> action_6 arg_1) (\marshaledArg_7 -> (\action_8 -> action_8 arg_2) (\marshaledArg_9 -> (\action_10 -> action_10 arg_3) (\marshaledArg_11 -> do ret_12 <- setGravitydWorldSetGravity marshaledArg_5 marshaledArg_7 marshaledArg_9 marshaledArg_11+ case () of+ () -> do return ()))))+foreign import ccall unsafe "dWorldSetGravity" setGravitydWorldSetGravity :: World ->+ ODEreal ->+ ODEreal ->+ ODEreal -> IO ()+getGravity :: World -> IO ((ODEreal, ODEreal, ODEreal))+getGravity = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> allocaArray 4 (\marshaledArg_3 -> do ret_4 <- getGravitydWorldGetGravity marshaledArg_2 marshaledArg_3+ peekVector3 (marshaledArg_3)))+foreign import ccall unsafe "dWorldGetGravity" getGravitydWorldGetGravity :: World ->+ Ptr ODEreal -> IO ()+step :: World -> ODEreal -> IO ()+step = \arg_0 arg_1 -> (\action_2 -> action_2 arg_0) (\marshaledArg_3 -> (\action_4 -> action_4 arg_1) (\marshaledArg_5 -> do ret_6 <- stepdWorldStep marshaledArg_3 marshaledArg_5+ case () of+ () -> do return ()))+foreign import ccall unsafe "dWorldStep" stepdWorldStep :: World ->+ ODEreal -> IO ()+quickStep :: World -> ODEreal -> IO ()+quickStep = \arg_0 arg_1 -> (\action_2 -> action_2 arg_0) (\marshaledArg_3 -> (\action_4 -> action_4 arg_1) (\marshaledArg_5 -> do ret_6 <- quickStepdWorldQuickStep marshaledArg_3 marshaledArg_5+ case () of+ () -> do return ()))+foreign import ccall unsafe "dWorldQuickStep" quickStepdWorldQuickStep :: World ->+ ODEreal -> IO ()+setContactSurfaceLayer :: World -> ODEreal -> IO ()+setContactSurfaceLayer = \arg_0 arg_1 -> (\action_2 -> action_2 arg_0) (\marshaledArg_3 -> (\action_4 -> action_4 arg_1) (\marshaledArg_5 -> do ret_6 <- setContactSurfaceLayerdWorldSetContactSurfaceLayer marshaledArg_3 marshaledArg_5+ case () of+ () -> do return ()))+foreign import ccall unsafe "dWorldSetContactSurfaceLayer" setContactSurfaceLayerdWorldSetContactSurfaceLayer :: World ->+ ODEreal ->+ IO ()+getContactSurfaceLayer :: World -> IO ODEreal+getContactSurfaceLayer = \arg_0 -> (\action_1 -> action_1 arg_0) (\marshaledArg_2 -> do ret_3 <- getContactSurfaceLayerdWorldGetContactSurfaceLayer marshaledArg_2+ return (ret_3))+foreign import ccall unsafe "dWorldGetContactSurfaceLayer" getContactSurfaceLayerdWorldGetContactSurfaceLayer :: World ->+ IO ODEreal
+ src/Physics/ODE/World.th view
@@ -0,0 +1,41 @@+module Physics.ODE.World+ ( create+ , destroyWorld+ , setGravity+ , getGravity+ , closeODE+ , step+ , quickStep+ , setContactSurfaceLayer+ , getContactSurfaceLayer+ ) where++import Foreign++import Physics.ODE.Types+import Physics.ODE.Utilities++#ifdef HASTH+import Foreign.HacanonLight.DIS+import Foreign.HacanonLight.Generate+import Physics.ODE.DIS+#endif++$(bind "create" "dWorldCreate" [world])++$(bind "destroyWorld" "dWorldDestroy" [world,unit])++$(bind "setGravity" "dWorldSetGravity" [world,ode,ode,ode,unit])++$(bind "getGravity" "dWorldGetGravity" [world,vector3Out,unit])++foreign import ccall unsafe "dCloseODE" closeODE :: IO ()++$(bind "step" "dWorldStep" [world,ode,unit])++$(bind "quickStep" "dWorldQuickStep" [world,ode,unit])++$(bind "setContactSurfaceLayer" "dWorldSetContactSurfaceLayer" [world,ode,unit])++$(bind "getContactSurfaceLayer" "dWorldGetContactSurfaceLayer" [world,ode])+