{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE QuasiQuotes                #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances       #-}

module Apecs.Physics.Types where

import           Apecs
import           Apecs.Core
import           Data.Bits
import           Data.Char                 (intToDigit)
import qualified Data.IntMap               as M
import qualified Data.IntSet               as S
import           Data.IORef
import qualified Data.Map                  as Map
import           Data.Monoid               ((<>))
import qualified Foreign.C.Types           as C
import           Foreign.ForeignPtr
import           Foreign.Ptr
import           Language.C.Inline
import           Language.C.Inline.Context
import qualified Language.C.Types          as C
import qualified Language.Haskell.TH       as TH
import           Linear.V2
import           Numeric                   (showIntAtBase)

phycsCtx :: Context
phycsCtx :: Context
phycsCtx = Context
baseCtx Context -> Context -> Context
forall a. Semigroup a => a -> a -> a
<> Context
funCtx Context -> Context -> Context
forall a. Semigroup a => a -> a -> a
<> Context
ctx
  where ctx :: Context
ctx = Context
forall a. Monoid a => a
mempty { ctxTypesTable :: TypesTable
ctxTypesTable = TypesTable
phycsTypesTable }

phycsTypesTable :: Map.Map C.TypeSpecifier TH.TypeQ
phycsTypesTable :: TypesTable
phycsTypesTable = [(TypeSpecifier, TypeQ)] -> TypesTable
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
  [ (CIdentifier -> TypeSpecifier
C.TypeName CIdentifier
"cpArbiter",          [t| Collision        |])
  , (CIdentifier -> TypeSpecifier
C.TypeName CIdentifier
"cpBody",             [t| Body             |])
  , (CIdentifier -> TypeSpecifier
C.TypeName CIdentifier
"cpCollisionHandler", [t| CollisionHandler |])
  , (CIdentifier -> TypeSpecifier
C.TypeName CIdentifier
"cpConstraint",       [t| Constraint       |])
  , (CIdentifier -> TypeSpecifier
C.TypeName CIdentifier
"cpDataPointer",      [t| C.CUInt          |])
  , (CIdentifier -> TypeSpecifier
C.TypeName CIdentifier
"cpShape",            [t| Shape            |])
  , (CIdentifier -> TypeSpecifier
C.TypeName CIdentifier
"cpPointQueryInfo",   [t| PointQueryResult |])
  , (CIdentifier -> TypeSpecifier
C.TypeName CIdentifier
"cpVect",             [t| V2 C.CDouble     |])
  , (CIdentifier -> TypeSpecifier
C.TypeName CIdentifier
"cpSpace",            [t| FrnSpace         |])
  ]

-- | Uninhabited, should be added to the world as a component to add a physics space.
data Physics

-- | Vector type used by the library
type Vec = V2 Double
-- | Type synonym indicating that a vector is expected to be in body-space coordinates
type BVec = Vec
-- | Type synonym indicating that a vector is expected to be in world-space coordinates
type WVec = Vec

-- | Added to a component to add it to the physics space.
--   Deleting it will also delete all associated shapes and constraints.
--   A body has a number of subcomponents: @Position@, @Velocity@, @Force@, @Torque@, @BodyMass@, @Moment@, @Angle@, @AngularVelocity@, and @CenterOfGravity@.
--   These components cannot be added or removed from an entity, but rather are present as long as the entity has a @Body@.
data Body = DynamicBody | KinematicBody | StaticBody deriving (Body -> Body -> Bool
(Body -> Body -> Bool) -> (Body -> Body -> Bool) -> Eq Body
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Body -> Body -> Bool
$c/= :: Body -> Body -> Bool
== :: Body -> Body -> Bool
$c== :: Body -> Body -> Bool
Eq, Eq Body
Eq Body
-> (Body -> Body -> Ordering)
-> (Body -> Body -> Bool)
-> (Body -> Body -> Bool)
-> (Body -> Body -> Bool)
-> (Body -> Body -> Bool)
-> (Body -> Body -> Body)
-> (Body -> Body -> Body)
-> Ord Body
Body -> Body -> Bool
Body -> Body -> Ordering
Body -> Body -> Body
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Body -> Body -> Body
$cmin :: Body -> Body -> Body
max :: Body -> Body -> Body
$cmax :: Body -> Body -> Body
>= :: Body -> Body -> Bool
$c>= :: Body -> Body -> Bool
> :: Body -> Body -> Bool
$c> :: Body -> Body -> Bool
<= :: Body -> Body -> Bool
$c<= :: Body -> Body -> Bool
< :: Body -> Body -> Bool
$c< :: Body -> Body -> Bool
compare :: Body -> Body -> Ordering
$ccompare :: Body -> Body -> Ordering
$cp1Ord :: Eq Body
Ord, Int -> Body
Body -> Int
Body -> [Body]
Body -> Body
Body -> Body -> [Body]
Body -> Body -> Body -> [Body]
(Body -> Body)
-> (Body -> Body)
-> (Int -> Body)
-> (Body -> Int)
-> (Body -> [Body])
-> (Body -> Body -> [Body])
-> (Body -> Body -> [Body])
-> (Body -> Body -> Body -> [Body])
-> Enum Body
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Body -> Body -> Body -> [Body]
$cenumFromThenTo :: Body -> Body -> Body -> [Body]
enumFromTo :: Body -> Body -> [Body]
$cenumFromTo :: Body -> Body -> [Body]
enumFromThen :: Body -> Body -> [Body]
$cenumFromThen :: Body -> Body -> [Body]
enumFrom :: Body -> [Body]
$cenumFrom :: Body -> [Body]
fromEnum :: Body -> Int
$cfromEnum :: Body -> Int
toEnum :: Int -> Body
$ctoEnum :: Int -> Body
pred :: Body -> Body
$cpred :: Body -> Body
succ :: Body -> Body
$csucc :: Body -> Body
Enum)

-- | A subcomponent of @Body@ representing where it is in world coordinates.
newtype Position        = Position WVec
-- | A subcomponent of @Body@ representing where it is going in world coordinates
newtype Velocity        = Velocity WVec
-- | A component used to apply a force to a @Body@.
-- The force is applied to the body's center of gravity.
-- This component is reset to @ Vec 0 0 @ after every stimulation step, 
-- so it is mainly used to apply a force as opposed to being read.
newtype Force           = Force Vec
-- | A component used to apply a torque to a @Body@.
-- The torque is applied to the entire body at once.
-- This component is reset to @ 0 @ after every simulation step, so it
-- is mainly used to apply a torque as opposed to being read.
newtype Torque          = Torque Double
-- | A component representing the mass of the @Body@ overall.
newtype BodyMass        = BodyMass Double deriving (BodyMass -> BodyMass -> Bool
(BodyMass -> BodyMass -> Bool)
-> (BodyMass -> BodyMass -> Bool) -> Eq BodyMass
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BodyMass -> BodyMass -> Bool
$c/= :: BodyMass -> BodyMass -> Bool
== :: BodyMass -> BodyMass -> Bool
$c== :: BodyMass -> BodyMass -> Bool
Eq, Int -> BodyMass -> ShowS
[BodyMass] -> ShowS
BodyMass -> String
(Int -> BodyMass -> ShowS)
-> (BodyMass -> String) -> ([BodyMass] -> ShowS) -> Show BodyMass
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BodyMass] -> ShowS
$cshowList :: [BodyMass] -> ShowS
show :: BodyMass -> String
$cshow :: BodyMass -> String
showsPrec :: Int -> BodyMass -> ShowS
$cshowsPrec :: Int -> BodyMass -> ShowS
Show)
-- | The moment of inertia of the @Body@.
-- This is basically the body's tendency to resist angular acceleration.
newtype Moment          = Moment Double deriving (Moment -> Moment -> Bool
(Moment -> Moment -> Bool)
-> (Moment -> Moment -> Bool) -> Eq Moment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Moment -> Moment -> Bool
$c/= :: Moment -> Moment -> Bool
== :: Moment -> Moment -> Bool
$c== :: Moment -> Moment -> Bool
Eq, Int -> Moment -> ShowS
[Moment] -> ShowS
Moment -> String
(Int -> Moment -> ShowS)
-> (Moment -> String) -> ([Moment] -> ShowS) -> Show Moment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Moment] -> ShowS
$cshowList :: [Moment] -> ShowS
show :: Moment -> String
$cshow :: Moment -> String
showsPrec :: Int -> Moment -> ShowS
$cshowsPrec :: Int -> Moment -> ShowS
Show)
newtype Angle           = Angle Double deriving (Angle -> Angle -> Bool
(Angle -> Angle -> Bool) -> (Angle -> Angle -> Bool) -> Eq Angle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Angle -> Angle -> Bool
$c/= :: Angle -> Angle -> Bool
== :: Angle -> Angle -> Bool
$c== :: Angle -> Angle -> Bool
Eq, Int -> Angle -> ShowS
[Angle] -> ShowS
Angle -> String
(Int -> Angle -> ShowS)
-> (Angle -> String) -> ([Angle] -> ShowS) -> Show Angle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Angle] -> ShowS
$cshowList :: [Angle] -> ShowS
show :: Angle -> String
$cshow :: Angle -> String
showsPrec :: Int -> Angle -> ShowS
$cshowsPrec :: Int -> Angle -> ShowS
Show)
newtype AngularVelocity = AngularVelocity Double
-- | Where the @Body@'s center of gravity is, in body-local coordinates.
-- Can be read and written to.
newtype CenterOfGravity = CenterOfGravity BVec

