{-# 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.Body 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.Shape ()
import           Apecs.Physics.Constraint ()
import           Apecs.Physics.Types

C.context phycsCtx
C.include "<chipmunk.h>"

-- Body
newBody :: SpacePtr -> Int -> IO (Ptr Body)
newBody :: SpacePtr -> Int -> IO (Ptr Body)
newBody SpacePtr
spacePtr (Int -> CIntPtr
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> CIntPtr
ety) = SpacePtr -> (Ptr FrnSpace -> IO (Ptr Body)) -> IO (Ptr Body)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr SpacePtr
spacePtr ((Ptr FrnSpace -> IO (Ptr Body)) -> IO (Ptr Body))
-> (Ptr FrnSpace -> IO (Ptr Body)) -> IO (Ptr Body)
forall a b. (a -> b) -> a -> b
$ \Ptr FrnSpace
space -> [C.block| cpBody* {
    cpBody* body = cpBodyNew(0,0);
    cpSpaceAddBody($(cpSpace* space), body);
    cpBodySetUserData(body, (void*) $(intptr_t ety));
    return body; } |]

setBodyType :: Ptr Body -> Body -> IO ()
setBodyType :: Ptr Body -> Body -> IO ()
setBodyType Ptr Body
bodyPtr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Body -> Int) -> Body -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Body -> Int
forall a. Enum a => a -> Int
fromEnum -> CInt
bodyInt) =
  [C.exp| void { cpBodySetType($(cpBody* bodyPtr), $(int bodyInt)) } |]

getBodyType :: Ptr Body -> IO Body
getBodyType :: Ptr Body -> IO Body
getBodyType Ptr Body
bodyPtr = Int -> Body
forall a. Enum a => Int -> a
toEnum (Int -> Body) -> (CInt -> Int) -> CInt -> Body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Body) -> IO CInt -> IO Body
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [C.exp| int { cpBodyGetType($(cpBody* bodyPtr)) } |]

