{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
module Apecs.Physics.Constraint
(
) where
import Apecs
import Apecs.Core
import Control.Monad
import Control.Monad.IO.Class (liftIO, MonadIO)
import qualified Data.IntMap as M
import qualified Data.IntSet as S
import Data.IORef
import qualified Data.Vector.Unboxed as U
import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Ptr
import qualified Language.C.Inline as C
import Linear.V2
import Apecs.Physics.Space ()
import Apecs.Physics.Types
C.context phycsCtx
C.include "<chipmunk.h>"
newConstraint :: SpacePtr -> Ptr Body -> Ptr Body -> Int -> ConstraintType -> IO (Ptr Constraint)
newConstraint :: SpacePtr
-> Ptr Body
-> Ptr Body
-> Int
-> ConstraintType
-> IO (Ptr Constraint)
newConstraint SpacePtr
spacePtr Ptr Body
bodyA Ptr Body
bodyB (forall a b. (Integral a, Num b) => a -> b
fromIntegral -> CIntPtr
ety)
(PinJoint (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Real a, Fractional b) => a -> b
realToFrac -> V2 CDouble
ax CDouble
ay) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Real a, Fractional b) => a -> b
realToFrac -> V2 CDouble
bx CDouble
by)) =
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr SpacePtr
spacePtr forall a b. (a -> b) -> a -> b
$ \Ptr FrnSpace
space -> [C.block| cpConstraint* {
cpVect anchorA = cpv( $(double ax), $(double ay) );
cpVect anchorB = cpv( $(double bx), $(double by) );
cpConstraint* constraint = cpPinJointNew($(cpBody* bodyA), $(cpBody* bodyB),anchorA,anchorB);
cpConstraintSetUserData(constraint, (void*) $(intptr_t ety));
return cpSpaceAddConstraint($(cpSpace* space), constraint);
} |]
newConstraint SpacePtr
spacePtr Ptr Body
bodyA Ptr Body
bodyB (forall a b. (Integral a, Num b) => a -> b
fromIntegral -> CIntPtr
ety)
(SlideJoint (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Real a, Fractional b) => a -> b
realToFrac -> V2 CDouble
ax CDouble
ay) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Real a, Fractional b) => a -> b
realToFrac -> V2 CDouble
bx CDouble
by) (forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
min) (forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
max)) =
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr SpacePtr
spacePtr forall a b. (a -> b) -> a -> b
$ \Ptr FrnSpace
space -> [C.block| cpConstraint* {
cpVect anchorA = cpv( $(double ax), $(double ay) );
cpVect anchorB = cpv( $(double bx), $(double by) );
cpConstraint* constraint = cpSlideJointNew($(cpBody* bodyA), $(cpBody* bodyB),anchorA,anchorB,$(double min),$(double max));
cpConstraintSetUserData(constraint, (void*) $(intptr_t ety));
return cpSpaceAddConstraint($(cpSpace* space), constraint);
} |]
newConstraint SpacePtr
spacePtr Ptr Body
bodyA Ptr Body
bodyB (forall a b. (Integral a, Num b) => a -> b
fromIntegral -> CIntPtr
ety)
(PivotJoint (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Real a, Fractional b) => a -> b
realToFrac -> V2 CDouble
x CDouble
y)) =
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr SpacePtr
spacePtr forall a b. (a -> b) -> a -> b
$ \Ptr FrnSpace
space -> [C.block| cpConstraint* {
cpVect anchor = cpv( $(double x), $(double y) );
cpConstraint* constraint = cpPivotJointNew($(cpBody* bodyA), $(cpBody* bodyB), anchor);
cpConstraintSetUserData(constraint, (void*) $(intptr_t ety));
return cpSpaceAddConstraint($(cpSpace* space), constraint);
} |]
newConstraint SpacePtr
spacePtr Ptr Body
bodyA Ptr Body
bodyB (forall a b. (Integral a, Num b) => a -> b
fromIntegral -> CIntPtr
ety)
(PivotJoint2 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Real a, Fractional b) => a -> b
realToFrac -> V2 CDouble
ax CDouble
ay) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Real a, Fractional b) => a -> b
realToFrac -> V2 CDouble
bx CDouble
by)) =
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr SpacePtr
spacePtr forall a b. (a -> b) -> a -> b
$ \Ptr FrnSpace
space -> [C.block| cpConstraint* {
cpVect va = cpv( $(double ax), $(double ay) );
cpVect vb = cpv( $(double bx), $(double by) );
cpConstraint* constraint = cpPivotJointNew2($(cpBody* bodyA), $(cpBody* bodyB), va, vb);
cpConstraintSetUserData(constraint, (void*) $(intptr_t ety));
return cpSpaceAddConstraint($(cpSpace* space), constraint);
} |]
newConstraint SpacePtr
spacePtr Ptr Body
bodyA Ptr Body
bodyB (forall a b. (Integral a, Num b) => a -> b
fromIntegral -> CIntPtr
ety)
(GrooveJoint (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Real a, Fractional b) => a -> b
realToFrac -> V2 CDouble
ax CDouble
ay) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Real a, Fractional b) => a -> b
realToFrac -> V2 CDouble
bx CDouble
by) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Real a, Fractional b) => a -> b
realToFrac -> V2 CDouble
ancx CDouble
ancy)) =
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr SpacePtr
spacePtr forall a b. (a -> b) -> a -> b
$ \Ptr FrnSpace
space -> [C.block| cpConstraint* {
cpVect va = cpv( $(double ax), $(double ay) );
cpVect vb = cpv( $(double bx), $(double by) );
cpVect anchor = cpv( $(double ancx), $(double ancy) );
cpConstraint* constraint = cpGrooveJointNew($(cpBody* bodyA), $(cpBody* bodyB), va, vb, anchor);
cpConstraintSetUserData(constraint, (void*) $(intptr_t ety));
return cpSpaceAddConstraint($(cpSpace* space), constraint);
} |]
newConstraint SpacePtr
spacePtr Ptr Body
bodyA Ptr Body
bodyB (forall a b. (Integral a, Num b) => a -> b
fromIntegral -> CIntPtr
ety)
(DampedSpring (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Real a, Fractional b) => a -> b
realToFrac -> V2 CDouble
ax CDouble
ay) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Real a, Fractional b) => a -> b
realToFrac -> V2 CDouble
bx CDouble
by) (forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
rl) (forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
stf) (forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
damping)) =
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr SpacePtr
spacePtr forall a b. (a -> b) -> a -> b
$ \Ptr FrnSpace
space -> [C.block| cpConstraint* {
cpVect va = cpv( $(double ax), $(double ay) );
cpVect vb = cpv( $(double bx), $(double by) );
cpConstraint* constraint = cpDampedSpringNew($(cpBody* bodyA), $(cpBody* bodyB), va, vb, $(double rl), $(double stf), $(double damping));
cpConstraintSetUserData(constraint, (void*) $(intptr_t ety));
return cpSpaceAddConstraint($(cpSpace* space), constraint);
} |]
newConstraint SpacePtr
spacePtr Ptr Body
bodyA Ptr Body
bodyB (forall a b. (Integral a, Num b) => a -> b
fromIntegral -> CIntPtr
ety)
(DampedRotarySpring (forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
ra) (forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
stf) (forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
damping)) =
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr SpacePtr
spacePtr forall a b. (a -> b) -> a -> b
$ \Ptr FrnSpace
space -> [C.block| cpConstraint* {
cpConstraint* constraint = cpDampedRotarySpringNew($(cpBody* bodyA), $(cpBody* bodyB), $(double ra), $(double stf), $(double damping));
cpConstraintSetUserData(constraint, (void*) $(intptr_t ety));
return cpSpaceAddConstraint($(cpSpace* space), constraint);
} |]
newConstraint SpacePtr
spacePtr Ptr Body
bodyA Ptr Body
bodyB (forall a b. (Integral a, Num b) => a -> b
fromIntegral -> CIntPtr
ety)
(RotaryLimitJoint (forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
min) (forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
max)) =
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr SpacePtr
spacePtr forall a b. (a -> b) -> a -> b
$ \Ptr FrnSpace
space -> [C.block| cpConstraint* {
cpConstraint* constraint = cpRotaryLimitJointNew($(cpBody* bodyA), $(cpBody* bodyB), $(double min), $(double max));
cpConstraintSetUserData(constraint, (void*) $(intptr_t ety));
return cpSpaceAddConstraint($(cpSpace* space), constraint);
} |]
newConstraint SpacePtr
spacePtr Ptr Body
bodyA Ptr Body
bodyB (forall a b. (Integral a, Num b) => a -> b
fromIntegral -> CIntPtr
ety)
(RatchetJoint (forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
phase) (forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
ratchet)) =
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr SpacePtr
spacePtr forall a b. (a -> b) -> a -> b
$ \Ptr FrnSpace
space -> [C.block| cpConstraint* {
cpConstraint* constraint = cpRatchetJointNew($(cpBody* bodyA), $(cpBody* bodyB), $(double phase), $(double ratchet));
cpConstraintSetUserData(constraint, (void*) $(intptr_t ety));
return cpSpaceAddConstraint($(cpSpace* space), constraint);
} |]
newConstraint SpacePtr
spacePtr Ptr Body
bodyA Ptr Body
bodyB (forall a b. (Integral a, Num b) => a -> b
fromIntegral -> CIntPtr
ety)
(GearJoint (forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
phase) (forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
ratio)) =
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr SpacePtr
spacePtr forall a b. (a -> b) -> a -> b
$ \Ptr FrnSpace
space -> [C.block| cpConstraint* {
cpConstraint* constraint = cpGearJointNew($(cpBody* bodyA), $(cpBody* bodyB), $(double phase), $(double ratio));
cpConstraintSetUserData(constraint, (void*) $(intptr_t ety));
return cpSpaceAddConstraint($(cpSpace* space), constraint);
} |]
newConstraint SpacePtr
spacePtr Ptr Body
bodyA Ptr Body
bodyB (forall a b. (Integral a, Num b) => a -> b
fromIntegral -> CIntPtr
ety)
(SimpleMotor (forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
rate)) =
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr SpacePtr
spacePtr forall a b. (a -> b) -> a -> b
$ \Ptr FrnSpace
space -> [C.block| cpConstraint* {
cpConstraint* constraint = cpSimpleMotorNew($(cpBody* bodyA), $(cpBody* bodyB), $(double rate));
cpConstraintSetUserData(constraint, (void*) $(intptr_t ety));
return cpSpaceAddConstraint($(cpSpace* space), constraint);
} |]
destroyConstraint :: SpacePtr -> Ptr Constraint -> IO ()
destroyConstraint :: SpacePtr -> Ptr Constraint -> IO ()
destroyConstraint SpacePtr
spacePtr Ptr Constraint
constraintPtr = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr SpacePtr
spacePtr forall a b. (a -> b) -> a -> b
$ \Ptr FrnSpace
space -> [C.block| void {
cpConstraint *constraint = $(cpConstraint* constraintPtr);
cpSpaceRemoveConstraint($(cpSpace* space), constraint);
cpConstraintFree(constraint); }|]
instance Component Constraint where
type Storage Constraint = Space Constraint
instance (MonadIO m, Has w m Physics) => Has w m Constraint where
getStore :: SystemT w m (Storage Constraint)
getStore = (forall a b. Space a -> Space b
cast :: Space Physics -> Space Constraint) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
instance MonadIO m => ExplSet m (Space Constraint) where
explSet :: Space Constraint -> Int -> Elem (Space Constraint) -> m ()
explSet sp :: Space Constraint
sp@(Space IOMap BodyRecord
bMap IOMap (Record Shape)
_ IOMap (Record Constraint)
cMap IOMap (Record CollisionHandler)
_ SpacePtr
spcPtr) Int
cEty cons :: Elem (Space Constraint)
cons@(Constraint (Entity Int
bEtyA) (Entity Int
bEtyB) ConstraintType
ctype) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *) s. ExplDestroy m s => s -> Int -> m ()
explDestroy Space Constraint
sp Int
cEty
Maybe BodyRecord
mBrA <- forall a. Int -> IntMap a -> Maybe a
M.lookup Int
bEtyA forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IOMap BodyRecord
bMap
Maybe BodyRecord
mBrB <- forall a. Int -> IntMap a -> Maybe a
M.lookup Int
bEtyB forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IOMap BodyRecord
bMap
case (Maybe BodyRecord
mBrA,Maybe BodyRecord
mBrB) of
(Just BodyRecord
brA, Just BodyRecord
brB) -> do
Ptr Constraint
cPtr <- SpacePtr
-> Ptr Body
-> Ptr Body
-> Int
-> ConstraintType
-> IO (Ptr Constraint)
newConstraint SpacePtr
spcPtr (BodyRecord -> Ptr Body
brPtr BodyRecord
brA) (BodyRecord -> Ptr Body
brPtr BodyRecord
brB) Int
cEty ConstraintType
ctype
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IOMap (Record Constraint)
cMap (forall a. Int -> a -> IntMap a -> IntMap a
M.insert Int
cEty (forall a. Ptr a -> a -> Record a
Record Ptr Constraint
cPtr Elem (Space Constraint)
cons))
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (BodyRecord -> IORef IntSet
brConstraints BodyRecord
brA) (Int -> IntSet -> IntSet
S.insert Int
cEty)
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (BodyRecord -> IORef IntSet
brConstraints BodyRecord
brB) (Int -> IntSet -> IntSet
S.insert Int
cEty)
(Maybe BodyRecord, Maybe BodyRecord)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
instance MonadIO m => ExplDestroy m (Space Constraint) where
explDestroy :: Space Constraint -> Int -> m ()
explDestroy (Space IOMap BodyRecord
bMap IOMap (Record Shape)
_ IOMap (Record Constraint)
cMap IOMap (Record CollisionHandler)
_ SpacePtr
spc) Int
cEty = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Maybe (Record Constraint)
rd <- forall a. Int -> IntMap a -> Maybe a
M.lookup Int
cEty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IOMap (Record Constraint)
cMap
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Record Constraint)
rd forall a b. (a -> b) -> a -> b
$ \(Record Ptr Constraint
cPtr (Constraint (Entity Int
bEtyA) (Entity Int
bEtyB) ConstraintType
_)) -> do
IntMap BodyRecord
bMap' <- forall a. IORef a -> IO a
readIORef IOMap BodyRecord
bMap
let rmConstraint :: BodyRecord -> IO ()
rmConstraint BodyRecord
ref = forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (BodyRecord -> IORef IntSet
brConstraints BodyRecord
ref) (Int -> IntSet -> IntSet
S.delete Int
cEty)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ BodyRecord -> IO ()
rmConstraint (forall a. Int -> IntMap a -> Maybe a
M.lookup Int
bEtyA IntMap BodyRecord
bMap')
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ BodyRecord -> IO ()
rmConstraint (forall a. Int -> IntMap a -> Maybe a
M.lookup Int
bEtyB IntMap BodyRecord
bMap')
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IOMap (Record Constraint)
cMap forall a b. (a -> b) -> a -> b
$ forall a. Int -> IntMap a -> IntMap a
M.delete Int
cEty
SpacePtr -> Ptr Constraint -> IO ()
destroyConstraint SpacePtr
spc Ptr Constraint
cPtr
instance MonadIO m => ExplMembers m (Space Constraint) where
explMembers :: Space Constraint -> m (Vector Int)
explMembers (Space IOMap BodyRecord
_ IOMap (Record Shape)
_ IOMap (Record Constraint)
cMap IOMap (Record CollisionHandler)
_ SpacePtr
_) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Unbox a => [a] -> Vector a
U.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IntMap a -> [Int]
M.keys forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IOMap (Record Constraint)
cMap
instance MonadIO m => ExplGet m (Space Constraint) where
explExists :: Space Constraint -> Int -> m Bool
explExists (Space IOMap BodyRecord
_ IOMap (Record Shape)
_ IOMap (Record Constraint)
cMap IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Int -> IntMap a -> Bool
M.member Int
ety forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IOMap (Record Constraint)
cMap
explGet :: Space Constraint -> Int -> m (Elem (Space Constraint))
explGet (Space IOMap BodyRecord
_ IOMap (Record Shape)
_ IOMap (Record Constraint)
cMap IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Just (Record Ptr Constraint
_ Constraint
cons) <- forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IOMap (Record Constraint)
cMap
forall (m :: * -> *) a. Monad m => a -> m a
return Constraint
cons
getMaxForce :: Ptr Constraint -> IO Double
getMaxForce :: Ptr Constraint -> IO Double
getMaxForce Ptr Constraint
c = forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [C.exp| double { cpConstraintGetMaxForce ($(cpConstraint* c)) } |]
setMaxForce :: Ptr Constraint -> Double -> IO ()
setMaxForce :: Ptr Constraint -> Double -> IO ()
setMaxForce Ptr Constraint
c (forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
maxForce) = [C.exp| void { cpConstraintSetMaxForce($(cpConstraint* c), $(double maxForce)); } |]
instance Component MaxForce where
type Storage MaxForce = Space MaxForce
instance (MonadIO m, Has w m Physics) => Has w m MaxForce where
getStore :: SystemT w m (Storage MaxForce)
getStore = (forall a b. Space a -> Space b
cast :: Space Physics -> Space MaxForce) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
instance MonadIO m => ExplMembers m (Space MaxForce) where
explMembers :: Space MaxForce -> m (Vector Int)
explMembers Space MaxForce
s = forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (forall a b. Space a -> Space b
cast Space MaxForce
s :: Space Constraint)
instance MonadIO m => ExplSet m (Space MaxForce) where
explSet :: Space MaxForce -> Int -> Elem (Space MaxForce) -> m ()
explSet (Space IOMap BodyRecord
_ IOMap (Record Shape)
_ IOMap (Record Constraint)
cMap IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety (MaxForce Double
vec) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Maybe (Record Constraint)
rd <- forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IOMap (Record Constraint)
cMap
case Maybe (Record Constraint)
rd of
Maybe (Record Constraint)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (Record Ptr Constraint
c Constraint
_) -> Ptr Constraint -> Double -> IO ()
setMaxForce Ptr Constraint
c Double
vec
instance MonadIO m => ExplGet m (Space MaxForce) where
explExists :: Space MaxForce -> Int -> m Bool
explExists Space MaxForce
s Int
ety = forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (forall a b. Space a -> Space b
cast Space MaxForce
s :: Space Constraint) Int
ety
explGet :: Space MaxForce -> Int -> m (Elem (Space MaxForce))
explGet (Space IOMap BodyRecord
_ IOMap (Record Shape)
_ IOMap (Record Constraint)
cMap IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Just (Record Ptr Constraint
c Constraint
_) <- forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IOMap (Record Constraint)
cMap
Double -> MaxForce
MaxForce forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Constraint -> IO Double
getMaxForce Ptr Constraint
c
getMaxBias :: Ptr Constraint -> IO Double
getMaxBias :: Ptr Constraint -> IO Double
getMaxBias Ptr Constraint
c = do
CDouble
maxBias <- [C.exp| double { cpConstraintGetMaxBias ($(cpConstraint* c)) } |]
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
maxBias)
setMaxBias :: Ptr Constraint -> Double -> IO ()
setMaxBias :: Ptr Constraint -> Double -> IO ()
setMaxBias Ptr Constraint
c (forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
maxBias) = [C.exp| void { cpConstraintSetMaxBias($(cpConstraint* c), $(double maxBias)); } |]
instance Component MaxBias where
type Storage MaxBias = Space MaxBias
instance (MonadIO m, Has w m Physics) => Has w m MaxBias where
getStore :: SystemT w m (Storage MaxBias)
getStore = (forall a b. Space a -> Space b
cast :: Space Physics -> Space MaxBias) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
instance MonadIO m => ExplMembers m (Space MaxBias) where
explMembers :: Space MaxBias -> m (Vector Int)
explMembers Space MaxBias
s = forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (forall a b. Space a -> Space b
cast Space MaxBias
s :: Space Constraint)
instance MonadIO m => ExplSet m (Space MaxBias) where
explSet :: Space MaxBias -> Int -> Elem (Space MaxBias) -> m ()
explSet (Space IOMap BodyRecord
_ IOMap (Record Shape)
_ IOMap (Record Constraint)
cMap IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety (MaxBias Double
vec) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Maybe (Record Constraint)
rd <- forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IOMap (Record Constraint)
cMap
case Maybe (Record Constraint)
rd of
Maybe (Record Constraint)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (Record Ptr Constraint
c Constraint
_) -> Ptr Constraint -> Double -> IO ()
setMaxBias Ptr Constraint
c Double
vec
instance MonadIO m => ExplGet m (Space MaxBias) where
explGet :: Space MaxBias -> Int -> m (Elem (Space MaxBias))
explGet (Space IOMap BodyRecord
_ IOMap (Record Shape)
_ IOMap (Record Constraint)
cMap IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Just (Record Ptr Constraint
c Constraint
_) <- forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IOMap (Record Constraint)
cMap
Double -> MaxBias
MaxBias forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Constraint -> IO Double
getMaxBias Ptr Constraint
c
explExists :: Space MaxBias -> Int -> m Bool
explExists Space MaxBias
s Int
ety = forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (forall a b. Space a -> Space b
cast Space MaxBias
s :: Space Constraint) Int
ety
getErrorBias :: Ptr Constraint -> IO Double
getErrorBias :: Ptr Constraint -> IO Double
getErrorBias Ptr Constraint
c = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
CDouble
errorBias <- [C.exp| double { cpConstraintGetErrorBias ($(cpConstraint* c)) } |]
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
errorBias)
setErrorBias :: Ptr Constraint -> Double -> IO ()
setErrorBias :: Ptr Constraint -> Double -> IO ()
setErrorBias Ptr Constraint
c (forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
errorBias) = [C.exp| void { cpConstraintSetErrorBias($(cpConstraint* c), $(double errorBias)); } |]
instance Component ErrorBias where
type Storage ErrorBias = Space ErrorBias
instance (MonadIO m, Has w m Physics) => Has w m ErrorBias where
getStore :: SystemT w m (Storage ErrorBias)
getStore = (forall a b. Space a -> Space b
cast :: Space Physics -> Space ErrorBias) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
instance MonadIO m => ExplMembers m (Space ErrorBias) where
explMembers :: Space ErrorBias -> m (Vector Int)
explMembers Space ErrorBias
s = forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (forall a b. Space a -> Space b
cast Space ErrorBias
s :: Space Constraint)
instance MonadIO m => ExplSet m (Space ErrorBias) where
explSet :: Space ErrorBias -> Int -> Elem (Space ErrorBias) -> m ()
explSet (Space IOMap BodyRecord
_ IOMap (Record Shape)
_ IOMap (Record Constraint)
cMap IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety (ErrorBias Double
vec) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Maybe (Record Constraint)
rd <- forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IOMap (Record Constraint)
cMap
case Maybe (Record Constraint)
rd of
Maybe (Record Constraint)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (Record Ptr Constraint
c Constraint
_) -> Ptr Constraint -> Double -> IO ()
setErrorBias Ptr Constraint
c Double
vec
instance MonadIO m => ExplGet m (Space ErrorBias) where
explExists :: Space ErrorBias -> Int -> m Bool
explExists Space ErrorBias
s Int
ety = forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (forall a b. Space a -> Space b
cast Space ErrorBias
s :: Space Constraint) Int
ety
explGet :: Space ErrorBias -> Int -> m (Elem (Space ErrorBias))
explGet (Space IOMap BodyRecord
_ IOMap (Record Shape)
_ IOMap (Record Constraint)
cMap IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Just (Record Ptr Constraint
c Constraint
_) <- forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IOMap (Record Constraint)
cMap
Double -> ErrorBias
ErrorBias forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Constraint -> IO Double
getErrorBias Ptr Constraint
c
getImpulse :: Ptr Constraint -> IO Double
getImpulse :: Ptr Constraint -> IO Double
getImpulse Ptr Constraint
c = forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [C.exp| double { cpConstraintGetImpulse ($(cpConstraint* c)) } |]
instance Component Impulse where
type Storage Impulse = Space Impulse
instance (MonadIO m, Has w m Physics) => Has w m Impulse where
getStore :: SystemT w m (Storage Impulse)
getStore = (forall a b. Space a -> Space b
cast :: Space Physics -> Space Impulse) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
instance MonadIO m => ExplMembers m (Space Impulse) where
explMembers :: Space Impulse -> m (Vector Int)
explMembers Space Impulse
s = forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (forall a b. Space a -> Space b
cast Space Impulse
s :: Space Constraint)
instance MonadIO m => ExplGet m (Space Impulse) where
explExists :: Space Impulse -> Int -> m Bool
explExists Space Impulse
s Int
ety = forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (forall a b. Space a -> Space b
cast Space Impulse
s :: Space Constraint) Int
ety
explGet :: Space Impulse -> Int -> m (Elem (Space Impulse))
explGet (Space IOMap BodyRecord
_ IOMap (Record Shape)
_ IOMap (Record Constraint)
cMap IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Just (Record Ptr Constraint
c Constraint
_) <- forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IOMap (Record Constraint)
cMap
Double -> Impulse
Impulse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Constraint -> IO Double
getImpulse Ptr Constraint
c
getCollideBodies :: Ptr Constraint -> IO Bool
getCollideBodies :: Ptr Constraint -> IO Bool
getCollideBodies Ptr Constraint
c = do
CInt
collide <- [C.exp| int { cpConstraintGetCollideBodies ($(cpConstraint* c)) } |]
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ CInt
collide
setCollideBodies :: Ptr Constraint -> Bool -> IO ()
setCollideBodies :: Ptr Constraint -> Bool -> IO ()
setCollideBodies Ptr Constraint
c (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum -> CInt
collide) = [C.exp| void { cpConstraintSetCollideBodies($(cpConstraint* c), $(int collide)); } |]
instance Component CollideBodies where
type Storage CollideBodies = Space CollideBodies
instance (MonadIO m, Has w m Physics) => Has w m CollideBodies where
getStore :: SystemT w m (Storage CollideBodies)
getStore = (forall a b. Space a -> Space b
cast :: Space Physics -> Space CollideBodies) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore
instance MonadIO m => ExplMembers m (Space CollideBodies) where
explMembers :: Space CollideBodies -> m (Vector Int)
explMembers Space CollideBodies
s = forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (forall a b. Space a -> Space b
cast Space CollideBodies
s :: Space Constraint)
instance MonadIO m => ExplSet m (Space CollideBodies) where
explSet :: Space CollideBodies -> Int -> Elem (Space CollideBodies) -> m ()
explSet (Space IOMap BodyRecord
_ IOMap (Record Shape)
_ IOMap (Record Constraint)
cMap IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety (CollideBodies Bool
vec) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Maybe (Record Constraint)
rd <- forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IOMap (Record Constraint)
cMap
case Maybe (Record Constraint)
rd of
Maybe (Record Constraint)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (Record Ptr Constraint
c Constraint
_) -> Ptr Constraint -> Bool -> IO ()
setCollideBodies Ptr Constraint
c Bool
vec
instance MonadIO m => ExplGet m (Space CollideBodies) where
explExists :: Space CollideBodies -> Int -> m Bool
explExists Space CollideBodies
s Int
ety = forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (forall a b. Space a -> Space b
cast Space CollideBodies
s :: Space Constraint) Int
ety
explGet :: Space CollideBodies -> Int -> m (Elem (Space CollideBodies))
explGet (Space IOMap BodyRecord
_ IOMap (Record Shape)
_ IOMap (Record Constraint)
cMap IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Just (Record Ptr Constraint
c Constraint
_) <- forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IOMap (Record Constraint)
cMap
Bool -> CollideBodies
CollideBodies forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Constraint -> IO Bool
getCollideBodies Ptr Constraint
c