-- | The @Shape@s belonging to a body. Read-only.
newtype ShapeList = ShapeList [Entity]
-- | The @Constraint@s belonging to a body. Read-only.
newtype ConstraintList = ConstraintList [Entity]

-- | Shape component.
--   Adding a shape to an entity that has no @Body@ is a noop.
data Shape = Shape Entity Convex

-- | A convex polygon.
--   Consists of a list of vertices, and a radius.
data Convex = Convex [BVec] Double deriving (Convex -> Convex -> Bool
(Convex -> Convex -> Bool)
-> (Convex -> Convex -> Bool) -> Eq Convex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Convex -> Convex -> Bool
$c/= :: Convex -> Convex -> Bool
== :: Convex -> Convex -> Bool
$c== :: Convex -> Convex -> Bool
Eq, Int -> Convex -> ShowS
[Convex] -> ShowS
Convex -> String
(Int -> Convex -> ShowS)
-> (Convex -> String) -> ([Convex] -> ShowS) -> Show Convex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Convex] -> ShowS
$cshowList :: [Convex] -> ShowS
show :: Convex -> String
$cshow :: Convex -> String
showsPrec :: Int -> Convex -> ShowS
$cshowsPrec :: Int -> Convex -> ShowS
Show)

-- | If a body is a 'Sensor', it exists only to trigger collision responses.
-- It won't phyiscally interact with other bodies in any way, but it __will__
-- cause collision handlers to run. 
newtype Sensor          = Sensor          Bool       deriving (Sensor -> Sensor -> Bool
(Sensor -> Sensor -> Bool)
-> (Sensor -> Sensor -> Bool) -> Eq Sensor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sensor -> Sensor -> Bool
$c/= :: Sensor -> Sensor -> Bool
== :: Sensor -> Sensor -> Bool
$c== :: Sensor -> Sensor -> Bool
Eq, Int -> Sensor -> ShowS
[Sensor] -> ShowS
Sensor -> String
(Int -> Sensor -> ShowS)
-> (Sensor -> String) -> ([Sensor] -> ShowS) -> Show Sensor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sensor] -> ShowS
$cshowList :: [Sensor] -> ShowS
show :: Sensor -> String
$cshow :: Sensor -> String
showsPrec :: Int -> Sensor -> ShowS
$cshowsPrec :: Int -> Sensor -> ShowS
Show)
-- | The elasticity of a shape. Higher elasticities will create more
-- elastic collisions, IE, will be bouncier.
--
-- See <https://en.wikipedia.org/wiki/Elasticity_(physics)> for more information.
newtype Elasticity      = Elasticity      Double     deriving (Elasticity -> Elasticity -> Bool
(Elasticity -> Elasticity -> Bool)
-> (Elasticity -> Elasticity -> Bool) -> Eq Elasticity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Elasticity -> Elasticity -> Bool
$c/= :: Elasticity -> Elasticity -> Bool
== :: Elasticity -> Elasticity -> Bool
$c== :: Elasticity -> Elasticity -> Bool
Eq, Int -> Elasticity -> ShowS
[Elasticity] -> ShowS
Elasticity -> String
(Int -> Elasticity -> ShowS)
-> (Elasticity -> String)
-> ([Elasticity] -> ShowS)
-> Show Elasticity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Elasticity] -> ShowS
$cshowList :: [Elasticity] -> ShowS
show :: Elasticity -> String
$cshow :: Elasticity -> String
showsPrec :: Int -> Elasticity -> ShowS
$cshowsPrec :: Int -> Elasticity -> ShowS
Show)
-- | The mass of a shape is technically a measure of how much resistance it has to
-- being accelerated, but it's generally easier to understand it as being how "heavy" something is.
--
-- The physics engine lets you set this, and it will calculate the 'Density' and other components
-- for you. 
--
-- See <https://en.wikipedia.org/wiki/Mass> for more information.
newtype Mass            = Mass            Double     deriving (Mass -> Mass -> Bool
(Mass -> Mass -> Bool) -> (Mass -> Mass -> Bool) -> Eq Mass
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mass -> Mass -> Bool
$c/= :: Mass -> Mass -> Bool
== :: Mass -> Mass -> Bool
$c== :: Mass -> Mass -> Bool
Eq, Int -> Mass -> ShowS
[Mass] -> ShowS
Mass -> String
(Int -> Mass -> ShowS)
-> (Mass -> String) -> ([Mass] -> ShowS) -> Show Mass
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mass] -> ShowS
$cshowList :: [Mass] -> ShowS
show :: Mass -> String
$cshow :: Mass -> String
showsPrec :: Int -> Mass -> ShowS
$cshowsPrec :: Int -> Mass -> ShowS
Show)
-- | The density of a shape is a measure of how much mass an object has in a given volume.
-- 
-- The physics engine lets you set this, and it will calculate the 'Mass' and other components for you.
-- 
-- See <https://en.wikipedia.org/wiki/Density> for more information.
newtype Density         = Density         Double     deriving (Density -> Density -> Bool
(Density -> Density -> Bool)
-> (Density -> Density -> Bool) -> Eq Density
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Density -> Density -> Bool
$c/= :: Density -> Density -> Bool
== :: Density -> Density -> Bool
$c== :: Density -> Density -> Bool
Eq, Int -> Density -> ShowS
[Density] -> ShowS
Density -> String
(Int -> Density -> ShowS)
-> (Density -> String) -> ([Density] -> ShowS) -> Show Density
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Density] -> ShowS
$cshowList :: [Density] -> ShowS
show :: Density -> String
$cshow :: Density -> String
showsPrec :: Int -> Density -> ShowS
$cshowsPrec :: Int -> Density -> ShowS
Show)
-- | The friction of an object is a measure of how much it resists movement.
-- Shapes with high friction will naturally slow down more quickly over time than objects
-- with low friction.
--
-- See <https://en.wikipedia.org/wiki/Friction> for more information.
newtype Friction        = Friction        Double     deriving (Friction -> Friction -> Bool
(Friction -> Friction -> Bool)
-> (Friction -> Friction -> Bool) -> Eq Friction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Friction -> Friction -> Bool
$c/= :: Friction -> Friction -> Bool
== :: Friction -> Friction -> Bool
$c== :: Friction -> Friction -> Bool
Eq, Int -> Friction -> ShowS
[Friction] -> ShowS
Friction -> String
(Int -> Friction -> ShowS)
-> (Friction -> String) -> ([Friction] -> ShowS) -> Show Friction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Friction] -> ShowS
$cshowList :: [Friction] -> ShowS
show :: Friction -> String
$cshow :: Friction -> String
showsPrec :: Int -> Friction -> ShowS
$cshowsPrec :: Int -> Friction -> ShowS
Show)
newtype SurfaceVelocity = SurfaceVelocity Vec        deriving (SurfaceVelocity -> SurfaceVelocity -> Bool
(SurfaceVelocity -> SurfaceVelocity -> Bool)
-> (SurfaceVelocity -> SurfaceVelocity -> Bool)
-> Eq SurfaceVelocity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SurfaceVelocity -> SurfaceVelocity -> Bool
$c/= :: SurfaceVelocity -> SurfaceVelocity -> Bool
== :: SurfaceVelocity -> SurfaceVelocity -> Bool
$c== :: SurfaceVelocity -> SurfaceVelocity -> Bool
Eq, Int -> SurfaceVelocity -> ShowS
[SurfaceVelocity] -> ShowS
SurfaceVelocity -> String
(Int -> SurfaceVelocity -> ShowS)
-> (SurfaceVelocity -> String)
-> ([SurfaceVelocity] -> ShowS)
-> Show SurfaceVelocity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SurfaceVelocity] -> ShowS
$cshowList :: [SurfaceVelocity] -> ShowS
show :: SurfaceVelocity -> String
$cshow :: SurfaceVelocity -> String
showsPrec :: Int -> SurfaceVelocity -> ShowS
$cshowsPrec :: Int -> SurfaceVelocity -> ShowS
Show)

