-- 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/Body.chs" #-}
-- | Description: Rigid bodies manipulations
-- Module provides access to the rigid bodies which are at the core of the physics simulation.
module Chiphunk.Low.Body
  ( Body
  , BodyType (..)
  , bodyNew
  , bodyNewKinematic
  , bodyNewStatic
  , bodyFree
  , bodyType
  , bodyMass
  , bodyMoment
  , bodyPosition
  , bodyCenterOfGravity
  , bodyVelocity
  , bodyForce
  , bodyAngle
  , bodyAngularVelocity
  , bodyTorque
  , bodyRotation
  , bodySpace
  , bodyUserData
  , bodyLocalToWorld
  , bodyWorldToLocal
  , bodyVelocityAtWorldPoint
  , bodyVelocityAtLocalPoint
  , bodyApplyForceAtWorldPoint
  , bodyApplyForceAtLocalPoint
  , bodyApplyImpulseAtWorldPoint
  , bodyApplyImpulseAtLocalPoint
  , bodyIsSleeping
  , bodyActivate
  , bodySleep
  , bodyActivateStatic
  , bodySleepWithGroup
  , BodyShapeIteratorFunc
  , bodyEachShape
  , BodyConstraintIteratorFunc
  , bodyEachConstraint
  , BodyArbiterIteratorFunc
  , bodyEachArbiter
  ) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified Foreign.Ptr as C2HSImp



import Chiphunk.Low.Vect
import Control.Exception.Safe
import Data.StateVar
import Foreign