destroyBody :: SpacePtr -> Ptr Body -> IO ()
destroyBody :: SpacePtr -> Ptr Body -> IO ()
destroyBody SpacePtr
spacePtr Ptr Body
bodyPtr = SpacePtr -> (Ptr FrnSpace -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr SpacePtr
spacePtr ((Ptr FrnSpace -> IO ()) -> IO ())
-> (Ptr FrnSpace -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr FrnSpace
space -> [C.block| void {
  cpBody *body = $(cpBody* bodyPtr);
  cpSpaceRemoveBody($(cpSpace* space), body);
  cpBodyFree(body); }|]

instance Component Body where
  type Storage Body = Space Body

instance (MonadIO m, Has w m Physics) => Has w m Body where
  getStore :: SystemT w m (Storage Body)
getStore = (Space Physics -> Space Body
forall a b. Space a -> Space b
cast :: Space Physics -> Space Body) (Space Physics -> Space Body)
-> SystemT w m (Space Physics) -> SystemT w m (Space Body)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SystemT w m (Space Physics)
forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore

instance MonadIO m => ExplSet m (Space Body) where
  explSet :: Space Body -> Int -> Elem (Space Body) -> m ()
explSet (Space IOMap BodyRecord
bMap IOMap (Record Shape)
_ IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
spcPtr) Int
ety Elem (Space Body)
btype = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Maybe BodyRecord
rd <- Int -> IntMap BodyRecord -> Maybe BodyRecord
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap BodyRecord -> Maybe BodyRecord)
-> IO (IntMap BodyRecord) -> IO (Maybe BodyRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap BodyRecord -> IO (IntMap BodyRecord)
forall a. IORef a -> IO a
readIORef IOMap BodyRecord
bMap
    Ptr Body
bdyPtr <- case Maybe BodyRecord
rd of
                Just (BodyRecord Ptr Body
bdyPtr Body
_ IORef IntSet
_ IORef IntSet
_) -> Ptr Body -> IO (Ptr Body)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Body
bdyPtr
                Maybe BodyRecord
Nothing -> do
                  Ptr Body
bdyPtr <- SpacePtr -> Int -> IO (Ptr Body)
newBody SpacePtr
spcPtr Int
ety
                  IORef IntSet
bsMap <- IntSet -> IO (IORef IntSet)
forall a. a -> IO (IORef a)
newIORef IntSet
forall a. Monoid a => a
mempty
                  IORef IntSet
bcMap <- IntSet -> IO (IORef IntSet)
forall a. a -> IO (IORef a)
newIORef IntSet
forall a. Monoid a => a
mempty
                  IOMap BodyRecord
-> (IntMap BodyRecord -> IntMap BodyRecord) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IOMap BodyRecord
bMap (Int -> BodyRecord -> IntMap BodyRecord -> IntMap BodyRecord
forall a. Int -> a -> IntMap a -> IntMap a
M.insert Int
ety (BodyRecord -> IntMap BodyRecord -> IntMap BodyRecord)
-> BodyRecord -> IntMap BodyRecord -> IntMap BodyRecord
forall a b. (a -> b) -> a -> b
$ Ptr Body -> Body -> IORef IntSet -> IORef IntSet -> BodyRecord
BodyRecord Ptr Body
bdyPtr Elem (Space Body)
Body
btype IORef IntSet
bsMap IORef IntSet
bcMap)
                  Ptr Body -> IO (Ptr Body)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Body
bdyPtr
    Ptr Body -> Body -> IO ()
setBodyType Ptr Body
bdyPtr Elem (Space Body)
Body
btype

instance MonadIO m => ExplDestroy m (Space Body) where
  explDestroy :: Space Body -> Int -> m ()
explDestroy sp :: Space Body
sp@(Space IOMap BodyRecord
bMap IOMap (Record Shape)
_ IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
spc) Int
ety = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Maybe BodyRecord
rd <- Int -> IntMap BodyRecord -> Maybe BodyRecord
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap BodyRecord -> Maybe BodyRecord)
-> IO (IntMap BodyRecord) -> IO (Maybe BodyRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap BodyRecord -> IO (IntMap BodyRecord)
forall a. IORef a -> IO a
readIORef IOMap BodyRecord
bMap
    IOMap BodyRecord
-> (IntMap BodyRecord -> IntMap BodyRecord) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IOMap BodyRecord
bMap (Int -> IntMap BodyRecord -> IntMap BodyRecord
forall a. Int -> IntMap a -> IntMap a
M.delete Int
ety)
    Maybe BodyRecord -> (BodyRecord -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe BodyRecord
rd ((BodyRecord -> IO ()) -> IO ()) -> (BodyRecord -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(BodyRecord Ptr Body
bPtr Body
_ IORef IntSet
shapes IORef IntSet
constraints) -> do
      IORef IntSet -> IO IntSet
forall a. IORef a -> IO a
readIORef IORef IntSet
shapes      IO IntSet -> (IntSet -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> IO ()) -> [Int] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Space Shape -> Int -> IO ()
forall (m :: * -> *) s. ExplDestroy m s => s -> Int -> m ()
explDestroy (Space Body -> Space Shape
forall a b. Space a -> Space b
cast Space Body
sp :: Space Shape))      ([Int] -> IO ()) -> (IntSet -> [Int]) -> IntSet -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
S.toList
      IORef IntSet -> IO IntSet
forall a. IORef a -> IO a
readIORef IORef IntSet
constraints IO IntSet -> (IntSet -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> IO ()) -> [Int] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Space Constraint -> Int -> IO ()
forall (m :: * -> *) s. ExplDestroy m s => s -> Int -> m ()
explDestroy (Space Body -> Space Constraint
forall a b. Space a -> Space b
cast Space Body
sp :: Space Constraint)) ([Int] -> IO ()) -> (IntSet -> [Int]) -> IntSet -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
S.toList
      SpacePtr -> Ptr Body -> IO ()
destroyBody SpacePtr
spc Ptr Body
bPtr

instance MonadIO m => ExplMembers m (Space Body) where
  explMembers :: Space Body -> m (Vector Int)
explMembers (Space IOMap BodyRecord
bMap IOMap (Record Shape)
_ IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) = IO (Vector Int) -> m (Vector Int)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Vector Int) -> m (Vector Int))
-> IO (Vector Int) -> m (Vector Int)
forall a b. (a -> b) -> a -> b
$ [Int] -> Vector Int
forall a. Unbox a => [a] -> Vector a
U.fromList ([Int] -> Vector Int)
-> (IntMap BodyRecord -> [Int]) -> IntMap BodyRecord -> Vector Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap BodyRecord -> [Int]
forall a. IntMap a -> [Int]
M.keys (IntMap BodyRecord -> Vector Int)
-> IO (IntMap BodyRecord) -> IO (Vector Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap BodyRecord -> IO (IntMap BodyRecord)
forall a. IORef a -> IO a
readIORef IOMap BodyRecord
bMap

instance MonadIO m => ExplGet m (Space Body) where
  explExists :: Space Body -> Int -> m Bool
explExists (Space IOMap BodyRecord
bMap IOMap (Record Shape)
_ IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Int -> IntMap BodyRecord -> Bool
forall a. Int -> IntMap a -> Bool
M.member Int
ety (IntMap BodyRecord -> Bool) -> IO (IntMap BodyRecord) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap BodyRecord -> IO (IntMap BodyRecord)
forall a. IORef a -> IO a
readIORef IOMap BodyRecord
bMap
  explGet :: Space Body -> Int -> m (Elem (Space Body))
explGet (Space IOMap BodyRecord
bMap IOMap (Record Shape)
_ IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety = IO Body -> m Body
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Body -> m Body) -> IO Body -> m Body
forall a b. (a -> b) -> a -> b
$ do
    Just (BodyRecord Ptr Body
_ Body
b IORef IntSet
_ IORef IntSet
_) <- Int -> IntMap BodyRecord -> Maybe BodyRecord
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap BodyRecord -> Maybe BodyRecord)
-> IO (IntMap BodyRecord) -> IO (Maybe BodyRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap BodyRecord -> IO (IntMap BodyRecord)
forall a. IORef a -> IO a
readIORef IOMap BodyRecord
bMap
    Body -> IO Body
forall (m :: * -> *) a. Monad m => a -> m a
return Body
b

-- Position
getPosition :: Ptr Body -> IO (V2 Double)
getPosition :: Ptr Body -> IO (V2 Double)
getPosition Ptr Body
bodyPtr = do
  CDouble
x <- [C.exp| double { cpBodyGetPosition ($(cpBody* bodyPtr)).x } |]
  CDouble
y <- [C.exp| double { cpBodyGetPosition ($(cpBody* bodyPtr)).y } |]
  V2 Double -> IO (V2 Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Double -> V2 Double
forall a. a -> a -> V2 a
V2 (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
x) (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
y))

setPosition :: Ptr Body -> V2 Double -> IO ()
setPosition :: Ptr Body -> V2 Double -> IO ()
setPosition Ptr Body
bodyPtr (V2 (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
x) (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
y)) = [C.block| void {
  const cpVect pos = { $(double x), $(double y) };
  cpBody *body = $(cpBody* bodyPtr);
  cpBodySetPosition(body, pos);
  if (cpBodyGetType(body) == CP_BODY_TYPE_STATIC)
    cpSpaceReindexShapesForBody(cpBodyGetSpace(body), body);
  } |]

instance Component Position where
  type Storage Position = Space Position

instance (MonadIO m, Has w m Physics) => Has w m Position where
  getStore :: SystemT w m (Storage Position)
getStore = (Space Physics -> Space Position
forall a b. Space a -> Space b
cast :: Space Physics -> Space Position) (Space Physics -> Space Position)
-> SystemT w m (Space Physics) -> SystemT w m (Space Position)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SystemT w m (Space Physics)
forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore

instance MonadIO m => ExplMembers m (Space Position) where
  explMembers :: Space Position -> m (Vector Int)
explMembers Space Position
s = Space Body -> m (Vector Int)
forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (Space Position -> Space Body
forall a b. Space a -> Space b
cast Space Position
s :: Space Body)

instance MonadIO m => ExplSet m (Space Position) where
  explSet :: Space Position -> Int -> Elem (Space Position) -> m ()
explSet (Space IOMap BodyRecord
bMap IOMap (Record Shape)
_ IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety (Position pos) = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Maybe BodyRecord
rd <- Int -> IntMap BodyRecord -> Maybe BodyRecord
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap BodyRecord -> Maybe BodyRecord)
-> IO (IntMap BodyRecord) -> IO (Maybe BodyRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap BodyRecord -> IO (IntMap BodyRecord)
forall a. IORef a -> IO a
readIORef IOMap BodyRecord
bMap
    Maybe BodyRecord -> (BodyRecord -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe BodyRecord
rd((BodyRecord -> IO ()) -> IO ()) -> (BodyRecord -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(BodyRecord Ptr Body
b Body
_ IORef IntSet
_ IORef IntSet
_) -> Ptr Body -> V2 Double -> IO ()
setPosition Ptr Body
b V2 Double
pos

instance MonadIO m => ExplGet m (Space Position) where
  explExists :: Space Position -> Int -> m Bool
explExists Space Position
s Int
ety = Space Body -> Int -> m Bool
forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (Space Position -> Space Body
forall a b. Space a -> Space b
cast Space Position
s :: Space Body) Int
ety
  explGet :: Space Position -> Int -> m (Elem (Space Position))
explGet (Space IOMap BodyRecord
bMap IOMap (Record Shape)
_ IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety = IO Position -> m Position
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Position -> m Position) -> IO Position -> m Position
forall a b. (a -> b) -> a -> b
$ do
    Just (BodyRecord Ptr Body
b Body
_ IORef IntSet
_ IORef IntSet
_) <- Int -> IntMap BodyRecord -> Maybe BodyRecord
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap BodyRecord -> Maybe BodyRecord)
-> IO (IntMap BodyRecord) -> IO (Maybe BodyRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap BodyRecord -> IO (IntMap BodyRecord)
forall a. IORef a -> IO a
readIORef IOMap BodyRecord
bMap
    V2 Double -> Position
Position (V2 Double -> Position) -> IO (V2 Double) -> IO Position
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Body -> IO (V2 Double)
getPosition Ptr Body
b

-- Velocity
getVelocity :: Ptr Body -> IO (V2 Double)
getVelocity :: Ptr Body -> IO (V2 Double)
getVelocity Ptr Body
bodyPtr = do
  CDouble
x <- [C.exp| double { cpBodyGetVelocity ($(cpBody* bodyPtr)).x } |]
  CDouble
y <- [C.exp| double { cpBodyGetVelocity ($(cpBody* bodyPtr)).y } |]
  V2 Double -> IO (V2 Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Double -> V2 Double
forall a. a -> a -> V2 a
V2 (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
x) (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
y))

setVelocity :: Ptr Body -> V2 Double -> IO ()
setVelocity :: Ptr Body -> V2 Double -> IO ()
setVelocity Ptr Body
bodyPtr (V2 (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
x) (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
y)) = [C.block| void {
  const cpVect vel = { $(double x), $(double y) };
  cpBodySetVelocity($(cpBody* bodyPtr), vel);
  } |]

instance Component Velocity where
  type Storage Velocity = Space Velocity

instance (MonadIO m, Has w m Physics) => Has w m Velocity where
  getStore :: SystemT w m (Storage Velocity)
getStore = (Space Physics -> Space Velocity
forall a b. Space a -> Space b
cast :: Space Physics -> Space Velocity) (Space Physics -> Space Velocity)
-> SystemT w m (Space Physics) -> SystemT w m (Space Velocity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SystemT w m (Space Physics)
forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore

instance MonadIO m => ExplMembers m (Space Velocity) where
  explMembers :: Space Velocity -> m (Vector Int)
explMembers Space Velocity
s = Space Body -> m (Vector Int)
forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (Space Velocity -> Space Body
forall a b. Space a -> Space b
cast Space Velocity
s :: Space Body)

instance MonadIO m => ExplSet m (Space Velocity) where
  explSet :: Space Velocity -> Int -> Elem (Space Velocity) -> m ()
explSet (Space IOMap BodyRecord
bMap IOMap (Record Shape)
_ IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety (Velocity vel) = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Maybe BodyRecord
rd <- Int -> IntMap BodyRecord -> Maybe BodyRecord
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap BodyRecord -> Maybe BodyRecord)
-> IO (IntMap BodyRecord) -> IO (Maybe BodyRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap BodyRecord -> IO (IntMap BodyRecord)
forall a. IORef a -> IO a
readIORef IOMap BodyRecord
bMap
    Maybe BodyRecord -> (BodyRecord -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe BodyRecord
rd((BodyRecord -> IO ()) -> IO ()) -> (BodyRecord -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(BodyRecord Ptr Body
b Body
_ IORef IntSet
_ IORef IntSet
_) -> Ptr Body -> V2 Double -> IO ()
setVelocity Ptr Body
b V2 Double
vel

instance MonadIO m => ExplGet m (Space Velocity) where
  explExists :: Space Velocity -> Int -> m Bool
explExists Space Velocity
s Int
ety = Space Body -> Int -> m Bool
forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (Space Velocity -> Space Body
forall a b. Space a -> Space b
cast Space Velocity
s :: Space Body) Int
ety
  explGet :: Space Velocity -> Int -> m (Elem (Space Velocity))
explGet (Space IOMap BodyRecord
bMap IOMap (Record Shape)
_ IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety = IO Velocity -> m Velocity
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Velocity -> m Velocity) -> IO Velocity -> m Velocity
forall a b. (a -> b) -> a -> b
$ do
    Just (BodyRecord Ptr Body
b Body
_ IORef IntSet
_ IORef IntSet
_) <- Int -> IntMap BodyRecord -> Maybe BodyRecord
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap BodyRecord -> Maybe BodyRecord)
-> IO (IntMap BodyRecord) -> IO (Maybe BodyRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap BodyRecord -> IO (IntMap BodyRecord)
forall a. IORef a -> IO a
readIORef IOMap BodyRecord
bMap
    V2 Double -> Velocity
Velocity (V2 Double -> Velocity) -> IO (V2 Double) -> IO Velocity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Body -> IO (V2 Double)
getVelocity Ptr Body
b

-- Angle
getAngle :: Ptr Body -> IO Double
getAngle :: Ptr Body -> IO Double
getAngle Ptr Body
bodyPtr = do
  CDouble
angle <- [C.exp| double { cpBodyGetAngle ($(cpBody* bodyPtr)) } |]
  Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
angle)

setAngle :: Ptr Body -> Double -> IO ()
setAngle :: Ptr Body -> Double -> IO ()
setAngle Ptr Body
bodyPtr (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
angle) = [C.block| void {
  cpBody *body = $(cpBody* bodyPtr);
  cpBodySetAngle(body, $(double angle));
  if (cpBodyGetType(body) == CP_BODY_TYPE_STATIC)
    cpSpaceReindexShapesForBody(cpBodyGetSpace(body), body);
  } |]
  -- FIXME reindex

instance Component Angle where
  type Storage Angle = Space Angle

instance (MonadIO m, Has w m Physics) => Has w m Angle where
  getStore :: SystemT w m (Storage Angle)
getStore = (Space Physics -> Space Angle
forall a b. Space a -> Space b
cast :: Space Physics -> Space Angle) (Space Physics -> Space Angle)
-> SystemT w m (Space Physics) -> SystemT w m (Space Angle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SystemT w m (Space Physics)
forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore

instance MonadIO m => ExplMembers m (Space Angle) where
  explMembers :: Space Angle -> m (Vector Int)
explMembers Space Angle
s = Space Body -> m (Vector Int)
forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (Space Angle -> Space Body
forall a b. Space a -> Space b
cast Space Angle
s :: Space Body)

instance MonadIO m => ExplSet m (Space Angle) where
  explSet :: Space Angle -> Int -> Elem (Space Angle) -> m ()
explSet (Space IOMap BodyRecord
bMap IOMap (Record Shape)
_ IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety (Angle angle) = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Maybe BodyRecord
rd <- Int -> IntMap BodyRecord -> Maybe BodyRecord
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap BodyRecord -> Maybe BodyRecord)
-> IO (IntMap BodyRecord) -> IO (Maybe BodyRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap BodyRecord -> IO (IntMap BodyRecord)
forall a. IORef a -> IO a
readIORef IOMap BodyRecord
bMap
    Maybe BodyRecord -> (BodyRecord -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe BodyRecord
rd ((BodyRecord -> IO ()) -> IO ()) -> (BodyRecord -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(BodyRecord Ptr Body
b Body
_ IORef IntSet
_ IORef IntSet
_) -> Ptr Body -> Double -> IO ()
setAngle Ptr Body
b Double
angle

instance MonadIO m => ExplGet m (Space Angle) where
  explExists :: Space Angle -> Int -> m Bool
explExists Space Angle
s Int
ety = Space Body -> Int -> m Bool
forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (Space Angle -> Space Body
forall a b. Space a -> Space b
cast Space Angle
s :: Space Body) Int
ety
  explGet :: Space Angle -> Int -> m (Elem (Space Angle))
explGet (Space IOMap BodyRecord
bMap IOMap (Record Shape)
_ IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety = IO Angle -> m Angle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Angle -> m Angle) -> IO Angle -> m Angle
forall a b. (a -> b) -> a -> b
$ do
    Just (BodyRecord Ptr Body
b Body
_ IORef IntSet
_ IORef IntSet
_) <- Int -> IntMap BodyRecord -> Maybe BodyRecord
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap BodyRecord -> Maybe BodyRecord)
-> IO (IntMap BodyRecord) -> IO (Maybe BodyRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap BodyRecord -> IO (IntMap BodyRecord)
forall a. IORef a -> IO a
readIORef IOMap BodyRecord
bMap
    Double -> Angle
Angle (Double -> Angle) -> IO Double -> IO Angle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Body -> IO Double
getAngle Ptr Body
b

-- AngularVelocity
getAngularVelocity :: Ptr Body -> IO Double
getAngularVelocity :: Ptr Body -> IO Double
getAngularVelocity Ptr Body
bodyPtr = do
  CDouble
angle <- [C.exp| double { cpBodyGetAngularVelocity ($(cpBody* bodyPtr)) } |]
  Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
angle)

setAngularVelocity :: Ptr Body -> Double -> IO ()
setAngularVelocity :: Ptr Body -> Double -> IO ()
setAngularVelocity Ptr Body
bodyPtr (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
angle) = [C.block| void {
  cpBody *body = $(cpBody* bodyPtr);
  cpBodySetAngularVelocity(body, $(double angle));
  if (cpBodyGetType(body) == CP_BODY_TYPE_STATIC)
    cpSpaceReindexShapesForBody(cpBodyGetSpace(body), body);
  } |]
  -- FIXME reindex

instance Component AngularVelocity where
  type Storage AngularVelocity = Space AngularVelocity

instance (MonadIO m, Has w m Physics) => Has w m AngularVelocity where
  getStore :: SystemT w m (Storage AngularVelocity)
getStore = (Space Physics -> Space AngularVelocity
forall a b. Space a -> Space b
cast :: Space Physics -> Space AngularVelocity) (Space Physics -> Space AngularVelocity)
-> SystemT w m (Space Physics)
-> SystemT w m (Space AngularVelocity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SystemT w m (Space Physics)
forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore

instance MonadIO m => ExplMembers m (Space AngularVelocity) where
  explMembers :: Space AngularVelocity -> m (Vector Int)
explMembers Space AngularVelocity
s = Space Body -> m (Vector Int)
forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (Space AngularVelocity -> Space Body
forall a b. Space a -> Space b
cast Space AngularVelocity
s :: Space Body)

instance MonadIO m => ExplSet m (Space AngularVelocity) where
  explSet :: Space AngularVelocity
-> Int -> Elem (Space AngularVelocity) -> m ()
explSet (Space IOMap BodyRecord
bMap IOMap (Record Shape)
_ IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety (AngularVelocity angle) = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Maybe BodyRecord
rd <- Int -> IntMap BodyRecord -> Maybe BodyRecord
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap BodyRecord -> Maybe BodyRecord)
-> IO (IntMap BodyRecord) -> IO (Maybe BodyRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap BodyRecord -> IO (IntMap BodyRecord)
forall a. IORef a -> IO a
readIORef IOMap BodyRecord
bMap
    Maybe BodyRecord -> (BodyRecord -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe BodyRecord
rd ((BodyRecord -> IO ()) -> IO ()) -> (BodyRecord -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(BodyRecord Ptr Body
b Body
_ IORef IntSet
_ IORef IntSet
_) -> Ptr Body -> Double -> IO ()
setAngularVelocity Ptr Body
b Double
angle

instance MonadIO m => ExplGet m (Space AngularVelocity) where
  explExists :: Space AngularVelocity -> Int -> m Bool
explExists Space AngularVelocity
s Int
ety = Space Body -> Int -> m Bool
forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (Space AngularVelocity -> Space Body
forall a b. Space a -> Space b
cast Space AngularVelocity
s :: Space Body) Int
ety
  explGet :: Space AngularVelocity -> Int -> m (Elem (Space AngularVelocity))
explGet (Space IOMap BodyRecord
bMap IOMap (Record Shape)
_ IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety = IO AngularVelocity -> m AngularVelocity
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AngularVelocity -> m AngularVelocity)
-> IO AngularVelocity -> m AngularVelocity
forall a b. (a -> b) -> a -> b
$ do
    Just (BodyRecord Ptr Body
b Body
_ IORef IntSet
_ IORef IntSet
_) <- Int -> IntMap BodyRecord -> Maybe BodyRecord
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap BodyRecord -> Maybe BodyRecord)
-> IO (IntMap BodyRecord) -> IO (Maybe BodyRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap BodyRecord -> IO (IntMap BodyRecord)
forall a. IORef a -> IO a
readIORef IOMap BodyRecord
bMap
    Double -> AngularVelocity
AngularVelocity (Double -> AngularVelocity) -> IO Double -> IO AngularVelocity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Body -> IO Double
getAngularVelocity Ptr Body
b

-- Force
getForce :: Ptr Body -> IO (V2 Double)
getForce :: Ptr Body -> IO (V2 Double)
getForce Ptr Body
bodyPtr = do
  CDouble
x <- [C.exp| double { cpBodyGetForce ($(cpBody* bodyPtr)).x } |]
  CDouble
y <- [C.exp| double { cpBodyGetForce ($(cpBody* bodyPtr)).y } |]
  V2 Double -> IO (V2 Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Double -> V2 Double
forall a. a -> a -> V2 a
V2 (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
x) (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
y))

setForce :: Ptr Body -> V2 Double -> IO ()
setForce :: Ptr Body -> V2 Double -> IO ()
setForce Ptr Body
bodyPtr (V2 (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
x) (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
y)) = [C.block| void {
  const cpVect frc = { $(double x), $(double y) };
  cpBodySetForce($(cpBody* bodyPtr), frc);
  } |]

instance Component Force where
  type Storage Force = Space Force

instance (MonadIO m, Has w m Physics) => Has w m Force where
  getStore :: SystemT w m (Storage Force)
getStore = (Space Physics -> Space Force
forall a b. Space a -> Space b
cast :: Space Physics -> Space Force) (Space Physics -> Space Force)
-> SystemT w m (Space Physics) -> SystemT w m (Space Force)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SystemT w m (Space Physics)
forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore

instance MonadIO m => ExplMembers m (Space Force) where
  explMembers :: Space Force -> m (Vector Int)
explMembers Space Force
s = Space Body -> m (Vector Int)
forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (Space Force -> Space Body
forall a b. Space a -> Space b
cast Space Force
s :: Space Body)

instance MonadIO m => ExplSet m (Space Force) where
  explSet :: Space Force -> Int -> Elem (Space Force) -> m ()
explSet (Space IOMap BodyRecord
bMap IOMap (Record Shape)
_ IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety (Force frc) = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Maybe BodyRecord
rd <- Int -> IntMap BodyRecord -> Maybe BodyRecord
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap BodyRecord -> Maybe BodyRecord)
-> IO (IntMap BodyRecord) -> IO (Maybe BodyRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap BodyRecord -> IO (IntMap BodyRecord)
forall a. IORef a -> IO a
readIORef IOMap BodyRecord
bMap
    Maybe BodyRecord -> (BodyRecord -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe BodyRecord
rd((BodyRecord -> IO ()) -> IO ()) -> (BodyRecord -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(BodyRecord Ptr Body
b Body
_ IORef IntSet
_ IORef IntSet
_) -> Ptr Body -> V2 Double -> IO ()
setForce Ptr Body
b V2 Double
frc

instance MonadIO m => ExplGet m (Space Force) where
  explExists :: Space Force -> Int -> m Bool
explExists Space Force
s Int
ety = Space Body -> Int -> m Bool
forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (Space Force -> Space Body
forall a b. Space a -> Space b
cast Space Force
s :: Space Body) Int
ety
  explGet :: Space Force -> Int -> m (Elem (Space Force))
explGet (Space IOMap BodyRecord
bMap IOMap (Record Shape)
_ IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety = IO Force -> m Force
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Force -> m Force) -> IO Force -> m Force
forall a b. (a -> b) -> a -> b
$ do
    Just (BodyRecord Ptr Body
b Body
_ IORef IntSet
_ IORef IntSet
_) <- Int -> IntMap BodyRecord -> Maybe BodyRecord
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap BodyRecord -> Maybe BodyRecord)
-> IO (IntMap BodyRecord) -> IO (Maybe BodyRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap BodyRecord -> IO (IntMap BodyRecord)
forall a. IORef a -> IO a
readIORef IOMap BodyRecord
bMap
    V2 Double -> Force
Force (V2 Double -> Force) -> IO (V2 Double) -> IO Force
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Body -> IO (V2 Double)
getForce Ptr Body
b

-- BodyMass
getBodyMass :: Ptr Body -> IO Double
getBodyMass :: Ptr Body -> IO Double
getBodyMass Ptr Body
bodyPtr = do
  CDouble
angle <- [C.exp| double { cpBodyGetMass ($(cpBody* bodyPtr)) } |]
  Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
angle)

setBodyMass :: Ptr Body -> Double -> IO ()
setBodyMass :: Ptr Body -> Double -> IO ()
setBodyMass Ptr Body
bodyPtr (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
angle) = [C.block| void {
  cpBody *body = $(cpBody* bodyPtr);
  cpBodySetMass(body, $(double angle));
  if (cpBodyGetType(body) == CP_BODY_TYPE_STATIC)
    cpSpaceReindexShapesForBody(cpBodyGetSpace(body), body);
  } |]
  -- FIXME reindex

instance Component BodyMass where
  type Storage BodyMass = Space BodyMass

instance (MonadIO m, Has w m Physics) => Has w m BodyMass where
  getStore :: SystemT w m (Storage BodyMass)
getStore = (Space Physics -> Space BodyMass
forall a b. Space a -> Space b
cast :: Space Physics -> Space BodyMass) (Space Physics -> Space BodyMass)
-> SystemT w m (Space Physics) -> SystemT w m (Space BodyMass)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SystemT w m (Space Physics)
forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore

instance MonadIO m => ExplMembers m (Space BodyMass) where
  explMembers :: Space BodyMass -> m (Vector Int)
explMembers Space BodyMass
s = Space Body -> m (Vector Int)
forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (Space BodyMass -> Space Body
forall a b. Space a -> Space b
cast Space BodyMass
s :: Space Body)

instance MonadIO m => ExplSet m (Space BodyMass) where
  explSet :: Space BodyMass -> Int -> Elem (Space BodyMass) -> m ()
explSet (Space IOMap BodyRecord
bMap IOMap (Record Shape)
_ IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety (BodyMass angle) = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Maybe BodyRecord
rd <- Int -> IntMap BodyRecord -> Maybe BodyRecord
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap BodyRecord -> Maybe BodyRecord)
-> IO (IntMap BodyRecord) -> IO (Maybe BodyRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap BodyRecord -> IO (IntMap BodyRecord)
forall a. IORef a -> IO a
readIORef IOMap BodyRecord
bMap
    Maybe BodyRecord -> (BodyRecord -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe BodyRecord
rd ((BodyRecord -> IO ()) -> IO ()) -> (BodyRecord -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(BodyRecord Ptr Body
b Body
_ IORef IntSet
_ IORef IntSet
_) -> Ptr Body -> Double -> IO ()
setBodyMass Ptr Body
b Double
angle

instance MonadIO m => ExplGet m (Space BodyMass) where
  explExists :: Space BodyMass -> Int -> m Bool
explExists Space BodyMass
s Int
ety = Space Body -> Int -> m Bool
forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (Space BodyMass -> Space Body
forall a b. Space a -> Space b
cast Space BodyMass
s :: Space Body) Int
ety
  explGet :: Space BodyMass -> Int -> m (Elem (Space BodyMass))
explGet (Space IOMap BodyRecord
bMap IOMap (Record Shape)
_ IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety = IO BodyMass -> m BodyMass
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BodyMass -> m BodyMass) -> IO BodyMass -> m BodyMass
forall a b. (a -> b) -> a -> b
$ do
    Just (BodyRecord Ptr Body
b Body
_ IORef IntSet
_ IORef IntSet
_) <- Int -> IntMap BodyRecord -> Maybe BodyRecord
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap BodyRecord -> Maybe BodyRecord)
-> IO (IntMap BodyRecord) -> IO (Maybe BodyRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap BodyRecord -> IO (IntMap BodyRecord)
forall a. IORef a -> IO a
readIORef IOMap BodyRecord
bMap
    Double -> BodyMass
BodyMass (Double -> BodyMass) -> IO Double -> IO BodyMass
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Body -> IO Double
getBodyMass Ptr Body
b

-- Moment
getMoment :: Ptr Body -> IO Double
getMoment :: Ptr Body -> IO Double
getMoment Ptr Body
bodyPtr = do
  CDouble
angle <- [C.exp| double { cpBodyGetMoment ($(cpBody* bodyPtr)) } |]
  Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
angle)

setMoment :: Ptr Body -> Double -> IO ()
setMoment :: Ptr Body -> Double -> IO ()
setMoment Ptr Body
bodyPtr (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
angle) = [C.block| void {
  cpBody *body = $(cpBody* bodyPtr);
  cpBodySetMoment(body, $(double angle));
  if (cpBodyGetType(body) == CP_BODY_TYPE_STATIC)
    cpSpaceReindexShapesForBody(cpBodyGetSpace(body), body);
  } |]
  -- FIXME reindex

instance Component Moment where
  type Storage Moment = Space Moment

instance (MonadIO m, Has w m Physics) => Has w m Moment where
  getStore :: SystemT w m (Storage Moment)
getStore = (Space Physics -> Space Moment
forall a b. Space a -> Space b
cast :: Space Physics -> Space Moment) (Space Physics -> Space Moment)
-> SystemT w m (Space Physics) -> SystemT w m (Space Moment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SystemT w m (Space Physics)
forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore

instance MonadIO m => ExplMembers m (Space Moment) where
  explMembers :: Space Moment -> m (Vector Int)
explMembers Space Moment
s = Space Body -> m (Vector Int)
forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (Space Moment -> Space Body
forall a b. Space a -> Space b
cast Space Moment
s :: Space Body)

instance MonadIO m => ExplSet m (Space Moment) where
  explSet :: Space Moment -> Int -> Elem (Space Moment) -> m ()
explSet (Space IOMap BodyRecord
bMap IOMap (Record Shape)
_ IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety (Moment angle) = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Maybe BodyRecord
rd <- Int -> IntMap BodyRecord -> Maybe BodyRecord
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap BodyRecord -> Maybe BodyRecord)
-> IO (IntMap BodyRecord) -> IO (Maybe BodyRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap BodyRecord -> IO (IntMap BodyRecord)
forall a. IORef a -> IO a
readIORef IOMap BodyRecord
bMap
    Maybe BodyRecord -> (BodyRecord -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe BodyRecord
rd ((BodyRecord -> IO ()) -> IO ()) -> (BodyRecord -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(BodyRecord Ptr Body
b Body
_ IORef IntSet
_ IORef IntSet
_) -> Ptr Body -> Double -> IO ()
setMoment Ptr Body
b Double
angle

instance MonadIO m => ExplGet m (Space Moment) where
  explExists :: Space Moment -> Int -> m Bool
explExists Space Moment
s Int
ety = Space Body -> Int -> m Bool
forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (Space Moment -> Space Body
forall a b. Space a -> Space b
cast Space Moment
s :: Space Body) Int
ety
  explGet :: Space Moment -> Int -> m (Elem (Space Moment))
explGet (Space IOMap BodyRecord
bMap IOMap (Record Shape)
_ IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety = IO Moment -> m Moment
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Moment -> m Moment) -> IO Moment -> m Moment
forall a b. (a -> b) -> a -> b
$ do
    Just (BodyRecord Ptr Body
b Body
_ IORef IntSet
_ IORef IntSet
_) <- Int -> IntMap BodyRecord -> Maybe BodyRecord
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap BodyRecord -> Maybe BodyRecord)
-> IO (IntMap BodyRecord) -> IO (Maybe BodyRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap BodyRecord -> IO (IntMap BodyRecord)
forall a. IORef a -> IO a
readIORef IOMap BodyRecord
bMap
    Double -> Moment
Moment (Double -> Moment) -> IO Double -> IO Moment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Body -> IO Double
getMoment Ptr Body
b

-- Torque
getTorque :: Ptr Body -> IO Double
getTorque :: Ptr Body -> IO Double
getTorque Ptr Body
bodyPtr = do
  CDouble
angle <- [C.exp| double { cpBodyGetTorque ($(cpBody* bodyPtr)) } |]
  Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
angle)

setTorque :: Ptr Body -> Double -> IO ()
setTorque :: Ptr Body -> Double -> IO ()
setTorque Ptr Body
bodyPtr (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
angle) = [C.block| void {
  cpBody *body = $(cpBody* bodyPtr);
  cpBodySetTorque(body, $(double angle));
  if (cpBodyGetType(body) == CP_BODY_TYPE_STATIC)
    cpSpaceReindexShapesForBody(cpBodyGetSpace(body), body);
  } |]
  -- FIXME reindex

instance Component Torque where
  type Storage Torque = Space Torque

instance (MonadIO m, Has w m Physics) => Has w m Torque where
  getStore :: SystemT w m (Storage Torque)
getStore = (Space Physics -> Space Torque
forall a b. Space a -> Space b
cast :: Space Physics -> Space Torque) (Space Physics -> Space Torque)
-> SystemT w m (Space Physics) -> SystemT w m (Space Torque)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SystemT w m (Space Physics)
forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore

instance MonadIO m => ExplMembers m (Space Torque) where
  explMembers :: Space Torque -> m (Vector Int)
explMembers Space Torque
s = Space Body -> m (Vector Int)
forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (Space Torque -> Space Body
forall a b. Space a -> Space b
cast Space Torque
s :: Space Body)

instance MonadIO m => ExplSet m (Space Torque) where
  explSet :: Space Torque -> Int -> Elem (Space Torque) -> m ()
explSet (Space IOMap BodyRecord
bMap IOMap (Record Shape)
_ IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety (Torque angle) = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Maybe BodyRecord
rd <- Int -> IntMap BodyRecord -> Maybe BodyRecord
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap BodyRecord -> Maybe BodyRecord)
-> IO (IntMap BodyRecord) -> IO (Maybe BodyRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap BodyRecord -> IO (IntMap BodyRecord)
forall a. IORef a -> IO a
readIORef IOMap BodyRecord
bMap
    Maybe BodyRecord -> (BodyRecord -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe BodyRecord
rd ((BodyRecord -> IO ()) -> IO ()) -> (BodyRecord -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(BodyRecord Ptr Body
b Body
_ IORef IntSet
_ IORef IntSet
_) -> Ptr Body -> Double -> IO ()
setTorque Ptr Body
b Double
angle

instance MonadIO m => ExplGet m (Space Torque) where
  explExists :: Space Torque -> Int -> m Bool
explExists Space Torque
s Int
ety = Space Body -> Int -> m Bool
forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (Space Torque -> Space Body
forall a b. Space a -> Space b
cast Space Torque
s :: Space Body) Int
ety
  explGet :: Space Torque -> Int -> m (Elem (Space Torque))
explGet (Space IOMap BodyRecord
bMap IOMap (Record Shape)
_ IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety = IO Torque -> m Torque
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Torque -> m Torque) -> IO Torque -> m Torque
forall a b. (a -> b) -> a -> b
$ do
    Just (BodyRecord Ptr Body
b Body
_ IORef IntSet
_ IORef IntSet
_) <- Int -> IntMap BodyRecord -> Maybe BodyRecord
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap BodyRecord -> Maybe BodyRecord)
-> IO (IntMap BodyRecord) -> IO (Maybe BodyRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap BodyRecord -> IO (IntMap BodyRecord)
forall a. IORef a -> IO a
readIORef IOMap BodyRecord
bMap
    Double -> Torque
Torque (Double -> Torque) -> IO Double -> IO Torque
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Body -> IO Double
getTorque Ptr Body
b

-- CenterOfGravity
getCenterOfGravity :: Ptr Body -> IO (V2 Double)
getCenterOfGravity :: Ptr Body -> IO (V2 Double)
getCenterOfGravity Ptr Body
bodyPtr = do
  CDouble
x <- [C.exp| double { cpBodyGetCenterOfGravity ($(cpBody* bodyPtr)).x } |]
  CDouble
y <- [C.exp| double { cpBodyGetCenterOfGravity ($(cpBody* bodyPtr)).y } |]
  V2 Double -> IO (V2 Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Double -> V2 Double
forall a. a -> a -> V2 a
V2 (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
x) (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
y))

setCenterOfGravity :: Ptr Body -> V2 Double -> IO ()
setCenterOfGravity :: Ptr Body -> V2 Double -> IO ()
setCenterOfGravity Ptr Body
bodyPtr (V2 (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
x) (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
y)) = [C.block| void {
  const cpVect vel = { $(double x), $(double y) };
  cpBodySetCenterOfGravity($(cpBody* bodyPtr), vel);
  } |]

instance Component CenterOfGravity where
  type Storage CenterOfGravity = Space CenterOfGravity

instance (MonadIO m, Has w m Physics) => Has w m CenterOfGravity where
  getStore :: SystemT w m (Storage CenterOfGravity)
getStore = (Space Physics -> Space CenterOfGravity
forall a b. Space a -> Space b
cast :: Space Physics -> Space CenterOfGravity) (Space Physics -> Space CenterOfGravity)
-> SystemT w m (Space Physics)
-> SystemT w m (Space CenterOfGravity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SystemT w m (Space Physics)
forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore

instance MonadIO m => ExplMembers m (Space CenterOfGravity) where
  explMembers :: Space CenterOfGravity -> m (Vector Int)
explMembers Space CenterOfGravity
s = Space Body -> m (Vector Int)
forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (Space CenterOfGravity -> Space Body
forall a b. Space a -> Space b
cast Space CenterOfGravity
s :: Space Body)

instance MonadIO m => ExplSet m (Space CenterOfGravity) where
  explSet :: Space CenterOfGravity
-> Int -> Elem (Space CenterOfGravity) -> m ()
explSet (Space IOMap BodyRecord
bMap IOMap (Record Shape)
_ IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety (CenterOfGravity vel) = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Maybe BodyRecord
rd <- Int -> IntMap BodyRecord -> Maybe BodyRecord
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap BodyRecord -> Maybe BodyRecord)
-> IO (IntMap BodyRecord) -> IO (Maybe BodyRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap BodyRecord -> IO (IntMap BodyRecord)
forall a. IORef a -> IO a
readIORef IOMap BodyRecord
bMap
    Maybe BodyRecord -> (BodyRecord -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe BodyRecord
rd((BodyRecord -> IO ()) -> IO ()) -> (BodyRecord -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(BodyRecord Ptr Body
b Body
_ IORef IntSet
_ IORef IntSet
_) -> Ptr Body -> V2 Double -> IO ()
setCenterOfGravity Ptr Body
b V2 Double
vel

instance MonadIO m => ExplGet m (Space CenterOfGravity) where
  explExists :: Space CenterOfGravity -> Int -> m Bool
explExists Space CenterOfGravity
s Int
ety = Space Body -> Int -> m Bool
forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (Space CenterOfGravity -> Space Body
forall a b. Space a -> Space b
cast Space CenterOfGravity
s :: Space Body) Int
ety
  explGet :: Space CenterOfGravity -> Int -> m (Elem (Space CenterOfGravity))
explGet (Space IOMap BodyRecord
bMap IOMap (Record Shape)
_ IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety = IO CenterOfGravity -> m CenterOfGravity
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CenterOfGravity -> m CenterOfGravity)
-> IO CenterOfGravity -> m CenterOfGravity
forall a b. (a -> b) -> a -> b
$ do
    Just (BodyRecord Ptr Body
b Body
_ IORef IntSet
_ IORef IntSet
_) <- Int -> IntMap BodyRecord -> Maybe BodyRecord
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap BodyRecord -> Maybe BodyRecord)
-> IO (IntMap BodyRecord) -> IO (Maybe BodyRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap BodyRecord -> IO (IntMap BodyRecord)
forall a. IORef a -> IO a
readIORef IOMap BodyRecord
bMap
    V2 Double -> CenterOfGravity
CenterOfGravity (V2 Double -> CenterOfGravity)
-> IO (V2 Double) -> IO CenterOfGravity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Body -> IO (V2 Double)
getCenterOfGravity Ptr Body
b

-- ShapeList
instance Component ShapeList where
  type Storage ShapeList = Space ShapeList

instance (MonadIO m, Has w m Physics) => Has w m ShapeList where
  getStore :: SystemT w m (Storage ShapeList)
getStore = (Space Physics -> Space ShapeList
forall a b. Space a -> Space b
cast :: Space Physics -> Space ShapeList) (Space Physics -> Space ShapeList)
-> SystemT w m (Space Physics) -> SystemT w m (Space ShapeList)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SystemT w m (Space Physics)
forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore

instance MonadIO m => ExplMembers m (Space ShapeList) where
  explMembers :: Space ShapeList -> m (Vector Int)
explMembers Space ShapeList
s = Space Body -> m (Vector Int)
forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (Space ShapeList -> Space Body
forall a b. Space a -> Space b
cast Space ShapeList
s :: Space Body)

instance MonadIO m => ExplGet m (Space ShapeList) where
  explExists :: Space ShapeList -> Int -> m Bool
explExists Space ShapeList
s Int
ety = Space Body -> Int -> m Bool
forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (Space ShapeList -> Space Body
forall a b. Space a -> Space b
cast Space ShapeList
s :: Space Body) Int
ety
  explGet :: Space ShapeList -> Int -> m (Elem (Space ShapeList))
explGet (Space IOMap BodyRecord
bMap IOMap (Record Shape)
_ IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety = IO ShapeList -> m ShapeList
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ShapeList -> m ShapeList) -> IO ShapeList -> m ShapeList
forall a b. (a -> b) -> a -> b
$ do
    Just (BodyRecord Ptr Body
_ Body
_ IORef IntSet
sPtr IORef IntSet
_) <- Int -> IntMap BodyRecord -> Maybe BodyRecord
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap BodyRecord -> Maybe BodyRecord)
-> IO (IntMap BodyRecord) -> IO (Maybe BodyRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap BodyRecord -> IO (IntMap BodyRecord)
forall a. IORef a -> IO a
readIORef IOMap BodyRecord
bMap
    [Entity] -> ShapeList
ShapeList ([Entity] -> ShapeList)
-> (IntSet -> [Entity]) -> IntSet -> ShapeList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Entity) -> [Int] -> [Entity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Entity
Entity ([Int] -> [Entity]) -> (IntSet -> [Int]) -> IntSet -> [Entity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
S.toList (IntSet -> ShapeList) -> IO IntSet -> IO ShapeList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef IntSet -> IO IntSet
forall a. IORef a -> IO a
readIORef IORef IntSet
sPtr

-- ConstraintList
instance Component ConstraintList where
  type Storage ConstraintList = Space ConstraintList

instance (MonadIO m, Has w m Physics) => Has w m ConstraintList where
  getStore :: SystemT w m (Storage ConstraintList)
getStore = (Space Physics -> Space ConstraintList
forall a b. Space a -> Space b
cast :: Space Physics -> Space ConstraintList) (Space Physics -> Space ConstraintList)
-> SystemT w m (Space Physics)
-> SystemT w m (Space ConstraintList)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SystemT w m (Space Physics)
forall w (m :: * -> *) c. Has w m c => SystemT w m (Storage c)
getStore

instance MonadIO m => ExplMembers m (Space ConstraintList) where
  explMembers :: Space ConstraintList -> m (Vector Int)
explMembers Space ConstraintList
s = Space Body -> m (Vector Int)
forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (Space ConstraintList -> Space Body
forall a b. Space a -> Space b
cast Space ConstraintList
s :: Space Body)

instance MonadIO m => ExplGet m (Space ConstraintList) where
  explExists :: Space ConstraintList -> Int -> m Bool
explExists Space ConstraintList
s Int
ety = Space Body -> Int -> m Bool
forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (Space ConstraintList -> Space Body
forall a b. Space a -> Space b
cast Space ConstraintList
s :: Space Body) Int
ety
  explGet :: Space ConstraintList -> Int -> m (Elem (Space ConstraintList))
explGet (Space IOMap BodyRecord
bMap IOMap (Record Shape)
_ IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety = IO ConstraintList -> m ConstraintList
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ConstraintList -> m ConstraintList)
-> IO ConstraintList -> m ConstraintList
forall a b. (a -> b) -> a -> b
$ do
    Just (BodyRecord Ptr Body
_ Body
_ IORef IntSet
_ IORef IntSet
cPtr) <- Int -> IntMap BodyRecord -> Maybe BodyRecord
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap BodyRecord -> Maybe BodyRecord)
-> IO (IntMap BodyRecord) -> IO (Maybe BodyRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap BodyRecord -> IO (IntMap BodyRecord)
forall a. IORef a -> IO a
readIORef IOMap BodyRecord
bMap
    [Entity] -> ConstraintList
ConstraintList ([Entity] -> ConstraintList)
-> (IntSet -> [Entity]) -> IntSet -> ConstraintList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Entity) -> [Int] -> [Entity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Entity
Entity ([Int] -> [Entity]) -> (IntSet -> [Int]) -> IntSet -> [Entity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
S.toList (IntSet -> ConstraintList) -> IO IntSet -> IO ConstraintList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef IntSet -> IO IntSet
forall a. IORef a -> IO a
readIORef IORef IntSet
cPtr