type CollisionGroup = CUInt

-- | Collision Filters determine what shapes this shape collides with.
--   Shapes in the same 'filterGroup' will never collide with one another.
--   This is used to ignore collisions between parts on a complex object.
--
--   'filterCategories' is a bitmask that determines what categories a shape belongs to.
--   'filterMask' is a bitmask that determines what categories it collides with.
--   See <https://chipmunk-physics.net/release/ChipmunkLatest-Docs/#cpShape-Filtering> for more information.
data CollisionFilter = CollisionFilter
  { CollisionFilter -> CollisionGroup
filterGroup      :: CollisionGroup
  , CollisionFilter -> Bitmask
filterCategories :: Bitmask
  , CollisionFilter -> Bitmask
filterMask       :: Bitmask
  } deriving (CollisionFilter -> CollisionFilter -> Bool
(CollisionFilter -> CollisionFilter -> Bool)
-> (CollisionFilter -> CollisionFilter -> Bool)
-> Eq CollisionFilter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CollisionFilter -> CollisionFilter -> Bool
$c/= :: CollisionFilter -> CollisionFilter -> Bool
== :: CollisionFilter -> CollisionFilter -> Bool
$c== :: CollisionFilter -> CollisionFilter -> Bool
Eq, Int -> CollisionFilter -> ShowS
[CollisionFilter] -> ShowS
CollisionFilter -> String
(Int -> CollisionFilter -> ShowS)
-> (CollisionFilter -> String)
-> ([CollisionFilter] -> ShowS)
-> Show CollisionFilter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CollisionFilter] -> ShowS
$cshowList :: [CollisionFilter] -> ShowS
show :: CollisionFilter -> String
$cshow :: CollisionFilter -> String
showsPrec :: Int -> CollisionFilter -> ShowS
$cshowsPrec :: Int -> CollisionFilter -> ShowS
Show)