import Chiphunk.Low.Types
{-# LINE 49 "src/Chiphunk/Low/Body.chs" #-}





-- | Creates body of type 'BodyTypeDynamic'.
bodyNew :: (Double) -- ^ Mass of the body. Guessing is usually fine.
 -> (Double) -- ^ Moment of inertia of the body.  Guessing a moment of inertia can lead to a very poor simulation  so it’s recommended to use Chipmunk’s moment calculations  to estimate the moment for you.
 -> IO ((Body))
bodyNew a1 a2 =
  let {a1' = realToFrac a1} in
  let {a2' = realToFrac a2} in
  bodyNew'_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 62 "src/Chiphunk/Low/Body.chs" #-}


-- | Create body of type 'BodyTypeKimenatic'.
bodyNewKinematic :: IO ((Body))
bodyNewKinematic =
  bodyNewKinematic'_ >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 65 "src/Chiphunk/Low/Body.chs" #-}


-- | Create body of type 'BodyTypeStatic'.
bodyNewStatic :: IO ((Body))
bodyNewStatic =
  bodyNewStatic'_ >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 68 "src/Chiphunk/Low/Body.chs" #-}


-- | Be careful not to free a body before any shapes or constraints attached to it
-- have been removed from a space.
bodyFree :: (Body) -> IO ()
bodyFree a1 =
  let {a1' = id a1} in
  bodyFree'_ a1' >>
  return ()

{-# LINE 72 "src/Chiphunk/Low/Body.chs" #-}

-- no "unsafe" qualifier because I think it may trigger callbacks

-- | Get the type of a body (dynamic, kinematic, static).
cpBodyGetType :: (Body) -> IO ((BodyType))
cpBodyGetType a1 =
  let {a1' = id a1} in
  cpBodyGetType'_ a1' >>= \res ->
  let {res' = (toEnum . fromIntegral) res} in
  return (res')

{-# LINE 76 "src/Chiphunk/Low/Body.chs" #-}


cpBodySetType :: (Body) -> (BodyType) -> IO ()
cpBodySetType a1 a2 =
  let {a1' = id a1} in
  let {a2' = (fromIntegral . fromEnum) a2} in
  cpBodySetType'_ a1' a2' >>
  return ()

{-# LINE 78 "src/Chiphunk/Low/Body.chs" #-}


-- | Type of a body (dynamic, kinematic, static).
-- When changing an body to a dynamic body, the mass and moment of inertia
-- are recalculated from the shapes added to the body.
-- Custom calculated moments of inertia are not preseved when changing types.
-- This function cannot be called directly in a collision callback.
bodyType :: Body -> StateVar BodyType
bodyType = mkStateVar cpBodyGetType cpBodySetType

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

{-# LINE 88 "src/Chiphunk/Low/Body.chs" #-}


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

{-# LINE 90 "src/Chiphunk/Low/Body.chs" #-}


-- | Mass of the body.
bodyMass :: Body -> StateVar Double
bodyMass = mkStateVar cpBodyGetMass cpBodySetMass

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

{-# LINE 96 "src/Chiphunk/Low/Body.chs" #-}


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

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


-- | Moment of inertia (MoI or sometimes just moment) of the body.
-- The moment is like the rotational mass of a body.
-- See below for function to help calculate the moment.
bodyMoment :: Body -> StateVar Double
bodyMoment = mkStateVar cpBodyGetMoment cpBodySetMoment

w_cpBodyGetPosition :: (Body) -> IO ((Vect))
w_cpBodyGetPosition a1 =
  let {a1' = id a1} in
  alloca $ \a2' ->
  w_cpBodyGetPosition'_ a1' a2' >>
  peek  a2'>>= \a2'' ->
  return (a2'')

{-# LINE 106 "src/Chiphunk/Low/Body.chs" #-}


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

{-# LINE 108 "src/Chiphunk/Low/Body.chs" #-}


-- | Position of the body. When changing the position you may also want to call
-- 'spaceReindexShapesForBody' to update the collision detection information
-- for the attached shapes if plan to make any queries against the space.
bodyPosition :: Body -> StateVar Vect
bodyPosition = mkStateVar w_cpBodyGetPosition cpBodySetPosition

w_cpBodyGetCenterOfGravity :: (Body) -> IO ((Vect))
w_cpBodyGetCenterOfGravity a1 =
  let {a1' = id a1} in
  alloca $ \a2' ->
  w_cpBodyGetCenterOfGravity'_ a1' a2' >>
  peek  a2'>>= \a2'' ->
  return (a2'')

{-# LINE 116 "src/Chiphunk/Low/Body.chs" #-}


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

{-# LINE 118 "src/Chiphunk/Low/Body.chs" #-}


-- | Location of the center of gravity in body local coordinates.
-- The default value is (0, 0), meaning the center of gravity
-- is the same as the position of the body.
bodyCenterOfGravity :: Body -> StateVar Vect
bodyCenterOfGravity = mkStateVar w_cpBodyGetCenterOfGravity cpBodySetCenterOfGravity

w_cpBodyGetVelocity :: (Body) -> IO ((Vect))
w_cpBodyGetVelocity a1 =
  let {a1' = id a1} in
  alloca $ \a2' ->
  w_cpBodyGetVelocity'_ a1' a2' >>
  peek  a2'>>= \a2'' ->
  return (a2'')

{-# LINE 126 "src/Chiphunk/Low/Body.chs" #-}


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

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


-- | Linear velocity of the center of gravity of the body.
bodyVelocity :: Body -> StateVar Vect
bodyVelocity = mkStateVar w_cpBodyGetVelocity cpBodySetVelocity

w_cpBodyGetForce :: (Body) -> IO ((Vect))
w_cpBodyGetForce a1 =
  let {a1' = id a1} in
  alloca $ \a2' ->
  w_cpBodyGetForce'_ a1' a2' >>
  peek  a2'>>= \a2'' ->
  return (a2'')

{-# LINE 134 "src/Chiphunk/Low/Body.chs" #-}


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

{-# LINE 136 "src/Chiphunk/Low/Body.chs" #-}


-- | Force applied to the center of gravity of the body.
-- This value is reset for every time step.
bodyForce :: Body -> StateVar Vect
bodyForce = mkStateVar w_cpBodyGetForce cpBodySetForce

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

{-# LINE 143 "src/Chiphunk/Low/Body.chs" #-}


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

{-# LINE 145 "src/Chiphunk/Low/Body.chs" #-}


-- | Set rotation of the body in radians.
-- When changing the rotation you may also want to call 'spaceReindexShapesForBody'
-- to update the collision detection information for the attached shapes
-- if you plan to make any queries against the space.
-- A body rotates around its center of gravity, not its position.
bodyAngle :: Body -> StateVar Double
bodyAngle = mkStateVar cpBodyGetAngle cpBodySetAngle

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

{-# LINE 155 "src/Chiphunk/Low/Body.chs" #-}


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

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


-- | Angular velocity of the body in radians per second.
bodyAngularVelocity :: Body -> StateVar Double
bodyAngularVelocity = mkStateVar cpBodyGetAngularVelocity cpBodySetAngularVelocity

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

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


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

{-# LINE 165 "src/Chiphunk/Low/Body.chs" #-}


-- | Torque applied to the body. This value is reset for every time step.
bodyTorque :: Body -> StateVar Double
bodyTorque = mkStateVar cpBodyGetTorque cpBodySetTorque

w_cpBodyGetRotation :: (Body) -> IO ((Vect))
w_cpBodyGetRotation a1 =
  let {a1' = id a1} in
  alloca $ \a2' ->
  w_cpBodyGetRotation'_ a1' a2' >>
  peek  a2'>>= \a2'' ->
  return (a2'')

{-# LINE 171 "src/Chiphunk/Low/Body.chs" #-}


-- | The rotation vector for the body.
-- Can be used with 'vRotate' or 'vUnRotate' to perform fast rotations.
bodyRotation :: Body -> GettableStateVar Vect
bodyRotation = makeGettableStateVar . w_cpBodyGetRotation

cpBodyGetSpace :: (Body) -> IO ((Space))
cpBodyGetSpace a1 =
  let {a1' = id a1} in
  cpBodyGetSpace'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 178 "src/Chiphunk/Low/Body.chs" #-}


-- | The 'Space' that body has been added to.
bodySpace :: Body -> GettableStateVar Space
bodySpace = makeGettableStateVar . cpBodyGetSpace

cpBodyGetUserData :: (Body) -> IO ((DataPtr))
cpBodyGetUserData a1 =
  let {a1' = id a1} in
  cpBodyGetUserData'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 184 "src/Chiphunk/Low/Body.chs" #-}


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

{-# LINE 186 "src/Chiphunk/Low/Body.chs" #-}


-- | User data pointer. Use this pointer to get a reference to the game object
-- that owns this body from callbacks.
bodyUserData :: Body -> StateVar DataPtr
bodyUserData = mkStateVar cpBodyGetUserData cpBodySetUserData

-- | Convert from body local coordinates to world space coordinates.
bodyLocalToWorld :: (Body) -> (Vect) -> IO ((Vect))
bodyLocalToWorld a1 a2 =
  let {a1' = id a1} in
  with a2 $ \a2' ->
  alloca $ \a3' ->
  bodyLocalToWorld'_ a1' a2' a3' >>
  peek  a3'>>= \a3'' ->
  return (a3'')

{-# LINE 194 "src/Chiphunk/Low/Body.chs" #-}


-- | Convert from world space coordinates to body local coordinates.
bodyWorldToLocal :: (Body) -> (Vect) -> IO ((Vect))
bodyWorldToLocal a1 a2 =
  let {a1' = id a1} in
  with a2 $ \a2' ->
  alloca $ \a3' ->
  bodyWorldToLocal'_ a1' a2' a3' >>
  peek  a3'>>= \a3'' ->
  return (a3'')

{-# LINE 197 "src/Chiphunk/Low/Body.chs" #-}


w_cpBodyGetVelocityAtWorldPoint :: (Body) -> (Vect) -> IO ((Vect))
w_cpBodyGetVelocityAtWorldPoint a1 a2 =
  let {a1' = id a1} in
  with a2 $ \a2' ->
  alloca $ \a3' ->
  w_cpBodyGetVelocityAtWorldPoint'_ a1' a2' a3' >>
  peek  a3'>>= \a3'' ->
  return (a3'')

{-# LINE 200 "src/Chiphunk/Low/Body.chs" #-}


-- | Absolute velocity of the rigid body at the given world point.
bodyVelocityAtWorldPoint :: Body -> Vect -> GettableStateVar Vect
bodyVelocityAtWorldPoint body = makeGettableStateVar . w_cpBodyGetVelocityAtWorldPoint body

w_cpBodyGetVelocityAtLocalPoint :: (Body) -> (Vect) -> IO ((Vect))
w_cpBodyGetVelocityAtLocalPoint a1 a2 =
  let {a1' = id a1} in
  with a2 $ \a2' ->
  alloca $ \a3' ->
  w_cpBodyGetVelocityAtLocalPoint'_ a1' a2' a3' >>
  peek  a3'>>= \a3'' ->
  return (a3'')

{-# LINE 207 "src/Chiphunk/Low/Body.chs" #-}


-- | Absolute velocity of the rigid body at the given body local point.
bodyVelocityAtLocalPoint :: Body -> Vect -> GettableStateVar Vect
bodyVelocityAtLocalPoint body = makeGettableStateVar . w_cpBodyGetVelocityAtLocalPoint body

-- | Add the @force@ to @body@ as if applied from the world @point@.
bodyApplyForceAtWorldPoint :: (Body) -- ^ body
 -> (Vect) -- ^ force
 -> (Vect) -- ^ point
 -> IO ()
bodyApplyForceAtWorldPoint a1 a2 a3 =
  let {a1' = id a1} in
  with a2 $ \a2' ->
  with a3 $ \a3' ->
  bodyApplyForceAtWorldPoint'_ a1' a2' a3' >>
  return ()

{-# LINE 218 "src/Chiphunk/Low/Body.chs" #-}


-- | Add the local @force@ to @body@ as if applied from the body local @point@.
bodyApplyForceAtLocalPoint :: (Body) -- ^ body
 -> (Vect) -- ^ force
 -> (Vect) -- ^ point
 -> IO ()
bodyApplyForceAtLocalPoint a1 a2 a3 =
  let {a1' = id a1} in
  with a2 $ \a2' ->
  with a3 $ \a3' ->
  bodyApplyForceAtLocalPoint'_ a1' a2' a3' >>
  return ()

{-# LINE 225 "src/Chiphunk/Low/Body.chs" #-}


-- | Add the @impulse@ to @body@ as if applied from the world @ point@.
bodyApplyImpulseAtWorldPoint :: (Body) -- ^ body
 -> (Vect) -- ^ impulse
 -> (Vect) -- ^ point
 -> IO ()
bodyApplyImpulseAtWorldPoint a1 a2 a3 =
  let {a1' = id a1} in
  with a2 $ \a2' ->
  with a3 $ \a3' ->
  bodyApplyImpulseAtWorldPoint'_ a1' a2' a3' >>
  return ()

{-# LINE 232 "src/Chiphunk/Low/Body.chs" #-}


-- | Add the local @impulse@ to @body@ as if applied from the body local @point@.
bodyApplyImpulseAtLocalPoint :: (Body) -- ^ body
 -> (Vect) -- ^ impulse
 -> (Vect) -- ^ point
 -> IO ()
bodyApplyImpulseAtLocalPoint a1 a2 a3 =
  let {a1' = id a1} in
  with a2 $ \a2' ->
  with a3 $ \a3' ->
  bodyApplyImpulseAtLocalPoint'_ a1' a2' a3' >>
  return ()

{-# LINE 239 "src/Chiphunk/Low/Body.chs" #-}


-- | Returns true if body is sleeping.
bodyIsSleeping :: (Body) -> IO ((Bool))
bodyIsSleeping a1 =
  let {a1' = id a1} in
  bodyIsSleeping'_ a1' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 242 "src/Chiphunk/Low/Body.chs" #-}


-- | Reset the idle timer on a body. If it was sleeping, wake it and any other bodies it was touching.
bodyActivate :: (Body) -> IO ()
bodyActivate a1 =
  let {a1' = id a1} in
  bodyActivate'_ a1' >>
  return ()

{-# LINE 245 "src/Chiphunk/Low/Body.chs" #-}


-- | Forces a body to fall asleep immediately even if it’s in midair. Cannot be called from a callback.
bodySleep :: (Body) -> IO ()
bodySleep a1 =
  let {a1' = id a1} in
  bodySleep'_ a1' >>
  return ()

{-# LINE 248 "src/Chiphunk/Low/Body.chs" #-}


-- | Activates all bodies touching @body@.
-- If @filter@ is not 'nullPtr', then only bodies touching through @filter@ will be awoken.
bodyActivateStatic :: (Body) -- ^ body
 -> (Shape) -- ^ filter
 -> IO ()
bodyActivateStatic a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  bodyActivateStatic'_ a1' a2' >>
  return ()

{-# LINE 255 "src/Chiphunk/Low/Body.chs" #-}


-- | When objects in Chipmunk sleep, they sleep as a group of all objects that are touching or jointed together.
-- When an object is woken up, all of the objects in its group are woken up.
-- 'bodySleepWithGroup' allows you group sleeping objects together.
-- It acts identically to 'bodySleep' if you pass 'nullPtr' as @group@ by starting a new group.
-- If you pass a sleeping body for @group@, @body@ will be awoken when group is awoken.
-- You can use this to initialize levels and start stacks of objects in a pre-sleeping state.
bodySleepWithGroup :: (Body) -- ^ body
 -> (Body) -- ^ group
 -> IO ()
bodySleepWithGroup a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  bodySleepWithGroup'_ a1' a2' >>
  return ()

{-# LINE 266 "src/Chiphunk/Low/Body.chs" #-}


-- | Type of callback which can be used to iterate all 'Shape's in a 'Body'.
type BodyShapeIteratorFunc = Body -> Shape -> Ptr () -> IO ()

foreign import ccall unsafe "wrapper"
  mkBodyShapeIteratorFunc :: BodyShapeIteratorFunc -> IO (FunPtr BodyShapeIteratorFunc)

-- | Call @func@ once for each shape that is attached to @body@ and added to a space.
-- @data@ is passed along as a context value. It is safe to remove shapes using these callbacks.
bodyEachShape :: (Body) -- ^ body
 -> (BodyShapeIteratorFunc) -- ^ func
 -> (Ptr ()) -- ^ data
 -> IO ()
bodyEachShape a1 a2 a3 =
  let {a1' = id a1} in
  withIterator a2 $ \a2' ->
  let {a3' = id a3} in
  bodyEachShape'_ a1' a2' a3' >>
  return ()

{-# LINE 280 "src/Chiphunk/Low/Body.chs" #-}

  where
    withIterator i = mkBodyShapeIteratorFunc i `bracket` freeHaskellFunPtr

-- | Type of callback which can be used to iterate all 'Constraint's in a 'Body'.
type BodyConstraintIteratorFunc = Body -> Constraint -> Ptr () -> IO ()

foreign import ccall unsafe "wrapper"
  mkBodyConstraintIteratorFunc :: BodyConstraintIteratorFunc -> IO (FunPtr BodyConstraintIteratorFunc)

-- | Call @func@ once for each constraint that is attached to @body@ and added to a space.
-- @data@ is passed along as a context value. It is safe to remove constraints using thes callbacks.
bodyEachConstraint :: (Body) -- ^ body
 -> (BodyConstraintIteratorFunc) -- ^ func
 -> (Ptr ()) -- ^ data
 -> IO ()
bodyEachConstraint a1 a2 a3 =
  let {a1' = id a1} in
  withIterator a2 $ \a2' ->
  let {a3' = id a3} in
  bodyEachConstraint'_ a1' a2' a3' >>
  return ()

{-# LINE 296 "src/Chiphunk/Low/Body.chs" #-}

  where
    withIterator i = mkBodyConstraintIteratorFunc i `bracket` freeHaskellFunPtr

-- | Type of callback which can be used to iterate all 'Arbiter's in a 'Body'.
type BodyArbiterIteratorFunc = Body -> Arbiter -> Ptr () -> IO ()

foreign import ccall unsafe "wrapper"
  mkBodyArbiterIteratorFunc :: BodyArbiterIteratorFunc -> IO (FunPtr BodyArbiterIteratorFunc)

-- | This one is more interesting. Calls @func@ once for each collision pair that @body@ is involved in.
-- Calling 'arbiterGetBodies'/'arbiterGetShapes' will return the body or shape for body as the first argument.
-- You can use this to check all sorts of collision information for a body like if it’s touching the ground,
-- another particular object, how much collision force is being applied to an object, etc.
--
-- Sensor shapes and arbiters that have been rejected by a collision handler callback or 'arbiterIgnore'
-- are not tracked by the contact graph.
bodyEachArbiter :: (Body) -- ^ body
 -> (BodyArbiterIteratorFunc) -- ^ func
 -> (Ptr ()) -- ^ data
 -> IO ()
bodyEachArbiter a1 a2 a3 =
  let {a1' = id a1} in
  withIterator a2 $ \a2' ->
  let {a3' = id a3} in
  bodyEachArbiter'_ a1' a2' a3' >>
  return ()

{-# LINE 317 "src/Chiphunk/Low/Body.chs" #-}

  where
    withIterator i = mkBodyArbiterIteratorFunc i `bracket` freeHaskellFunPtr

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

foreign import ccall unsafe "Chiphunk/Low/Body.chs.h cpBodyNewKinematic"
  bodyNewKinematic'_ :: (IO (Body))

foreign import ccall unsafe "Chiphunk/Low/Body.chs.h cpBodyNewStatic"
  bodyNewStatic'_ :: (IO (Body))

foreign import ccall safe "Chiphunk/Low/Body.chs.h cpBodyFree"
  bodyFree'_ :: ((Body) -> (IO ()))

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

foreign import ccall unsafe "Chiphunk/Low/Body.chs.h cpBodyGetSpace"
  cpBodyGetSpace'_ :: ((Body) -> (IO (Space)))

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

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

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

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

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

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

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

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

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

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

foreign import ccall unsafe "Chiphunk/Low/Body.chs.h cpBodyIsSleeping"
  bodyIsSleeping'_ :: ((Body) -> (IO C2HSImp.CUChar))

foreign import ccall unsafe "Chiphunk/Low/Body.chs.h cpBodyActivate"
  bodyActivate'_ :: ((Body) -> (IO ()))

foreign import ccall unsafe "Chiphunk/Low/Body.chs.h cpBodySleep"
  bodySleep'_ :: ((Body) -> (IO ()))

foreign import ccall unsafe "Chiphunk/Low/Body.chs.h cpBodyActivateStatic"
  bodyActivateStatic'_ :: ((Body) -> ((Shape) -> (IO ())))

foreign import ccall unsafe "Chiphunk/Low/Body.chs.h cpBodySleepWithGroup"
  bodySleepWithGroup'_ :: ((Body) -> ((Body) -> (IO ())))

foreign import ccall safe "Chiphunk/Low/Body.chs.h cpBodyEachShape"
  bodyEachShape'_ :: ((Body) -> ((C2HSImp.FunPtr ((Body) -> ((Shape) -> ((C2HSImp.Ptr ()) -> (IO ()))))) -> ((C2HSImp.Ptr ()) -> (IO ()))))

foreign import ccall safe "Chiphunk/Low/Body.chs.h cpBodyEachConstraint"
  bodyEachConstraint'_ :: ((Body) -> ((C2HSImp.FunPtr ((Body) -> ((Constraint) -> ((C2HSImp.Ptr ()) -> (IO ()))))) -> ((C2HSImp.Ptr ()) -> (IO ()))))

foreign import ccall safe "Chiphunk/Low/Body.chs.h cpBodyEachArbiter"
  bodyEachArbiter'_ :: ((Body) -> ((C2HSImp.FunPtr ((Body) -> ((Arbiter) -> ((C2HSImp.Ptr ()) -> (IO ()))))) -> ((C2HSImp.Ptr ()) -> (IO ()))))