Geom.th

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])