-- | A bitmask used for collision handling
newtype Bitmask = Bitmask CUInt deriving (Bitmask -> Bitmask -> Bool
(Bitmask -> Bitmask -> Bool)
-> (Bitmask -> Bitmask -> Bool) -> Eq Bitmask
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bitmask -> Bitmask -> Bool
$c/= :: Bitmask -> Bitmask -> Bool
== :: Bitmask -> Bitmask -> Bool
$c== :: Bitmask -> Bitmask -> Bool
Eq, Eq Bitmask
Bitmask
Eq Bitmask
-> (Bitmask -> Bitmask -> Bitmask)
-> (Bitmask -> Bitmask -> Bitmask)
-> (Bitmask -> Bitmask -> Bitmask)
-> (Bitmask -> Bitmask)
-> (Bitmask -> Int -> Bitmask)
-> (Bitmask -> Int -> Bitmask)
-> Bitmask
-> (Int -> Bitmask)
-> (Bitmask -> Int -> Bitmask)
-> (Bitmask -> Int -> Bitmask)
-> (Bitmask -> Int -> Bitmask)
-> (Bitmask -> Int -> Bool)
-> (Bitmask -> Maybe Int)
-> (Bitmask -> Int)
-> (Bitmask -> Bool)
-> (Bitmask -> Int -> Bitmask)
-> (Bitmask -> Int -> Bitmask)
-> (Bitmask -> Int -> Bitmask)
-> (Bitmask -> Int -> Bitmask)
-> (Bitmask -> Int -> Bitmask)
-> (Bitmask -> Int -> Bitmask)
-> (Bitmask -> Int)
-> Bits Bitmask
Int -> Bitmask
Bitmask -> Bool
Bitmask -> Int
Bitmask -> Maybe Int
Bitmask -> Bitmask
Bitmask -> Int -> Bool
Bitmask -> Int -> Bitmask
Bitmask -> Bitmask -> Bitmask
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: Bitmask -> Int
$cpopCount :: Bitmask -> Int
rotateR :: Bitmask -> Int -> Bitmask
$crotateR :: Bitmask -> Int -> Bitmask
rotateL :: Bitmask -> Int -> Bitmask
$crotateL :: Bitmask -> Int -> Bitmask
unsafeShiftR :: Bitmask -> Int -> Bitmask
$cunsafeShiftR :: Bitmask -> Int -> Bitmask
shiftR :: Bitmask -> Int -> Bitmask
$cshiftR :: Bitmask -> Int -> Bitmask
unsafeShiftL :: Bitmask -> Int -> Bitmask
$cunsafeShiftL :: Bitmask -> Int -> Bitmask
shiftL :: Bitmask -> Int -> Bitmask
$cshiftL :: Bitmask -> Int -> Bitmask
isSigned :: Bitmask -> Bool
$cisSigned :: Bitmask -> Bool
bitSize :: Bitmask -> Int
$cbitSize :: Bitmask -> Int
bitSizeMaybe :: Bitmask -> Maybe Int
$cbitSizeMaybe :: Bitmask -> Maybe Int
testBit :: Bitmask -> Int -> Bool
$ctestBit :: Bitmask -> Int -> Bool
complementBit :: Bitmask -> Int -> Bitmask
$ccomplementBit :: Bitmask -> Int -> Bitmask
clearBit :: Bitmask -> Int -> Bitmask
$cclearBit :: Bitmask -> Int -> Bitmask
setBit :: Bitmask -> Int -> Bitmask
$csetBit :: Bitmask -> Int -> Bitmask
bit :: Int -> Bitmask
$cbit :: Int -> Bitmask
zeroBits :: Bitmask
$czeroBits :: Bitmask
rotate :: Bitmask -> Int -> Bitmask
$crotate :: Bitmask -> Int -> Bitmask
shift :: Bitmask -> Int -> Bitmask
$cshift :: Bitmask -> Int -> Bitmask
complement :: Bitmask -> Bitmask
$ccomplement :: Bitmask -> Bitmask
xor :: Bitmask -> Bitmask -> Bitmask
$cxor :: Bitmask -> Bitmask -> Bitmask
.|. :: Bitmask -> Bitmask -> Bitmask
$c.|. :: Bitmask -> Bitmask -> Bitmask
.&. :: Bitmask -> Bitmask -> Bitmask
$c.&. :: Bitmask -> Bitmask -> Bitmask
$cp1Bits :: Eq Bitmask
Bits)
instance Show Bitmask where
  show :: Bitmask -> String
show (Bitmask CollisionGroup
mask) = String
"Bitmask 0b" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CollisionGroup -> (Int -> Char) -> CollisionGroup -> ShowS
forall a. (Integral a, Show a) => a -> (Int -> Char) -> a -> ShowS
showIntAtBase CollisionGroup
2 Int -> Char
intToDigit CollisionGroup
mask String
""

data FrnSpace
data FrnVec

data Space c = Space
  { Space c -> IOMap BodyRecord
spBodies      :: IOMap BodyRecord
  , Space c -> IOMap (Record Shape)
spShapes      :: IOMap (Record Shape)
  , Space c -> IOMap (Record Constraint)
spConstraints :: IOMap (Record Constraint)
  , Space c -> IOMap (Record CollisionHandler)
spHandlers    :: IOMap (Record CollisionHandler)
  , Space c -> SpacePtr
spacePtr      :: SpacePtr
  }

type instance Elem (Space a) = a

data BodyRecord = BodyRecord
  { BodyRecord -> Ptr Body
brPtr         :: Ptr Body
  , BodyRecord -> Body
brBody        :: Body
  , BodyRecord -> IORef IntSet
brShapes      :: IORef S.IntSet
  , BodyRecord -> IORef IntSet
brConstraints :: IORef S.IntSet
  }

data Record a = Record
  { Record a -> Ptr a
recPtr :: Ptr a
  , Record a -> a
recVal :: a
  }

type IOMap a = IORef (M.IntMap a)
type PtrMap a = IOMap (Ptr a)
type SpacePtr = ForeignPtr FrnSpace

