-- GENERATED by C->Haskell Compiler, version 0.28.3 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Chiphunk/Low/Arbiter.chs" #-}
module Chiphunk.Low.Arbiter
  ( Arbiter
  , arbiterRestitution
  , arbiterFriction
  , arbiterSurfaceVelocity
  , arbiterUserData
  , arbiterCount
  , arbiterNormal
  , arbiterPointA
  , arbiterPointB
  , arbiterDepth
  , arbiterIsFirstContact
  , arbiterIsRemoval
  , arbiterShapes
  , arbiterBodies
  , arbiterCallWildcardBeginA
  , arbiterCallWildcardBeginB
  , arbiterCallWildcardPreSolveA
  , arbiterCallWildcardPreSolveB
  , arbiterCallWildcardPostSolveA
  , arbiterCallWildcardPostSolveB
  , arbiterCallWildcardSeparateA
  , arbiterCallWildcardSeparateB
  ) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified Foreign.Ptr as C2HSImp



import Data.StateVar
import Foreign

import Chiphunk.Low.Types
{-# LINE 29 "src/Chiphunk/Low/Arbiter.chs" #-}





cpArbiterGetRestitution :: (Arbiter) -> IO ((Double))
cpArbiterGetRestitution a1 =
  let {a1' = id a1} in 
  cpArbiterGetRestitution'_ a1' >>= \res ->
  let {res' = realToFrac res} in
  return (res')

{-# LINE 34 "src/Chiphunk/Low/Arbiter.chs" #-}


cpArbiterSetRestitution :: (Arbiter) -> (Double) -> IO ()
cpArbiterSetRestitution a1 a2 =
  let {a1' = id a1} in 
  let {a2' = realToFrac a2} in 
  cpArbiterSetRestitution'_ a1' a2' >>
  return ()

{-# LINE 36 "src/Chiphunk/Low/Arbiter.chs" #-}


-- | The calculated elasticity for this collision pair.
-- Setting the value in a preSolve() callback will override the value calculated by the space.
-- The default calculation multiplies the elasticity of the two shapes together.
arbiterRestitution :: Arbiter -> StateVar Double
arbiterRestitution = mkStateVar cpArbiterGetRestitution cpArbiterSetRestitution

cpArbiterGetFriction :: (Arbiter) -> IO ((Double))
cpArbiterGetFriction :: Arbiter -> IO Double
cpArbiterGetFriction Arbiter
a1 =
  let {a1' :: Arbiter
a1' = Arbiter -> Arbiter
forall a. a -> a
id Arbiter
a1} in 
  Arbiter -> IO CDouble
cpArbiterGetFriction'_ Arbiter
a1' IO CDouble -> (CDouble -> IO Double) -> IO Double
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CDouble
res ->
  let {res' :: Double
res' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
res} in
  Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
res')

{-# LINE 44 "src/Chiphunk/Low/Arbiter.chs" #-}


cpArbiterSetFriction :: (Arbiter) -> (Double) -> IO ()
cpArbiterSetFriction a1 a2 =
  let {a1' = id a1} in 
  let {a2' = realToFrac a2} in 
  cpArbiterSetFriction'_ a1' a2' >>
  return ()

{-# LINE 46 "src/Chiphunk/Low/Arbiter.chs" #-}


-- | The calculated friction for this collision pair.
-- Setting the value in a preSolve() callback will override the value calculated by the space.
-- The default calculation multiplies the friction of the two shapes together.
arbiterFriction :: Arbiter -> StateVar Double
arbiterFriction = mkStateVar cpArbiterGetFriction cpArbiterSetFriction

w_cpArbiterGetSurfaceVelocity :: (Arbiter) -> IO ((Vect))
w_cpArbiterGetSurfaceVelocity :: Arbiter -> IO Vect
w_cpArbiterGetSurfaceVelocity Arbiter
a1 =
  let {a1' :: Arbiter
a1' = Arbiter -> Arbiter
forall a. a -> a
id Arbiter
a1} in 
  (Ptr Vect -> IO Vect) -> IO Vect
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Vect -> IO Vect) -> IO Vect)
-> (Ptr Vect -> IO Vect) -> IO Vect
forall a b. (a -> b) -> a -> b
$ \Ptr Vect
a2' -> 
  Arbiter -> Ptr Vect -> IO ()
w_cpArbiterGetSurfaceVelocity'_ Arbiter
a1' Ptr Vect
a2' IO () -> IO Vect -> IO Vect
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  Ptr Vect -> IO Vect
forall a. Storable a => Ptr a -> IO a
peek  Ptr Vect
a2'IO Vect -> (Vect -> IO Vect) -> IO Vect
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Vect
a2'' -> 
  Vect -> IO Vect
forall (m :: * -> *) a. Monad m => a -> m a
return (Vect
a2'')

{-# LINE 54 "src/Chiphunk/Low/Arbiter.chs" #-}


cpArbiterSetSurfaceVelocity :: (Arbiter) -> (Vect) -> IO ()
cpArbiterSetSurfaceVelocity a1 a2 =
  let {a1' = id a1} in 
  with a2 $ \a2' -> 
  cpArbiterSetSurfaceVelocity'_ a1' a2' >>
  return ()

{-# LINE 56 "src/Chiphunk/Low/Arbiter.chs" #-}


-- | The calculated surface velocity for this collision pair.
-- Setting the value in a preSolve() callback will override the value calculated by the space.
-- The default calculation subtracts the surface velocity of the second shape
-- from the first and then projects that onto the tangent of the collision.
-- This is so that only friction is affected by default calculation.
--
-- Using a custom calculation, you can make something that responds like a pinball bumper,
-- or where the surface velocity is dependent on the location of the contact point.
arbiterSurfaceVelocity :: Arbiter -> StateVar Vect
arbiterSurfaceVelocity :: Arbiter -> StateVar Vect
arbiterSurfaceVelocity = (Arbiter -> IO Vect)
-> (Arbiter -> Vect -> IO ()) -> Arbiter -> StateVar Vect
forall a b. (a -> IO b) -> (a -> b -> IO ()) -> a -> StateVar b
mkStateVar Arbiter -> IO Vect
w_cpArbiterGetSurfaceVelocity Arbiter -> Vect -> IO ()
cpArbiterSetSurfaceVelocity

cpArbiterGetUserData :: (Arbiter) -> IO ((DataPtr))
cpArbiterGetUserData :: Arbiter -> IO DataPtr
cpArbiterGetUserData Arbiter
a1 =
  let {a1' :: Arbiter
a1' = Arbiter -> Arbiter
forall a. a -> a
id Arbiter
a1} in 
  Arbiter -> IO DataPtr
cpArbiterGetUserData'_ Arbiter
a1' IO DataPtr -> (DataPtr -> IO DataPtr) -> IO DataPtr
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \DataPtr
res ->
  let {res' :: DataPtr
res' = DataPtr -> DataPtr
forall a. a -> a
id DataPtr
res} in
  DataPtr -> IO DataPtr
forall (m :: * -> *) a. Monad m => a -> m a
return (DataPtr
res')

{-# LINE 69 "src/Chiphunk/Low/Arbiter.chs" #-}


cpArbiterSetUserData :: (Arbiter) -> (DataPtr) -> IO ()
cpArbiterSetUserData a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  cpArbiterSetUserData'_ a1' a2' >>
  return ()

{-# LINE 71 "src/Chiphunk/Low/Arbiter.chs" #-}


-- | A user definable context pointer.
-- The value will persist until just after the separate callback is called for the pair.
--
-- __Note__: If you need to clean up this pointer, you should implement the separate callback to do it.
-- Also be careful when destroying the space as there may be active collisions still.
-- In order to trigger the separate callbacks and clean up your data,
-- you’ll need to remove all the shapes from the space before disposing of it.
-- This is something I’d suggest doing anyway.
-- See ChipmunkDemo.c:ChipmunkDemoFreeSpaceChildren() for an example of how to do it easily.
arbiterUserData :: Arbiter -> StateVar DataPtr
arbiterUserData :: Arbiter -> StateVar DataPtr
arbiterUserData = (Arbiter -> IO DataPtr)
-> (Arbiter -> DataPtr -> IO ()) -> Arbiter -> StateVar DataPtr
forall a b. (a -> IO b) -> (a -> b -> IO ()) -> a -> StateVar b
mkStateVar Arbiter -> IO DataPtr
cpArbiterGetUserData Arbiter -> DataPtr -> IO ()
cpArbiterSetUserData

cpArbiterGetCount :: (Arbiter) -> IO ((Int))
cpArbiterGetCount :: Arbiter -> IO Int
cpArbiterGetCount Arbiter
a1 =
  let {a1' :: Arbiter
a1' = Arbiter -> Arbiter
forall a. a -> a
id Arbiter
a1} in 
  Arbiter -> IO CInt
cpArbiterGetCount'_ Arbiter
a1' IO CInt -> (CInt -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Int
res' = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res} in
  return (res')

{-# LINE 85 "src/Chiphunk/Low/Arbiter.chs" #-}


-- | The number of contacts tracked by this arbiter.
-- For the forseeable future, the maximum number of contacts will be two.
arbiterCount :: Arbiter -> GettableStateVar Int
arbiterCount = makeGettableStateVar . cpArbiterGetCount

w_cpArbiterGetNormal :: (Arbiter) -> IO ((Vect))
w_cpArbiterGetNormal :: Arbiter -> IO Vect
w_cpArbiterGetNormal Arbiter
a1 =
  let {a1' :: Arbiter
a1' = Arbiter -> Arbiter
forall a. a -> a
id Arbiter
a1} in 
  (Ptr Vect -> IO Vect) -> IO Vect
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Vect -> IO Vect) -> IO Vect)
-> (Ptr Vect -> IO Vect) -> IO Vect
forall a b. (a -> b) -> a -> b
$ \Ptr Vect
a2' -> 
  Arbiter -> Ptr Vect -> IO ()
w_cpArbiterGetNormal'_ Arbiter
a1' Ptr Vect
a2' IO () -> IO Vect -> IO Vect
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  Ptr Vect -> IO Vect
forall a. Storable a => Ptr a -> IO a
peek  Ptr Vect
a2'IO Vect -> (Vect -> IO Vect) -> IO Vect
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Vect
a2'' -> 
  Vect -> IO Vect
forall (m :: * -> *) a. Monad m => a -> m a
return (Vect
a2'')

{-# LINE 92 "src/Chiphunk/Low/Arbiter.chs" #-}


-- | Collision normal in a specific point tracked by this collision.
arbiterNormal :: Arbiter -> GettableStateVar Vect
arbiterNormal = makeGettableStateVar . w_cpArbiterGetNormal

w_cpArbiterGetPointA :: (Arbiter) -> (Int) -> IO ((Vect))
w_cpArbiterGetPointA a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  alloca $ \a3' -> 
  w_cpArbiterGetPointA'_ a1' a2' a3' >>
  peek  a3'>>= \a3'' -> 
  return (a3'')

{-# LINE 98 "src/Chiphunk/Low/Arbiter.chs" #-}


-- | Collision point of a specific point on first body.
arbiterPointA :: Arbiter -> Int -> GettableStateVar Vect
arbiterPointA arbiter = makeGettableStateVar . w_cpArbiterGetPointA arbiter

w_cpArbiterGetPointB :: (Arbiter) -> (Int) -> IO ((Vect))
w_cpArbiterGetPointB a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  alloca $ \a3' -> 
  w_cpArbiterGetPointB'_ a1' a2' a3' >>
  peek  a3'>>= \a3'' -> 
  return (a3'')

{-# LINE 104 "src/Chiphunk/Low/Arbiter.chs" #-}


-- | Collision point of a specific point on second body.
arbiterPointB :: Arbiter -> Int -> GettableStateVar Vect
arbiterPointB arbiter = makeGettableStateVar . w_cpArbiterGetPointB arbiter

cpArbiterGetDepth :: (Arbiter) -> (Int) -> IO ((Double))
cpArbiterGetDepth a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  cpArbiterGetDepth'_ a1' a2' >>= \res ->
  let {res' = realToFrac res} in
  return (res')

{-# LINE 110 "src/Chiphunk/Low/Arbiter.chs" #-}


-- | Penetration depth of a collision point.
arbiterDepth :: Arbiter -> Int -> GettableStateVar Double
arbiterDepth arbiter = makeGettableStateVar . cpArbiterGetDepth arbiter

-- | Returns true if this is the first step the two shapes started touching. This can be useful for sound effects
-- for instance. If its the first frame for a certain collision, check the energy of the collision in a postStep
-- callbock and use that to determine the volume of a sound effect to play.
arbiterIsFirstContact :: (Arbiter) -> IO ((Bool))
arbiterIsFirstContact :: Arbiter -> IO Bool
arbiterIsFirstContact Arbiter
a1 =
  let {a1' :: Arbiter
a1' = Arbiter -> Arbiter
forall a. a -> a
id Arbiter
a1} in 
  Arbiter -> IO CUChar
arbiterIsFirstContact'_ Arbiter
a1' IO CUChar -> (CUChar -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CUChar
res ->
  let {res' :: Bool
res' = CUChar -> Bool
forall a. (Eq a, Num a) => a -> Bool
C2HSImp.toBool CUChar
res} in
  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
res')

{-# LINE 119 "src/Chiphunk/Low/Arbiter.chs" #-}


-- | Returns 'True' during a separate callback if the callback was invoked due to an object removal.
arbiterIsRemoval :: (Arbiter) -> IO ((Bool))
arbiterIsRemoval a1 =
  let {a1' = id a1} in 
  arbiterIsRemoval'_ a1' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 122 "src/Chiphunk/Low/Arbiter.chs" #-}


cpArbiterGetShapes :: (Arbiter) -> IO ((Shape), (Shape))
cpArbiterGetShapes a1 =
  let {a1' = id a1} in 
  alloca $ \a2' -> 
  alloca $ \a3' -> 
  cpArbiterGetShapes'_ a1' a2' a3' >>
  peek  a2'>>= \a2'' -> 
  peek  a3'>>= \a3'' -> 
  return (a2'', a3'')

{-# LINE 128 "src/Chiphunk/Low/Arbiter.chs" #-}


-- | The colliding shapes in the order that they were defined in the collision handler
-- associated with this arbiter.
-- If you defined the handler as cpSpaceAddCollisionHandler(space, 1, 2, ...),
-- you you will find that a->collision_type == 1 and b->collision_type == 2.
arbiterShapes :: Arbiter -> GettableStateVar (Shape, Shape)
arbiterShapes :: Arbiter -> IO (Shape, Shape)
arbiterShapes = IO (Shape, Shape) -> IO (Shape, Shape)
forall a. IO a -> IO a
makeGettableStateVar (IO (Shape, Shape) -> IO (Shape, Shape))
-> (Arbiter -> IO (Shape, Shape)) -> Arbiter -> IO (Shape, Shape)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arbiter -> IO (Shape, Shape)
cpArbiterGetShapes

cpArbiterGetBodies :: (Arbiter) -> IO ((Body), (Body))
cpArbiterGetBodies :: Arbiter -> IO (Body, Body)
cpArbiterGetBodies Arbiter
a1 =
  let {a1' :: Arbiter
a1' = Arbiter -> Arbiter
forall a. a -> a
id Arbiter
a1} in 
  (Ptr Body -> IO (Body, Body)) -> IO (Body, Body)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Body -> IO (Body, Body)) -> IO (Body, Body))
-> (Ptr Body -> IO (Body, Body)) -> IO (Body, Body)
forall a b. (a -> b) -> a -> b
$ \Ptr Body
a2' -> 
  (Ptr Body -> IO (Body, Body)) -> IO (Body, Body)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Body -> IO (Body, Body)) -> IO (Body, Body))
-> (Ptr Body -> IO (Body, Body)) -> IO (Body, Body)
forall a b. (a -> b) -> a -> b
$ \Ptr Body
a3' -> 
  Arbiter -> Ptr Body -> Ptr Body -> IO ()
cpArbiterGetBodies'_ Arbiter
a1' Ptr Body
a2' Ptr Body
a3' IO () -> IO Body -> IO Body
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  Ptr Body -> IO Body
forall a. Storable a => Ptr a -> IO a
peek  Ptr Body
a2'IO Body -> (Body -> IO (Body, Body)) -> IO (Body, Body)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Body
a2'' -> 
  Ptr Body -> IO Body
forall a. Storable a => Ptr a -> IO a
peek  Ptr Body
a3'IO Body -> (Body -> IO (Body, Body)) -> IO (Body, Body)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Body
a3'' -> 
  (Body, Body) -> IO (Body, Body)
forall (m :: * -> *) a. Monad m => a -> m a
return (Body
a2'', Body
a3'')

{-# LINE 141 "src/Chiphunk/Low/Arbiter.chs" #-}


-- | The colliding bodies in the order that they were defined in the collision handler
-- associated with this arbiter.
-- If you defined the handler as cpSpaceAddCollisionHandler(space, 1, 2, ...),
-- you you will find that a->collision_type == 1 and b->collision_type == 2.
arbiterBodies :: Arbiter -> GettableStateVar (Body, Body)
arbiterBodies :: Arbiter -> IO (Body, Body)
arbiterBodies = IO (Body, Body) -> IO (Body, Body)
forall a. IO a -> IO a
makeGettableStateVar (IO (Body, Body) -> IO (Body, Body))
-> (Arbiter -> IO (Body, Body)) -> Arbiter -> IO (Body, Body)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arbiter -> IO (Body, Body)
cpArbiterGetBodies

-- | Run begin wildcard callback for first body.
arbiterCallWildcardBeginA :: (Arbiter) -> (Space) -> IO ((Bool))
arbiterCallWildcardBeginA :: Arbiter -> Space -> IO Bool
arbiterCallWildcardBeginA Arbiter
a1 Space
a2 =
  let {a1' :: Arbiter
a1' = Arbiter -> Arbiter
forall a. a -> a
id Arbiter
a1} in 
  let {a2' :: Space
a2' = Space -> Space
forall a. a -> a
id Space
a2} in 
  Arbiter -> Space -> IO CUChar
arbiterCallWildcardBeginA'_ Arbiter
a1' Space
a2' IO CUChar -> (CUChar -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CUChar
res ->
  let {res' :: Bool
res' = CUChar -> Bool
forall a. (Eq a, Num a) => a -> Bool
C2HSImp.toBool CUChar
res} in
  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
res')

{-# LINE 151 "src/Chiphunk/Low/Arbiter.chs" #-}


-- | Run begin wildcard callback for second body.
arbiterCallWildcardBeginB :: (Arbiter) -> (Space) -> IO ((Bool))
arbiterCallWildcardBeginB a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  arbiterCallWildcardBeginB'_ a1' a2' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 154 "src/Chiphunk/Low/Arbiter.chs" #-}


-- | Run preSolve wildcard callback for first body.
arbiterCallWildcardPreSolveA :: (Arbiter) -> (Space) -> IO ((Bool))
arbiterCallWildcardPreSolveA a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  arbiterCallWildcardPreSolveA'_ a1' a2' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 157 "src/Chiphunk/Low/Arbiter.chs" #-}


-- | Run preSolve wildcard callback for second body.
arbiterCallWildcardPreSolveB :: (Arbiter) -> (Space) -> IO ((Bool))
arbiterCallWildcardPreSolveB a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  arbiterCallWildcardPreSolveB'_ a1' a2' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 160 "src/Chiphunk/Low/Arbiter.chs" #-}


-- | Run postSolve wildcard callback for first body.
arbiterCallWildcardPostSolveA :: (Arbiter) -> (Space) -> IO ()
arbiterCallWildcardPostSolveA a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  arbiterCallWildcardPostSolveA'_ a1' a2' >>
  return ()

{-# LINE 163 "src/Chiphunk/Low/Arbiter.chs" #-}


-- | Run postSolve wildcard callback for second body.
arbiterCallWildcardPostSolveB :: (Arbiter) -> (Space) -> IO ()
arbiterCallWildcardPostSolveB a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  arbiterCallWildcardPostSolveB'_ a1' a2' >>
  return ()

{-# LINE 166 "src/Chiphunk/Low/Arbiter.chs" #-}


-- | Run separate wildcard callback for first body.
arbiterCallWildcardSeparateA :: (Arbiter) -> (Space) -> IO ()
arbiterCallWildcardSeparateA a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  arbiterCallWildcardSeparateA'_ a1' a2' >>
  return ()

{-# LINE 169 "src/Chiphunk/Low/Arbiter.chs" #-}


-- | Run separate wildcard callback for second body.
arbiterCallWildcardSeparateB :: (Arbiter) -> (Space) -> IO ()
arbiterCallWildcardSeparateB a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  arbiterCallWildcardSeparateB'_ a1' a2' >>
  return ()

{-# LINE 172 "src/Chiphunk/Low/Arbiter.chs" #-}


foreign import ccall unsafe "Chiphunk/Low/Arbiter.chs.h cpArbiterGetRestitution"
  cpArbiterGetRestitution'_ :: ((Arbiter) -> (IO C2HSImp.CDouble))

foreign import ccall unsafe "Chiphunk/Low/Arbiter.chs.h cpArbiterSetRestitution"
  cpArbiterSetRestitution'_ :: ((Arbiter) -> (C2HSImp.CDouble -> (IO ())))

foreign import ccall unsafe "Chiphunk/Low/Arbiter.chs.h cpArbiterGetFriction"
  cpArbiterGetFriction'_ :: ((Arbiter) -> (IO C2HSImp.CDouble))

foreign import ccall unsafe "Chiphunk/Low/Arbiter.chs.h cpArbiterSetFriction"
  cpArbiterSetFriction'_ :: ((Arbiter) -> (C2HSImp.CDouble -> (IO ())))

foreign import ccall unsafe "Chiphunk/Low/Arbiter.chs.h w_cpArbiterGetSurfaceVelocity"
  w_cpArbiterGetSurfaceVelocity'_ :: ((Arbiter) -> ((VectPtr) -> (IO ())))

foreign import ccall unsafe "Chiphunk/Low/Arbiter.chs.h __c2hs_wrapped__cpArbiterSetSurfaceVelocity"
  cpArbiterSetSurfaceVelocity'_ :: ((Arbiter) -> ((VectPtr) -> (IO ())))

foreign import ccall unsafe "Chiphunk/Low/Arbiter.chs.h cpArbiterGetUserData"
  cpArbiterGetUserData'_ :: ((Arbiter) -> (IO (DataPtr)))

foreign import ccall unsafe "Chiphunk/Low/Arbiter.chs.h cpArbiterSetUserData"
  cpArbiterSetUserData'_ :: ((Arbiter) -> ((DataPtr) -> (IO ())))

foreign import ccall unsafe "Chiphunk/Low/Arbiter.chs.h cpArbiterGetCount"
  cpArbiterGetCount'_ :: ((Arbiter) -> (IO C2HSImp.CInt))

foreign import ccall unsafe "Chiphunk/Low/Arbiter.chs.h w_cpArbiterGetNormal"
  w_cpArbiterGetNormal'_ :: ((Arbiter) -> ((VectPtr) -> (IO ())))

foreign import ccall unsafe "Chiphunk/Low/Arbiter.chs.h w_cpArbiterGetPointA"
  w_cpArbiterGetPointA'_ :: ((Arbiter) -> (C2HSImp.CInt -> ((VectPtr) -> (IO ()))))

foreign import ccall unsafe "Chiphunk/Low/Arbiter.chs.h w_cpArbiterGetPointB"
  w_cpArbiterGetPointB'_ :: ((Arbiter) -> (C2HSImp.CInt -> ((VectPtr) -> (IO ()))))

foreign import ccall unsafe "Chiphunk/Low/Arbiter.chs.h cpArbiterGetDepth"
  cpArbiterGetDepth'_ :: ((Arbiter) -> (C2HSImp.CInt -> (IO C2HSImp.CDouble)))

foreign import ccall unsafe "Chiphunk/Low/Arbiter.chs.h cpArbiterIsFirstContact"
  arbiterIsFirstContact'_ :: ((Arbiter) -> (IO C2HSImp.CUChar))

foreign import ccall unsafe "Chiphunk/Low/Arbiter.chs.h cpArbiterIsRemoval"
  arbiterIsRemoval'_ :: ((Arbiter) -> (IO C2HSImp.CUChar))

foreign import ccall unsafe "Chiphunk/Low/Arbiter.chs.h cpArbiterGetShapes"
  cpArbiterGetShapes'_ :: ((Arbiter) -> ((C2HSImp.Ptr (Shape)) -> ((C2HSImp.Ptr (Shape)) -> (IO ()))))

foreign import ccall unsafe "Chiphunk/Low/Arbiter.chs.h cpArbiterGetBodies"
  cpArbiterGetBodies'_ :: ((Arbiter) -> ((C2HSImp.Ptr (Body)) -> ((C2HSImp.Ptr (Body)) -> (IO ()))))

foreign import ccall safe "Chiphunk/Low/Arbiter.chs.h cpArbiterCallWildcardBeginA"
  arbiterCallWildcardBeginA'_ :: ((Arbiter) -> ((Space) -> (IO C2HSImp.CUChar)))

foreign import ccall safe "Chiphunk/Low/Arbiter.chs.h cpArbiterCallWildcardBeginB"
  arbiterCallWildcardBeginB'_ :: ((Arbiter) -> ((Space) -> (IO C2HSImp.CUChar)))

foreign import ccall safe "Chiphunk/Low/Arbiter.chs.h cpArbiterCallWildcardPreSolveA"
  arbiterCallWildcardPreSolveA'_ :: ((Arbiter) -> ((Space) -> (IO C2HSImp.CUChar)))

foreign import ccall safe "Chiphunk/Low/Arbiter.chs.h cpArbiterCallWildcardPreSolveB"
  arbiterCallWildcardPreSolveB'_ :: ((Arbiter) -> ((Space) -> (IO C2HSImp.CUChar)))

foreign import ccall safe "Chiphunk/Low/Arbiter.chs.h cpArbiterCallWildcardPostSolveA"
  arbiterCallWildcardPostSolveA'_ :: ((Arbiter) -> ((Space) -> (IO ())))

foreign import ccall safe "Chiphunk/Low/Arbiter.chs.h cpArbiterCallWildcardPostSolveB"
  arbiterCallWildcardPostSolveB'_ :: ((Arbiter) -> ((Space) -> (IO ())))

foreign import ccall safe "Chiphunk/Low/Arbiter.chs.h cpArbiterCallWildcardSeparateA"
  arbiterCallWildcardSeparateA'_ :: ((Arbiter) -> ((Space) -> (IO ())))

foreign import ccall safe "Chiphunk/Low/Arbiter.chs.h cpArbiterCallWildcardSeparateB"
  arbiterCallWildcardSeparateB'_ :: ((Arbiter) -> ((Space) -> (IO ())))