-- 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/Space.chs" #-}
-- | Description: Manipulate space
-- Module defined utilities for manipulating spaces.
module Chiphunk.Low.Space
  ( Space
  , spaceIterations
  , spaceGravity
  , spaceDamping
  , spaceIdleSpeedThreshold
  , spaceSleepTimeThreshold
  , spaceCollisionSlop
  , spaceCollisionBias
  , spaceCollisionPersistence
  , spaceCurrentTimeStep
  , spaceIsLocked
  , spaceUserData
  , spaceStaticBody
  , spaceNew
  , spaceFree
  , spaceAddShape
  , spaceAddBody
  , spaceAddConstraint
  , spaceRemoveShape
  , spaceRemoveBody
  , spaceRemoveConstraint
  , spaceContainsShape
  , spaceContainsBody
  , spaceContainsConstraint
  , spaceReindexShape
  , spaceReindexShapesForBody
  , spaceReindexStatic
  , SpaceBodyIteratorFunc
  , spaceEachBody
  , SpaceShapeIteratorFunc
  , spaceEachShape
  , SpaceConstraintIteratorFunc
  , spaceEachConstraint
  , spaceStep
  ) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified Foreign.Ptr as C2HSImp



import Control.Exception.Safe
import Data.StateVar
import Foreign