-- | Number of iterations per step, global value
newtype Iterations = Iterations Int deriving (Iterations -> Iterations -> Bool
(Iterations -> Iterations -> Bool)
-> (Iterations -> Iterations -> Bool) -> Eq Iterations
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Iterations -> Iterations -> Bool
$c/= :: Iterations -> Iterations -> Bool
== :: Iterations -> Iterations -> Bool
$c== :: Iterations -> Iterations -> Bool
Eq, Int -> Iterations -> ShowS
[Iterations] -> ShowS
Iterations -> String
(Int -> Iterations -> ShowS)
-> (Iterations -> String)
-> ([Iterations] -> ShowS)
-> Show Iterations
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Iterations] -> ShowS
$cshowList :: [Iterations] -> ShowS
show :: Iterations -> String
$cshow :: Iterations -> String
showsPrec :: Int -> Iterations -> ShowS
$cshowsPrec :: Int -> Iterations -> ShowS
Show)
-- | Gravity force vector, global value
newtype Gravity = Gravity Vec deriving (Gravity -> Gravity -> Bool
(Gravity -> Gravity -> Bool)
-> (Gravity -> Gravity -> Bool) -> Eq Gravity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Gravity -> Gravity -> Bool
$c/= :: Gravity -> Gravity -> Bool
== :: Gravity -> Gravity -> Bool
$c== :: Gravity -> Gravity -> Bool
Eq, Int -> Gravity -> ShowS
[Gravity] -> ShowS
Gravity -> String
(Int -> Gravity -> ShowS)
-> (Gravity -> String) -> ([Gravity] -> ShowS) -> Show Gravity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Gravity] -> ShowS
$cshowList :: [Gravity] -> ShowS
show :: Gravity -> String
$cshow :: Gravity -> String
showsPrec :: Int -> Gravity -> ShowS
$cshowsPrec :: Int -> Gravity -> ShowS
Show)
-- | Daming factor, global value
newtype Damping = Damping Double deriving (Damping -> Damping -> Bool
(Damping -> Damping -> Bool)
-> (Damping -> Damping -> Bool) -> Eq Damping
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Damping -> Damping -> Bool
$c/= :: Damping -> Damping -> Bool
== :: Damping -> Damping -> Bool
$c== :: Damping -> Damping -> Bool
Eq, Int -> Damping -> ShowS
[Damping] -> ShowS
Damping -> String
(Int -> Damping -> ShowS)
-> (Damping -> String) -> ([Damping] -> ShowS) -> Show Damping
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Damping] -> ShowS
$cshowList :: [Damping] -> ShowS
show :: Damping -> String
$cshow :: Damping -> String
showsPrec :: Int -> Damping -> ShowS
$cshowsPrec :: Int -> Damping -> ShowS
Show)
-- | Speed threshold to be considered idle, and a candidate for being put to sleep. Global value.
-- Bodies with a speed less than this will not be simulated until a force acts upon them,
-- which can potentially lead to large gains in performance, especially if there's a lot of
-- inactive bodies in the simulation.
newtype IdleSpeedThreshold = IdleSpeedThreshold Double deriving (IdleSpeedThreshold -> IdleSpeedThreshold -> Bool
(IdleSpeedThreshold -> IdleSpeedThreshold -> Bool)
-> (IdleSpeedThreshold -> IdleSpeedThreshold -> Bool)
-> Eq IdleSpeedThreshold
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IdleSpeedThreshold -> IdleSpeedThreshold -> Bool
$c/= :: IdleSpeedThreshold -> IdleSpeedThreshold -> Bool
== :: IdleSpeedThreshold -> IdleSpeedThreshold -> Bool
$c== :: IdleSpeedThreshold -> IdleSpeedThreshold -> Bool
Eq, Int -> IdleSpeedThreshold -> ShowS
[IdleSpeedThreshold] -> ShowS
IdleSpeedThreshold -> String
(Int -> IdleSpeedThreshold -> ShowS)
-> (IdleSpeedThreshold -> String)
-> ([IdleSpeedThreshold] -> ShowS)
-> Show IdleSpeedThreshold
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdleSpeedThreshold] -> ShowS
$cshowList :: [IdleSpeedThreshold] -> ShowS
show :: IdleSpeedThreshold -> String
$cshow :: IdleSpeedThreshold -> String
showsPrec :: Int -> IdleSpeedThreshold -> ShowS
$cshowsPrec :: Int -> IdleSpeedThreshold -> ShowS
Show)
-- | Sleep idle time threshold, global value
newtype SleepIdleTime = SleepIdleTime Double deriving (SleepIdleTime -> SleepIdleTime -> Bool
(SleepIdleTime -> SleepIdleTime -> Bool)
-> (SleepIdleTime -> SleepIdleTime -> Bool) -> Eq SleepIdleTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SleepIdleTime -> SleepIdleTime -> Bool
$c/= :: SleepIdleTime -> SleepIdleTime -> Bool
== :: SleepIdleTime -> SleepIdleTime -> Bool
$c== :: SleepIdleTime -> SleepIdleTime -> Bool
Eq, Int -> SleepIdleTime -> ShowS
[SleepIdleTime] -> ShowS
SleepIdleTime -> String
(Int -> SleepIdleTime -> ShowS)
-> (SleepIdleTime -> String)
-> ([SleepIdleTime] -> ShowS)
-> Show SleepIdleTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SleepIdleTime] -> ShowS
$cshowList :: [SleepIdleTime] -> ShowS
show :: SleepIdleTime -> String
$cshow :: SleepIdleTime -> String
showsPrec :: Int -> SleepIdleTime -> ShowS
$cshowsPrec :: Int -> SleepIdleTime -> ShowS
Show)
-- | Collision parameter, global value
newtype CollisionSlop = CollisionSlop Double deriving (CollisionSlop -> CollisionSlop -> Bool
(CollisionSlop -> CollisionSlop -> Bool)
-> (CollisionSlop -> CollisionSlop -> Bool) -> Eq CollisionSlop
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CollisionSlop -> CollisionSlop -> Bool
$c/= :: CollisionSlop -> CollisionSlop -> Bool
== :: CollisionSlop -> CollisionSlop -> Bool
$c== :: CollisionSlop -> CollisionSlop -> Bool
Eq, Int -> CollisionSlop -> ShowS
[CollisionSlop] -> ShowS
CollisionSlop -> String
(Int -> CollisionSlop -> ShowS)
-> (CollisionSlop -> String)
-> ([CollisionSlop] -> ShowS)
-> Show CollisionSlop
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CollisionSlop] -> ShowS
$cshowList :: [CollisionSlop] -> ShowS
show :: CollisionSlop -> String
$cshow :: CollisionSlop -> String
showsPrec :: Int -> CollisionSlop -> ShowS
$cshowsPrec :: Int -> CollisionSlop -> ShowS
Show)
-- | Collision parameter, global value
newtype CollisionBias = CollisionBias Double deriving (CollisionBias -> CollisionBias -> Bool
(CollisionBias -> CollisionBias -> Bool)
-> (CollisionBias -> CollisionBias -> Bool) -> Eq CollisionBias
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CollisionBias -> CollisionBias -> Bool
$c/= :: CollisionBias -> CollisionBias -> Bool
== :: CollisionBias -> CollisionBias -> Bool
$c== :: CollisionBias -> CollisionBias -> Bool
Eq, Int -> CollisionBias -> ShowS
[CollisionBias] -> ShowS
CollisionBias -> String
(Int -> CollisionBias -> ShowS)
-> (CollisionBias -> String)
-> ([CollisionBias] -> ShowS)
-> Show CollisionBias
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CollisionBias] -> ShowS
$cshowList :: [CollisionBias] -> ShowS
show :: CollisionBias -> String
$cshow :: CollisionBias -> String
showsPrec :: Int -> CollisionBias -> ShowS
$cshowsPrec :: Int -> CollisionBias -> ShowS
Show)

