{-# LINE 1 "src/Chiphunk/Low/Callback.chs" #-}
module Chiphunk.Low.Callback
( CollisionCallback
, CollisionHandler (..)
, CollisionHandlerPtr
, spaceAddCollisionHandler
, spaceAddWildcardHandler
, spaceAddDefaultCollisionHandler
, modifyCollisionHandler
, mkCallback
, mkCallbackB
, PostStepFunc
, spaceAddPostStepCallback
) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified Foreign.Storable as C2HSImp
import Control.Applicative (liftA)
import Control.Exception.Safe
import Data.Bool (bool)
import Foreign
import Chiphunk.Low.Types
{-# LINE 22 "src/Chiphunk/Low/Callback.chs" #-}
type CollisionCallback ret = Arbiter -> Space -> DataPtr -> IO ret
data CollisionHandler = CollisionHandler
{ chTypeA :: !CollisionType
, chTypeB :: !CollisionType
, chBeginFunc :: !(FunPtr (CollisionCallback CPBool))
, chPreSolveFunc :: !(FunPtr (CollisionCallback CPBool))
, chPostSolveFunc :: !(FunPtr (CollisionCallback ()))
, chSeparateFunc :: !(FunPtr (CollisionCallback ()))
, cpUserData :: !DataPtr
} deriving Show
instance Storable CollisionHandler where
sizeOf _ = 56
{-# LINE 60 "src/Chiphunk/Low/Callback.chs" #-}
alignment _ = 8
{-# LINE 61 "src/Chiphunk/Low/Callback.chs" #-}
poke p (CollisionHandler typA typB beginFunc preSolveFunc postSolveFunc separateFunc userData) = do
(\ptr val -> do {C2HSImp.pokeByteOff ptr 0 (val :: C2HSImp.CULong)}) p $ fromIntegral typA
(\ptr val -> do {C2HSImp.pokeByteOff ptr 8 (val :: C2HSImp.CULong)}) p $ fromIntegral typB
(\ptr val -> do {C2HSImp.pokeByteOff ptr 16 (val :: (C2HSImp.FunPtr ((Arbiter) -> ((Space) -> ((DataPtr) -> (IO C2HSImp.CUChar))))))}) p beginFunc
(\ptr val -> do {C2HSImp.pokeByteOff ptr 24 (val :: (C2HSImp.FunPtr ((Arbiter) -> ((Space) -> ((DataPtr) -> (IO C2HSImp.CUChar))))))}) p preSolveFunc
(\ptr val -> do {C2HSImp.pokeByteOff ptr 32 (val :: (C2HSImp.FunPtr ((Arbiter) -> ((Space) -> ((DataPtr) -> (IO ()))))))}) p postSolveFunc
(\ptr val -> do {C2HSImp.pokeByteOff ptr 40 (val :: (C2HSImp.FunPtr ((Arbiter) -> ((Space) -> ((DataPtr) -> (IO ()))))))}) p separateFunc
(\ptr val -> do {C2HSImp.pokeByteOff ptr 48 (val :: (C2HSImp.Ptr ()))}) p userData
peek p = CollisionHandler <$> (fromIntegral <$> (\ptr -> do {C2HSImp.peekByteOff ptr 0 :: IO C2HSImp.CULong}) p)
<*> (fromIntegral <$> (\ptr -> do {C2HSImp.peekByteOff ptr 8 :: IO C2HSImp.CULong}) p)
<*> (\ptr -> do {C2HSImp.peekByteOff ptr 16 :: IO (C2HSImp.FunPtr ((Arbiter) -> ((Space) -> ((DataPtr) -> (IO C2HSImp.CUChar)))))}) p
<*> (\ptr -> do {C2HSImp.peekByteOff ptr 24 :: IO (C2HSImp.FunPtr ((Arbiter) -> ((Space) -> ((DataPtr) -> (IO C2HSImp.CUChar)))))}) p
<*> (\ptr -> do {C2HSImp.peekByteOff ptr 32 :: IO (C2HSImp.FunPtr ((Arbiter) -> ((Space) -> ((DataPtr) -> (IO ())))))}) p
<*> (\ptr -> do {C2HSImp.peekByteOff ptr 40 :: IO (C2HSImp.FunPtr ((Arbiter) -> ((Space) -> ((DataPtr) -> (IO ())))))}) p
<*> (\ptr -> do {C2HSImp.peekByteOff ptr 48 :: IO (C2HSImp.Ptr ())}) p
foreign import ccall unsafe "wrapper"
mkCallback' :: CollisionCallback () -> IO (FunPtr (CollisionCallback ()))
mkCallback :: CollisionCallback () -> IO (FunPtr (CollisionCallback ()))
mkCallback = mkCallback'
foreign import ccall unsafe "wrapper"
mkCallbackB' :: CollisionCallback CPBool -> IO (FunPtr (CollisionCallback CPBool))
mkCallbackB :: CollisionCallback Bool -> IO (FunPtr (CollisionCallback CPBool))
mkCallbackB = mkCallbackB' . liftA (liftA $ liftA $ liftA $ bool 0 1)
type CollisionHandlerPtr = C2HSImp.Ptr (CollisionHandler)
{-# LINE 93 "src/Chiphunk/Low/Callback.chs" #-}
spaceAddCollisionHandler :: (Space) -> (CollisionType)
-> (CollisionType)
-> IO ((CollisionHandlerPtr))
spaceAddCollisionHandler a1 a2 a3 =
let {a1' = id a1} in
let {a2' = fromIntegral a2} in
let {a3' = fromIntegral a3} in
spaceAddCollisionHandler'_ a1' a2' a3' >>= \res ->
let {res' = id res} in
return (res')
{-# LINE 104 "src/Chiphunk/Low/Callback.chs" #-}
spaceAddWildcardHandler :: (Space) -> (CollisionType)
-> IO ((CollisionHandlerPtr))
spaceAddWildcardHandler a1 a2 =
let {a1' = id a1} in
let {a2' = fromIntegral a2} in
spaceAddWildcardHandler'_ a1' a2' >>= \res ->
let {res' = id res} in
return (res')
{-# LINE 117 "src/Chiphunk/Low/Callback.chs" #-}
spaceAddDefaultCollisionHandler :: (Space) -> IO ((CollisionHandlerPtr))
spaceAddDefaultCollisionHandler a1 =
let {a1' = id a1} in
spaceAddDefaultCollisionHandler'_ a1' >>= \res ->
let {res' = id res} in
return (res')
{-# LINE 124 "src/Chiphunk/Low/Callback.chs" #-}
modifyCollisionHandler :: CollisionHandlerPtr -> (CollisionHandler -> IO CollisionHandler) -> IO ()
modifyCollisionHandler chPtr inner = peek chPtr >>= inner >>= poke chPtr
type PostStepFunc
= Space
-> Ptr ()
-> Ptr ()
-> IO ()
foreign import ccall "wrapper"
mkPostStep :: PostStepFunc -> IO (FunPtr PostStepFunc)
spaceAddPostStepCallback :: (Space)
-> (PostStepFunc)
-> (Ptr ())
-> (Ptr ())
-> IO ((Bool))
spaceAddPostStepCallback a1 a2 a3 a4 =
let {a1' = id a1} in
mk a2 $ \a2' ->
let {a3' = id a3} in
let {a4' = id a4} in
spaceAddPostStepCallback'_ a1' a2' a3' a4' >>= \res ->
let {res' = C2HSImp.toBool res} in
return (res')
{-# LINE 157 "src/Chiphunk/Low/Callback.chs" #-}
where
mk f = mkPostStep f `bracket` freeHaskellFunPtr
foreign import ccall unsafe "Chiphunk/Low/Callback.chs.h cpSpaceAddCollisionHandler"
spaceAddCollisionHandler'_ :: ((Space) -> (C2HSImp.CULong -> (C2HSImp.CULong -> (IO (CollisionHandlerPtr)))))
foreign import ccall unsafe "Chiphunk/Low/Callback.chs.h cpSpaceAddWildcardHandler"
spaceAddWildcardHandler'_ :: ((Space) -> (C2HSImp.CULong -> (IO (CollisionHandlerPtr))))
foreign import ccall unsafe "Chiphunk/Low/Callback.chs.h cpSpaceAddDefaultCollisionHandler"
spaceAddDefaultCollisionHandler'_ :: ((Space) -> (IO (CollisionHandlerPtr)))
foreign import ccall unsafe "Chiphunk/Low/Callback.chs.h cpSpaceAddPostStepCallback"
spaceAddPostStepCallback'_ :: ((Space) -> ((C2HSImp.FunPtr ((Space) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ()))))) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CUChar)))))