import Chiphunk.Low.Vect
import Chiphunk.Low.Types
{-# LINE 45 "src/Chiphunk/Low/Space.chs" #-}





cpSpaceGetIterations :: (Space) -> IO ((Int))
cpSpaceGetIterations a1 =
  let {a1' = id a1} in 
  cpSpaceGetIterations'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 50 "src/Chiphunk/Low/Space.chs" #-}


cpSpaceSetIterations :: (Space) -> (Int) -> IO ()
cpSpaceSetIterations a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  cpSpaceSetIterations'_ a1' a2' >>
  return ()

{-# LINE 52 "src/Chiphunk/Low/Space.chs" #-}


-- | Iterations allow you to control the accuracy of the solver.
-- Defaults to 10. See above for more information.
spaceIterations :: Space -> StateVar Int
spaceIterations = mkStateVar cpSpaceGetIterations cpSpaceSetIterations

w_cpSpaceGetGravity :: (Space) -> IO ((Vect))
w_cpSpaceGetGravity :: Space -> IO Vect
w_cpSpaceGetGravity Space
a1 =
  let {a1' :: Space
a1' = Space -> Space
forall a. a -> a
id Space
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' -> 
  Space -> Ptr Vect -> IO ()
w_cpSpaceGetGravity'_ Space
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 59 "src/Chiphunk/Low/Space.chs" #-}


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

{-# LINE 61 "src/Chiphunk/Low/Space.chs" #-}


-- | Global gravity applied to the space. Defaults to 'vZero'.
-- Can be overridden on a per body basis by writing custom integration functions.
-- Changing the gravity will activate all sleeping bodies in the space.
spaceGravity :: Space -> StateVar Vect
spaceGravity = mkStateVar w_cpSpaceGetGravity cpSpaceSetGravity

cpSpaceGetDamping :: (Space) -> IO ((Double))
cpSpaceGetDamping :: Space -> IO Double
cpSpaceGetDamping Space
a1 =
  let {a1' :: Space
a1' = Space -> Space
forall a. a -> a
id Space
a1} in 
  Space -> IO CDouble
cpSpaceGetDamping'_ Space
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 69 "src/Chiphunk/Low/Space.chs" #-}


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

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


-- | Amount of simple damping to apply to the space.
-- A value of 0.9 means that each body will lose 10% of its velocity per second.
-- Defaults to 1. Like gravity, it can be overridden on a per body basis.
spaceDamping :: Space -> StateVar Double
spaceDamping = mkStateVar cpSpaceGetDamping cpSpaceSetDamping

cpSpaceGetIdleSpeedThreshold :: (Space) -> IO ((Double))
cpSpaceGetIdleSpeedThreshold :: Space -> IO Double
cpSpaceGetIdleSpeedThreshold Space
a1 =
  let {a1' :: Space
a1' = Space -> Space
forall a. a -> a
id Space
a1} in 
  Space -> IO CDouble
cpSpaceGetIdleSpeedThreshold'_ Space
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 79 "src/Chiphunk/Low/Space.chs" #-}


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

{-# LINE 81 "src/Chiphunk/Low/Space.chs" #-}


-- | Speed threshold for a body to be considered idle.
-- The default value of 0 means the space estimates a good threshold based on gravity.
spaceIdleSpeedThreshold :: Space -> StateVar Double
spaceIdleSpeedThreshold = mkStateVar cpSpaceGetIdleSpeedThreshold cpSpaceSetIdleSpeedThreshold

cpSpaceGetSleepTimeThreshold :: (Space) -> IO ((Double))
cpSpaceGetSleepTimeThreshold :: Space -> IO Double
cpSpaceGetSleepTimeThreshold Space
a1 =
  let {a1' :: Space
a1' = Space -> Space
forall a. a -> a
id Space
a1} in 
  Space -> IO CDouble
cpSpaceGetSleepTimeThreshold'_ Space
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 88 "src/Chiphunk/Low/Space.chs" #-}


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

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


-- | Time a group of bodies must remain idle in order to fall asleep.
-- The default value of INFINITY disables the sleeping feature.
spaceSleepTimeThreshold :: Space -> StateVar Double
spaceSleepTimeThreshold = mkStateVar cpSpaceGetSleepTimeThreshold cpSpaceSetSleepTimeThreshold

cpSpaceGetCollisionSlop :: (Space) -> IO ((Double))
cpSpaceGetCollisionSlop :: Space -> IO Double
cpSpaceGetCollisionSlop Space
a1 =
  let {a1' :: Space
a1' = Space -> Space
forall a. a -> a
id Space
a1} in 
  Space -> IO CDouble
cpSpaceGetCollisionSlop'_ Space
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 97 "src/Chiphunk/Low/Space.chs" #-}


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

{-# LINE 99 "src/Chiphunk/Low/Space.chs" #-}


-- | Amount of overlap between shapes that is allowed.
-- To improve stability, set this as high as you can without noticable overlapping.
-- It defaults to @0.1@.
spaceCollisionSlop :: Space -> StateVar Double
spaceCollisionSlop = mkStateVar cpSpaceGetCollisionSlop cpSpaceSetCollisionSlop

cpSpaceGetCollisionBias :: (Space) -> IO ((Double))
cpSpaceGetCollisionBias :: Space -> IO Double
cpSpaceGetCollisionBias Space
a1 =
  let {a1' :: Space
a1' = Space -> Space
forall a. a -> a
id Space
a1} in 
  Space -> IO CDouble
cpSpaceGetCollisionBias'_ Space
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 107 "src/Chiphunk/Low/Space.chs" #-}


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

{-# LINE 109 "src/Chiphunk/Low/Space.chs" #-}


-- | Chipmunk allows fast moving objects to overlap, then fixes the overlap over time.
-- Overlapping objects are unavoidable even if swept collisions are supported,
-- and this is an efficient and stable way to deal with overlapping objects.
-- The bias value controls what percentage of overlap remains unfixed
-- after a second and defaults to ~0.2%.
--
-- Valid values are in the range from 0 to 1,
-- but using 0 is not recommended for stability reasons.
--
-- The default value is calculated as @(1.0 - 0.1) ^ 60@
-- meaning that Chipmunk attempts to correct 10% of error ever 1/60th of a second.
--
-- __Note__: Very very few games will need to change this value.
spaceCollisionBias :: Space -> StateVar Double
spaceCollisionBias :: Space -> StateVar Double
spaceCollisionBias = (Space -> IO Double)
-> (Space -> Double -> IO ()) -> Space -> StateVar Double
forall a b. (a -> IO b) -> (a -> b -> IO ()) -> a -> StateVar b
mkStateVar Space -> IO Double
cpSpaceGetCollisionBias Space -> Double -> IO ()
cpSpaceSetCollisionBias

cpSpaceGetCollisionPersistence :: (Space) -> IO ((Word32))
cpSpaceGetCollisionPersistence :: Space -> IO Word32
cpSpaceGetCollisionPersistence Space
a1 =
  let {a1' :: Space
a1' = Space -> Space
forall a. a -> a
id Space
a1} in 
  Space -> IO CUInt
cpSpaceGetCollisionPersistence'_ Space
a1' IO CUInt -> (CUInt -> IO Word32) -> IO Word32
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CUInt
res ->
  let {res' :: Word32
res' = CUInt -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
res} in
  Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32
res')

{-# LINE 127 "src/Chiphunk/Low/Space.chs" #-}


cpSpaceSetCollisionPersistence :: (Space) -> (Word32) -> IO ()
cpSpaceSetCollisionPersistence a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  cpSpaceSetCollisionPersistence'_ a1' a2' >>
  return ()

{-# LINE 129 "src/Chiphunk/Low/Space.chs" #-}


-- | The number of frames the space keeps collision solutions around for.
-- Helps prevent jittering contacts from getting worse.
-- This defaults to 3 and very very very few games will need to change this value.
spaceCollisionPersistence :: Space -> StateVar Word32
spaceCollisionPersistence = mkStateVar cpSpaceGetCollisionPersistence cpSpaceSetCollisionPersistence

cpSpaceGetCurrentTimeStep :: (Space) -> IO ((Double))
cpSpaceGetCurrentTimeStep :: Space -> IO Double
cpSpaceGetCurrentTimeStep Space
a1 =
  let {a1' :: Space
a1' = Space -> Space
forall a. a -> a
id Space
a1} in 
  Space -> IO CDouble
cpSpaceGetCurrentTimeStep'_ Space
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
  return (res')

{-# LINE 137 "src/Chiphunk/Low/Space.chs" #-}


-- | The current (if you are in a callback from 'spaceStep')
-- or most recent (outside of a 'spaceStep' call) timestep.
spaceCurrentTimeStep :: Space -> GettableStateVar Double
spaceCurrentTimeStep = makeGettableStateVar . cpSpaceGetCurrentTimeStep

-- | Returns true when you cannot add/remove objects from the space.
-- In particular, spaces are locked when in a collision callback.
-- Instead, run your code in a post-step callback instead.
spaceIsLocked :: (Space) -> IO ((Bool))
spaceIsLocked :: Space -> IO Bool
spaceIsLocked Space
a1 =
  let {a1' :: Space
a1' = Space -> Space
forall a. a -> a
id Space
a1} in 
  Space -> IO CUChar
spaceIsLocked'_ Space
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 147 "src/Chiphunk/Low/Space.chs" #-}


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

{-# LINE 149 "src/Chiphunk/Low/Space.chs" #-}


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

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


-- | A user definable data pointer.
-- It is often useful to point this at the gamestate object
-- or scene management object that owns the space.
spaceUserData :: Space -> StateVar DataPtr
spaceUserData = mkStateVar cpSpaceGetUserData cpSpaceSetUserData

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

{-# LINE 159 "src/Chiphunk/Low/Space.chs" #-}


-- | A dedicated static body for the space.
-- You don’t have to use it,
-- but because its memory is managed automatically with the space its very convenient.
-- You can set its user data pointer to something helpful if you want for callbacks.
spaceStaticBody :: Space -> GettableStateVar Body
spaceStaticBody = makeGettableStateVar . cpSpaceGetStaticBody

-- | Standard Chipmunk allocation function.
spaceNew :: IO ((Space))
spaceNew :: IO Space
spaceNew =
  IO Space
spaceNew'_ IO Space -> (Space -> IO Space) -> IO Space
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Space
res ->
  let {res' :: Space
res' = Space -> Space
forall a. a -> a
id Space
res} in
  Space -> IO Space
forall (m :: * -> *) a. Monad m => a -> m a
return (Space
res')

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


-- | Standard Chipmunk deallocation function.
spaceFree :: (Space) -> IO ()
spaceFree a1 =
  let {a1' = id a1} in 
  spaceFree'_ a1' >>
  return ()

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

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

-- | Add shape to the space.
spaceAddShape :: (Space) -> (Shape) -> IO ()
spaceAddShape a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  spaceAddShape'_ a1' a2' >>
  return ()

{-# LINE 176 "src/Chiphunk/Low/Space.chs" #-}


-- | Add body to the space.
spaceAddBody :: (Space) -> (Body) -> IO ()
spaceAddBody a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  spaceAddBody'_ a1' a2' >>
  return ()

{-# LINE 179 "src/Chiphunk/Low/Space.chs" #-}


-- | Add constraint to the space.
spaceAddConstraint :: (Space) -> (Constraint) -> IO ()
spaceAddConstraint a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  spaceAddConstraint'_ a1' a2' >>
  return ()

{-# LINE 182 "src/Chiphunk/Low/Space.chs" #-}


-- | Remove shape from the space.
spaceRemoveShape :: (Space) -> (Shape) -> IO ()
spaceRemoveShape a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  spaceRemoveShape'_ a1' a2' >>
  return ()

{-# LINE 185 "src/Chiphunk/Low/Space.chs" #-}

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

-- | Remove body from the space.
spaceRemoveBody :: (Space) -> (Body) -> IO ()
spaceRemoveBody a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  spaceRemoveBody'_ a1' a2' >>
  return ()

{-# LINE 189 "src/Chiphunk/Low/Space.chs" #-}

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

-- | Remove constraint from the space.
spaceRemoveConstraint :: (Space) -> (Constraint) -> IO ()
spaceRemoveConstraint a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  spaceRemoveConstraint'_ a1' a2' >>
  return ()

{-# LINE 193 "src/Chiphunk/Low/Space.chs" #-}

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

-- | Check if shape is attached to the space.
spaceContainsShape :: (Space) -> (Shape) -> IO ((Bool))
spaceContainsShape a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  spaceContainsShape'_ a1' a2' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

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


-- | Check if body is attached to the space.
spaceContainsBody :: (Space) -> (Body) -> IO ((Bool))
spaceContainsBody a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  spaceContainsBody'_ a1' a2' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

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


-- | Check if constraint is attached to the space.
spaceContainsConstraint :: (Space) -> (Constraint) -> IO ((Bool))
spaceContainsConstraint a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  spaceContainsConstraint'_ a1' a2' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 203 "src/Chiphunk/Low/Space.chs" #-}


-- | Reindex a specific shape.
spaceReindexShape :: (Space) -> (Shape) -> IO ()
spaceReindexShape a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  spaceReindexShape'_ a1' a2' >>
  return ()

{-# LINE 206 "src/Chiphunk/Low/Space.chs" #-}


-- | Reindex all the shapes for a certain body.
spaceReindexShapesForBody :: (Space) -> (Body) -> IO ()
spaceReindexShapesForBody a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  spaceReindexShapesForBody'_ a1' a2' >>
  return ()

{-# LINE 209 "src/Chiphunk/Low/Space.chs" #-}


-- | Reindex all static shapes. Generally updating only the shapes that changed is faster.
spaceReindexStatic :: (Space) -> IO ()
spaceReindexStatic a1 =
  let {a1' = id a1} in 
  spaceReindexStatic'_ a1' >>
  return ()

{-# LINE 212 "src/Chiphunk/Low/Space.chs" #-}


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

foreign import ccall unsafe "wrapper"
  mkSpaceBodyIteratorFunc :: SpaceBodyIteratorFunc -> IO (FunPtr SpaceBodyIteratorFunc)

-- | Call @func@ for each body in the @space@ also passing along your @data@ pointer.
-- Sleeping bodies are included, but static and kinematic bodies are not as they aren’t added to the space.
spaceEachBody :: (Space) -- ^ space
 -> (SpaceBodyIteratorFunc) -- ^ func
 -> (Ptr ()) -- ^ data
 -> IO ()
spaceEachBody :: Space -> SpaceBodyIteratorFunc -> DataPtr -> IO ()
spaceEachBody Space
a1 SpaceBodyIteratorFunc
a2 DataPtr
a3 =
  let {a1' :: Space
a1' = Space -> Space
forall a. a -> a
id Space
a1} in 
  SpaceBodyIteratorFunc
-> (FunPtr SpaceBodyIteratorFunc -> IO ()) -> IO ()
forall c.
SpaceBodyIteratorFunc
-> (FunPtr SpaceBodyIteratorFunc -> IO c) -> IO c
withIterator SpaceBodyIteratorFunc
a2 ((FunPtr SpaceBodyIteratorFunc -> IO ()) -> IO ())
-> (FunPtr SpaceBodyIteratorFunc -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FunPtr SpaceBodyIteratorFunc
a2' -> 
  let {a3' :: DataPtr
a3' = DataPtr -> DataPtr
forall a. a -> a
id DataPtr
a3} in 
  Space -> FunPtr SpaceBodyIteratorFunc -> DataPtr -> IO ()
spaceEachBody'_ Space
a1' FunPtr SpaceBodyIteratorFunc
a2' DataPtr
a3' IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# LINE 226 "src/Chiphunk/Low/Space.chs" #-}

  where
    withIterator i = mkSpaceBodyIteratorFunc i `bracket` freeHaskellFunPtr

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

foreign import ccall unsafe "wrapper"
  mkSpaceShapeIteratorFunc :: SpaceShapeIteratorFunc -> IO (FunPtr SpaceShapeIteratorFunc)

-- | Call @func@ for each shape in the @space@ also passing along your @data@ pointer.
-- Sleeping and static shapes are included.
spaceEachShape :: (Space) -- ^ space
 -> (SpaceShapeIteratorFunc) -- ^ func
 -> (Ptr ()) -- ^ data
 -> IO ()
spaceEachShape :: Space -> SpaceShapeIteratorFunc -> DataPtr -> IO ()
spaceEachShape Space
a1 SpaceShapeIteratorFunc
a2 DataPtr
a3 =
  let {a1' :: Space
a1' = Space -> Space
forall a. a -> a
id Space
a1} in 
  SpaceShapeIteratorFunc
-> (FunPtr SpaceShapeIteratorFunc -> IO ()) -> IO ()
forall c.
SpaceShapeIteratorFunc
-> (FunPtr SpaceShapeIteratorFunc -> IO c) -> IO c
withIterator SpaceShapeIteratorFunc
a2 ((FunPtr SpaceShapeIteratorFunc -> IO ()) -> IO ())
-> (FunPtr SpaceShapeIteratorFunc -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FunPtr SpaceShapeIteratorFunc
a2' -> 
  let {a3' :: DataPtr
a3' = DataPtr -> DataPtr
forall a. a -> a
id DataPtr
a3} in 
  Space -> FunPtr SpaceShapeIteratorFunc -> DataPtr -> IO ()
spaceEachShape'_ Space
a1' FunPtr SpaceShapeIteratorFunc
a2' DataPtr
a3' IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

  where
    withIterator i = mkSpaceShapeIteratorFunc i `bracket` freeHaskellFunPtr

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

foreign import ccall unsafe "wrapper"
  mkSpaceConstraintIteratorFunc :: SpaceConstraintIteratorFunc -> IO (FunPtr SpaceConstraintIteratorFunc)

-- | Call func for each constraint in the space also passing along your data pointer.
spaceEachConstraint :: (Space) -- ^ space
 -> (SpaceConstraintIteratorFunc) -- ^ func
 -> (Ptr ()) -- ^ data
 -> IO ()
spaceEachConstraint :: Space -> SpaceConstraintIteratorFunc -> DataPtr -> IO ()
spaceEachConstraint Space
a1 SpaceConstraintIteratorFunc
a2 DataPtr
a3 =
  let {a1' :: Space
a1' = Space -> Space
forall a. a -> a
id Space
a1} in 
  SpaceConstraintIteratorFunc
-> (FunPtr SpaceConstraintIteratorFunc -> IO ()) -> IO ()
forall c.
SpaceConstraintIteratorFunc
-> (FunPtr SpaceConstraintIteratorFunc -> IO c) -> IO c
withIterator SpaceConstraintIteratorFunc
a2 ((FunPtr SpaceConstraintIteratorFunc -> IO ()) -> IO ())
-> (FunPtr SpaceConstraintIteratorFunc -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FunPtr SpaceConstraintIteratorFunc
a2' -> 
  let {a3' :: DataPtr
a3' = DataPtr -> DataPtr
forall a. a -> a
id DataPtr
a3} in 
  Space -> FunPtr SpaceConstraintIteratorFunc -> DataPtr -> IO ()
spaceEachConstraint'_ Space
a1' FunPtr SpaceConstraintIteratorFunc
a2' DataPtr
a3' IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# LINE 257 "src/Chiphunk/Low/Space.chs" #-}

  where
    withIterator i = mkSpaceConstraintIteratorFunc i `bracket` freeHaskellFunPtr

-- | Update the space for the given time step. Using a fixed time step is highly recommended.
-- Doing so can greatly increase the quality of the simulation.
-- The easiest way to do constant timesteps is to simple step forward by 1/60th of a second
-- (or whatever your target framerate is) for each frame regardless of how long it took to render.
-- This works fine for many games, but a better way to do it is to separate your physics timestep and rendering.
spaceStep :: (Space) -> (Double) -> IO ()
spaceStep :: Space -> Double -> IO ()
spaceStep Space
a1 Double
a2 =
  let {a1' :: Space
a1' = Space -> Space
forall a. a -> a
id Space
a1} in 
  let {a2' :: CDouble
a2' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
a2} in 
  Space -> CDouble -> IO ()
spaceStep'_ Space
a1' CDouble
a2' IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

foreign import ccall unsafe "Chiphunk/Low/Space.chs.h cpSpaceIsLocked"
  spaceIsLocked'_ :: ((Space) -> (IO C2HSImp.CUChar))

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

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

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

foreign import ccall unsafe "Chiphunk/Low/Space.chs.h cpSpaceNew"
  spaceNew'_ :: (IO (Space))

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

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

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

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

foreign import ccall safe "Chiphunk/Low/Space.chs.h cpSpaceRemoveShape"
  spaceRemoveShape'_ :: ((Space) -> ((Shape) -> (IO ())))

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

foreign import ccall safe "Chiphunk/Low/Space.chs.h cpSpaceRemoveConstraint"
  spaceRemoveConstraint'_ :: ((Space) -> ((Constraint) -> (IO ())))

foreign import ccall unsafe "Chiphunk/Low/Space.chs.h cpSpaceContainsShape"
  spaceContainsShape'_ :: ((Space) -> ((Shape) -> (IO C2HSImp.CUChar)))

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

foreign import ccall unsafe "Chiphunk/Low/Space.chs.h cpSpaceContainsConstraint"
  spaceContainsConstraint'_ :: ((Space) -> ((Constraint) -> (IO C2HSImp.CUChar)))

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

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

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

foreign import ccall safe "Chiphunk/Low/Space.chs.h cpSpaceEachBody"
  spaceEachBody'_ :: ((Space) -> ((C2HSImp.FunPtr ((Body) -> ((C2HSImp.Ptr ()) -> (IO ())))) -> ((C2HSImp.Ptr ()) -> (IO ()))))

foreign import ccall safe "Chiphunk/Low/Space.chs.h cpSpaceEachShape"
  spaceEachShape'_ :: ((Space) -> ((C2HSImp.FunPtr ((Shape) -> ((C2HSImp.Ptr ()) -> (IO ())))) -> ((C2HSImp.Ptr ()) -> (IO ()))))

foreign import ccall safe "Chiphunk/Low/Space.chs.h cpSpaceEachConstraint"
  spaceEachConstraint'_ :: ((Space) -> ((C2HSImp.FunPtr ((Constraint) -> ((C2HSImp.Ptr ()) -> (IO ())))) -> ((C2HSImp.Ptr ()) -> (IO ()))))

foreign import ccall safe "Chiphunk/Low/Space.chs.h cpSpaceStep"
  spaceStep'_ :: ((Space) -> (C2HSImp.CDouble -> (IO ())))