cast :: Space a -> Space b
cast :: Space a -> Space b
cast (Space IOMap BodyRecord
b IOMap (Record Shape)
s IOMap (Record Constraint)
c IOMap (Record CollisionHandler)
h SpacePtr
w) = IOMap BodyRecord
-> IOMap (Record Shape)
-> IOMap (Record Constraint)
-> IOMap (Record CollisionHandler)
-> SpacePtr
-> Space b
forall c.
IOMap BodyRecord
-> IOMap (Record Shape)
-> IOMap (Record Constraint)
-> IOMap (Record CollisionHandler)
-> SpacePtr
-> Space c
Space IOMap BodyRecord
b IOMap (Record Shape)
s IOMap (Record Constraint)
c IOMap (Record CollisionHandler)
h SpacePtr
w

-- Constraint subcomponents
newtype MaxForce      = MaxForce      Double deriving (MaxForce -> MaxForce -> Bool
(MaxForce -> MaxForce -> Bool)
-> (MaxForce -> MaxForce -> Bool) -> Eq MaxForce
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MaxForce -> MaxForce -> Bool
$c/= :: MaxForce -> MaxForce -> Bool
== :: MaxForce -> MaxForce -> Bool
$c== :: MaxForce -> MaxForce -> Bool
Eq, Int -> MaxForce -> ShowS
[MaxForce] -> ShowS
MaxForce -> String
(Int -> MaxForce -> ShowS)
-> (MaxForce -> String) -> ([MaxForce] -> ShowS) -> Show MaxForce
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MaxForce] -> ShowS
$cshowList :: [MaxForce] -> ShowS
show :: MaxForce -> String
$cshow :: MaxForce -> String
showsPrec :: Int -> MaxForce -> ShowS
$cshowsPrec :: Int -> MaxForce -> ShowS
Show)
newtype MaxBias       = MaxBias       Double deriving (MaxBias -> MaxBias -> Bool
(MaxBias -> MaxBias -> Bool)
-> (MaxBias -> MaxBias -> Bool) -> Eq MaxBias
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MaxBias -> MaxBias -> Bool
$c/= :: MaxBias -> MaxBias -> Bool
== :: MaxBias -> MaxBias -> Bool
$c== :: MaxBias -> MaxBias -> Bool
Eq, Int -> MaxBias -> ShowS
[MaxBias] -> ShowS
MaxBias -> String
(Int -> MaxBias -> ShowS)
-> (MaxBias -> String) -> ([MaxBias] -> ShowS) -> Show MaxBias
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MaxBias] -> ShowS
$cshowList :: [MaxBias] -> ShowS
show :: MaxBias -> String
$cshow :: MaxBias -> String
showsPrec :: Int -> MaxBias -> ShowS
$cshowsPrec :: Int -> MaxBias -> ShowS
Show)
newtype ErrorBias     = ErrorBias     Double deriving (ErrorBias -> ErrorBias -> Bool
(ErrorBias -> ErrorBias -> Bool)
-> (ErrorBias -> ErrorBias -> Bool) -> Eq ErrorBias
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorBias -> ErrorBias -> Bool
$c/= :: ErrorBias -> ErrorBias -> Bool
== :: ErrorBias -> ErrorBias -> Bool
$c== :: ErrorBias -> ErrorBias -> Bool
Eq, Int -> ErrorBias -> ShowS
[ErrorBias] -> ShowS
ErrorBias -> String
(Int -> ErrorBias -> ShowS)
-> (ErrorBias -> String)
-> ([ErrorBias] -> ShowS)
-> Show ErrorBias
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorBias] -> ShowS
$cshowList :: [ErrorBias] -> ShowS
show :: ErrorBias -> String
$cshow :: ErrorBias -> String
showsPrec :: Int -> ErrorBias -> ShowS
$cshowsPrec :: Int -> ErrorBias -> ShowS
Show)
newtype CollideBodies = CollideBodies Bool   deriving (CollideBodies -> CollideBodies -> Bool
(CollideBodies -> CollideBodies -> Bool)
-> (CollideBodies -> CollideBodies -> Bool) -> Eq CollideBodies
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CollideBodies -> CollideBodies -> Bool
$c/= :: CollideBodies -> CollideBodies -> Bool
== :: CollideBodies -> CollideBodies -> Bool
$c== :: CollideBodies -> CollideBodies -> Bool
Eq, Int -> CollideBodies -> ShowS
[CollideBodies] -> ShowS
CollideBodies -> String
(Int -> CollideBodies -> ShowS)
-> (CollideBodies -> String)
-> ([CollideBodies] -> ShowS)
-> Show CollideBodies
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CollideBodies] -> ShowS
$cshowList :: [CollideBodies] -> ShowS
show :: CollideBodies -> String
$cshow :: CollideBodies -> String
showsPrec :: Int -> CollideBodies -> ShowS
$cshowsPrec :: Int -> CollideBodies -> ShowS
Show)
newtype Impulse       = Impulse       Double deriving (Impulse -> Impulse -> Bool
(Impulse -> Impulse -> Bool)
-> (Impulse -> Impulse -> Bool) -> Eq Impulse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Impulse -> Impulse -> Bool
$c/= :: Impulse -> Impulse -> Bool
== :: Impulse -> Impulse -> Bool
$c== :: Impulse -> Impulse -> Bool
Eq, Int -> Impulse -> ShowS
[Impulse] -> ShowS
Impulse -> String
(Int -> Impulse -> ShowS)
-> (Impulse -> String) -> ([Impulse] -> ShowS) -> Show Impulse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Impulse] -> ShowS
$cshowList :: [Impulse] -> ShowS
show :: Impulse -> String
$cshow :: Impulse -> String
showsPrec :: Int -> Impulse -> ShowS
$cshowsPrec :: Int -> Impulse -> ShowS
Show)

data Constraint = Constraint Entity Entity ConstraintType deriving (Constraint -> Constraint -> Bool
(Constraint -> Constraint -> Bool)
-> (Constraint -> Constraint -> Bool) -> Eq Constraint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Constraint -> Constraint -> Bool
$c/= :: Constraint -> Constraint -> Bool
== :: Constraint -> Constraint -> Bool
$c== :: Constraint -> Constraint -> Bool
Eq, Int -> Constraint -> ShowS
[Constraint] -> ShowS
Constraint -> String
(Int -> Constraint -> ShowS)
-> (Constraint -> String)
-> ([Constraint] -> ShowS)
-> Show Constraint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Constraint] -> ShowS
$cshowList :: [Constraint] -> ShowS
show :: Constraint -> String
$cshow :: Constraint -> String
showsPrec :: Int -> Constraint -> ShowS
$cshowsPrec :: Int -> Constraint -> ShowS
Show)

