{-# 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>"

-- Constraint
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

-- MaxForce
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

-- MaxBias
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

-- ErrorBias
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

-- Impulse
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

-- CollideBodies
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