data ConstraintType
  = PinJoint BVec BVec -- ^ Maintains a fixed distance between two anchor points
  | SlideJoint BVec BVec Double Double -- ^ A @PinJoint@ with minimum and maximum distance
  | PivotJoint WVec -- ^ Creates a pivot point at the given world coordinate
  | PivotJoint2 BVec BVec -- ^ Creates a pivot point at the given body coordinates
  | GrooveJoint BVec BVec BVec -- ^ The first two vectors are the start and end of the groove on body A, the third argument is the anchor point on body B.
  | DampedSpring BVec BVec Double Double Double -- ^ Spring between two anchor points, with given rest length, stiffness, and damping.
  | DampedRotarySpring Double Double Double -- ^ Rotary sping, with given rest angle, stiffness, and damping.
  | RotaryLimitJoint Double Double -- ^ Joint with minimum and maximum angle
  | RatchetJoint Double Double -- ^ Rathet joint with given phase and ratchet (distance between clicks).
  | GearJoint Double Double -- Keeps angular velocity ratio constant. The first argument is phase, the initial offset, the second argument is the ratio
  | SimpleMotor Double -- ^ Keeps relative angular velocity constant
  deriving (ConstraintType -> ConstraintType -> Bool
(ConstraintType -> ConstraintType -> Bool)
-> (ConstraintType -> ConstraintType -> Bool) -> Eq ConstraintType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConstraintType -> ConstraintType -> Bool
$c/= :: ConstraintType -> ConstraintType -> Bool
== :: ConstraintType -> ConstraintType -> Bool
$c== :: ConstraintType -> ConstraintType -> Bool
Eq, Int -> ConstraintType -> ShowS
[ConstraintType] -> ShowS
ConstraintType -> String
(Int -> ConstraintType -> ShowS)
-> (ConstraintType -> String)
-> ([ConstraintType] -> ShowS)
-> Show ConstraintType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConstraintType] -> ShowS
$cshowList :: [ConstraintType] -> ShowS
show :: ConstraintType -> String
$cshow :: ConstraintType -> String
showsPrec :: Int -> ConstraintType -> ShowS
$cshowsPrec :: Int -> ConstraintType -> ShowS
Show)

-- TODO
-- getPinJointDistance
-- getSlideJointDistance?


newtype BeginCB     = BeginCB     BeginFunc
newtype SeparateCB  = SeparateCB  SeparateFunc
newtype PreSolveCB  = PreSolveCB  PreSolveFunc
newtype PostSolveCB = PostSolveCB PostSolveFunc

-- Collision, Space, Handler data pointer
type BeginFunc     = Ptr Collision -> Ptr FrnSpace -> C.CUInt -> IO C.CUChar
type SeparateFunc  = Ptr Collision -> Ptr FrnSpace -> C.CUInt -> IO ()
type PreSolveFunc  = Ptr Collision -> Ptr FrnSpace -> C.CUInt -> IO C.CUChar
type PostSolveFunc = Ptr Collision -> Ptr FrnSpace -> C.CUInt -> IO ()

data CollisionHandler = CollisionHandler
  { CollisionHandler -> CollisionSource
source      :: CollisionSource
  , CollisionHandler -> Maybe BeginCB
beginCB     :: Maybe BeginCB
  -- ^ A callback called when two bodies start touching for the first time.
  -- If it returns 'True', the physics engine will process the collision normally.
  -- If it returns 'False', the physics engine will __ignore the collision entirely__.
  , CollisionHandler -> Maybe SeparateCB
separateCB  :: Maybe SeparateCB
  -- ^ A callback called when two bodies have just stopped touching. This will
  -- __always__ be called if 'beginCB' is, regardless of the return value of 'beginCB'.
  , CollisionHandler -> Maybe PreSolveCB
preSolveCB  :: Maybe PreSolveCB
  -- ^ A callback called when two bodies are touching during a physics step. If this function
  -- returns 'True', the collision will be processed normally. If it returns 'False, then
    -- the physics engine will stop processing the collision for this step.
  , CollisionHandler -> Maybe PostSolveCB
postSolveCB :: Maybe PostSolveCB
  -- ^ A callback called when two bodies are touching __after__ the response to the collision
  -- has been processed. This means that you can determine the collision impulse or kinetic energy
  -- in this callback, if you need that for processing.
  }

-- | A 'Shape' can have a 'CollisionType'.
--   'CollisionType's are used by callbacks for filtering, also see 'CollisionSource'.
--   The difference between 'CollisionType' and 'CollisionFilter' is that a 'CollisionFilter' determines whether
--   two shapes in the physics engine collide, or pass through one another, whereas a 'CollisionType' determines
--   what callback is called.
--   In general, if you don't want any special checks to happen, use 'CollisionFilter'.
newtype CollisionType = CollisionType C.CUIntPtr
  deriving (Integer -> CollisionType
CollisionType -> CollisionType
CollisionType -> CollisionType -> CollisionType
(CollisionType -> CollisionType -> CollisionType)
-> (CollisionType -> CollisionType -> CollisionType)
-> (CollisionType -> CollisionType -> CollisionType)
-> (CollisionType -> CollisionType)
-> (CollisionType -> CollisionType)
-> (CollisionType -> CollisionType)
-> (Integer -> CollisionType)
-> Num CollisionType
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> CollisionType
$cfromInteger :: Integer -> CollisionType
signum :: CollisionType -> CollisionType
$csignum :: CollisionType -> CollisionType
abs :: CollisionType -> CollisionType
$cabs :: CollisionType -> CollisionType
negate :: CollisionType -> CollisionType
$cnegate :: CollisionType -> CollisionType
* :: CollisionType -> CollisionType -> CollisionType
$c* :: CollisionType -> CollisionType -> CollisionType
- :: CollisionType -> CollisionType -> CollisionType
$c- :: CollisionType -> CollisionType -> CollisionType
+ :: CollisionType -> CollisionType -> CollisionType
$c+ :: CollisionType -> CollisionType -> CollisionType
Num, CollisionType -> CollisionType -> Bool
(CollisionType -> CollisionType -> Bool)
-> (CollisionType -> CollisionType -> Bool) -> Eq CollisionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CollisionType -> CollisionType -> Bool
$c/= :: CollisionType -> CollisionType -> Bool
== :: CollisionType -> CollisionType -> Bool
$c== :: CollisionType -> CollisionType -> Bool
Eq, Int -> CollisionType -> ShowS
[CollisionType] -> ShowS
CollisionType -> String
(Int -> CollisionType -> ShowS)
-> (CollisionType -> String)
-> ([CollisionType] -> ShowS)
-> Show CollisionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CollisionType] -> ShowS
$cshowList :: [CollisionType] -> ShowS
show :: CollisionType -> String
$cshow :: CollisionType -> String
showsPrec :: Int -> CollisionType -> ShowS
$cshowsPrec :: Int -> CollisionType -> ShowS
Show)

-- | A 'CollisionSource' determines what types of collisions a callback handles.
--   Also see 'CollisionType'
data CollisionSource
  = Wildcard CollisionType
  | Between CollisionType CollisionType

-- Corresponds to an 'arbiter' in Chipmunk
data Collision = Collision
  { Collision -> Vec
collisionNormal :: Vec
  , Collision -> Entity
collisionBodyA  :: Entity
  , Collision -> Entity
collisionBodyB  :: Entity
  , Collision -> Entity
collisionShapeA :: Entity
  , Collision -> Entity
collisionShapeB :: Entity
  } deriving (Collision -> Collision -> Bool
(Collision -> Collision -> Bool)
-> (Collision -> Collision -> Bool) -> Eq Collision
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Collision -> Collision -> Bool
$c/= :: Collision -> Collision -> Bool
== :: Collision -> Collision -> Bool
$c== :: Collision -> Collision -> Bool
Eq, Int -> Collision -> ShowS
[Collision] -> ShowS
Collision -> String
(Int -> Collision -> ShowS)
-> (Collision -> String)
-> ([Collision] -> ShowS)
-> Show Collision
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Collision] -> ShowS
$cshowList :: [Collision] -> ShowS
show :: Collision -> String
$cshow :: Collision -> String
showsPrec :: Int -> Collision -> ShowS
$cshowsPrec :: Int -> Collision -> ShowS
Show)

data CollisionProperties = CollisionProperties
  { CollisionProperties -> Double
collisionElasticity      :: Double
  , CollisionProperties -> Double
collisionFriction        :: Double
  , CollisionProperties -> Vec
collisionSurfaceVelocity :: Vec
  } deriving (CollisionProperties -> CollisionProperties -> Bool
(CollisionProperties -> CollisionProperties -> Bool)
-> (CollisionProperties -> CollisionProperties -> Bool)
-> Eq CollisionProperties
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CollisionProperties -> CollisionProperties -> Bool
$c/= :: CollisionProperties -> CollisionProperties -> Bool
== :: CollisionProperties -> CollisionProperties -> Bool
$c== :: CollisionProperties -> CollisionProperties -> Bool
Eq, Int -> CollisionProperties -> ShowS
[CollisionProperties] -> ShowS
CollisionProperties -> String
(Int -> CollisionProperties -> ShowS)
-> (CollisionProperties -> String)
-> ([CollisionProperties] -> ShowS)
-> Show CollisionProperties
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CollisionProperties] -> ShowS
$cshowList :: [CollisionProperties] -> ShowS
show :: CollisionProperties -> String
$cshow :: CollisionProperties -> String
showsPrec :: Int -> CollisionProperties -> ShowS
$cshowsPrec :: Int -> CollisionProperties -> ShowS
Show)

data SegmentQueryResult = SegmentQueryResult
  { SegmentQueryResult -> Entity
sqShape        :: Entity
  -- ^ What entity did this query connect with?
  , SegmentQueryResult -> Vec
sqImpactPoint  :: Vec
  -- ^ The point that the segment impacted with the shape
  , SegmentQueryResult -> Vec
sqImpactNormal :: Vec
  -- ^ The normal of the surface that the segment hit
  , SegmentQueryResult -> Double
sqImpactAlpha  :: Double
  -- ^ The normalized distance along the query segment in the range `[0, 1]`.
  -- Multiply it by the length of the segment to get the distance away the shape is.
  } deriving (SegmentQueryResult -> SegmentQueryResult -> Bool
(SegmentQueryResult -> SegmentQueryResult -> Bool)
-> (SegmentQueryResult -> SegmentQueryResult -> Bool)
-> Eq SegmentQueryResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SegmentQueryResult -> SegmentQueryResult -> Bool
$c/= :: SegmentQueryResult -> SegmentQueryResult -> Bool
== :: SegmentQueryResult -> SegmentQueryResult -> Bool
$c== :: SegmentQueryResult -> SegmentQueryResult -> Bool
Eq, Int -> SegmentQueryResult -> ShowS
[SegmentQueryResult] -> ShowS
SegmentQueryResult -> String
(Int -> SegmentQueryResult -> ShowS)
-> (SegmentQueryResult -> String)
-> ([SegmentQueryResult] -> ShowS)
-> Show SegmentQueryResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SegmentQueryResult] -> ShowS
$cshowList :: [SegmentQueryResult] -> ShowS
show :: SegmentQueryResult -> String
$cshow :: SegmentQueryResult -> String
showsPrec :: Int -> SegmentQueryResult -> ShowS
$cshowsPrec :: Int -> SegmentQueryResult -> ShowS
Show)

data PointQueryResult = PointQueryResult
  { PointQueryResult -> Entity
pqShape    :: Entity
  -- ^ What entity did this query connect with?
  , PointQueryResult -> Vec
pqPoint    :: WVec
  -- ^ The closest point on the shape's surface (in world space)
  , PointQueryResult -> Double
pqDistance :: Double
  -- ^ The distance to the queried point
  , PointQueryResult -> Vec
pqGradient :: Vec
  -- ^ The gradient of the distance function.
  -- This should be similar to 'pqPoint'/'pqDistance' but accurate even for
  -- very small distances.
  } deriving (PointQueryResult -> PointQueryResult -> Bool
(PointQueryResult -> PointQueryResult -> Bool)
-> (PointQueryResult -> PointQueryResult -> Bool)
-> Eq PointQueryResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PointQueryResult -> PointQueryResult -> Bool
$c/= :: PointQueryResult -> PointQueryResult -> Bool
== :: PointQueryResult -> PointQueryResult -> Bool
$c== :: PointQueryResult -> PointQueryResult -> Bool
Eq, Int -> PointQueryResult -> ShowS
[PointQueryResult] -> ShowS
PointQueryResult -> String
(Int -> PointQueryResult -> ShowS)
-> (PointQueryResult -> String)
-> ([PointQueryResult] -> ShowS)
-> Show PointQueryResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PointQueryResult] -> ShowS
$cshowList :: [PointQueryResult] -> ShowS
show :: PointQueryResult -> String
$cshow :: PointQueryResult -> String
showsPrec :: Int -> PointQueryResult -> ShowS
$cshowsPrec :: Int -> PointQueryResult -> ShowS
Show)