{-# 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>"
newBody :: SpacePtr -> Int -> IO (Ptr Body)
newBody :: SpacePtr -> Int -> IO (Ptr Body)
newBody SpacePtr
spacePtr (forall a b. (Integral a, Num b) => a -> b
fromIntegral -> CIntPtr
ety) = 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| 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 (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
bodyInt) =
[C.exp| void { cpBodySetType($(cpBody* bodyPtr), $(int bodyInt)) } |]
getBodyType :: Ptr Body -> IO Body
getBodyType :: Ptr Body -> IO Body
getBodyType Ptr Body
bodyPtr = 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 (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 = 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 {
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 = (forall a b. Space a -> Space b
cast :: Space Physics -> Space Body) 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 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Maybe BodyRecord
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 BodyRecord
bMap
Ptr Body
bdyPtr <- case Maybe BodyRecord
rd of
Just (BodyRecord Ptr Body
bdyPtr Body
_ IORef IntSet
_ IORef IntSet
_) -> 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 <- forall a. a -> IO (IORef a)
newIORef forall a. Monoid a => a
mempty
IORef IntSet
bcMap <- forall a. a -> IO (IORef a)
newIORef forall a. Monoid a => a
mempty
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IOMap BodyRecord
bMap (forall a. Int -> a -> IntMap a -> IntMap a
M.insert Int
ety forall a b. (a -> b) -> a -> b
$ Ptr Body -> Body -> IORef IntSet -> IORef IntSet -> BodyRecord
BodyRecord Ptr Body
bdyPtr Elem (Space Body)
btype IORef IntSet
bsMap IORef IntSet
bcMap)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Body
bdyPtr
Ptr Body -> Body -> IO ()
setBodyType Ptr Body
bdyPtr Elem (Space 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Maybe BodyRecord
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 BodyRecord
bMap
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IOMap BodyRecord
bMap (forall a. Int -> IntMap a -> IntMap a
M.delete Int
ety)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe BodyRecord
rd forall a b. (a -> b) -> a -> b
$ \(BodyRecord Ptr Body
bPtr Body
_ IORef IntSet
shapes IORef IntSet
constraints) -> do
forall a. IORef a -> IO a
readIORef IORef IntSet
shapes forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall (m :: * -> *) s. ExplDestroy m s => s -> Int -> m ()
explDestroy (forall a b. Space a -> Space b
cast Space Body
sp :: Space Shape)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
S.toList
forall a. IORef a -> IO a
readIORef IORef IntSet
constraints forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall (m :: * -> *) s. ExplDestroy m s => s -> Int -> m ()
explDestroy (forall a b. Space a -> Space b
cast Space Body
sp :: Space Constraint)) 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
_) = 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 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 = 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 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Just (BodyRecord Ptr Body
_ Body
b IORef IntSet
_ IORef IntSet
_) <- 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 BodyRecord
bMap
forall (m :: * -> *) a. Monad m => a -> m a
return Body
b
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 } |]
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> a -> V2 a
V2 (forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
x) (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 (forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
x) (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 = (forall a b. Space a -> Space b
cast :: Space Physics -> Space Position) 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 Position) where
explMembers :: Space Position -> m (Vector Int)
explMembers Space Position
s = forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (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 V2 Double
pos) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Maybe BodyRecord
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 BodyRecord
bMap
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe BodyRecord
rdforall 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 = forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Just (BodyRecord Ptr Body
b Body
_ IORef IntSet
_ IORef IntSet
_) <- 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 BodyRecord
bMap
V2 Double -> Position
Position forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Body -> IO (V2 Double)
getPosition Ptr Body
b
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 } |]
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> a -> V2 a
V2 (forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
x) (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 (forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
x) (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 = (forall a b. Space a -> Space b
cast :: Space Physics -> Space Velocity) 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 Velocity) where
explMembers :: Space Velocity -> m (Vector Int)
explMembers Space Velocity
s = forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (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 V2 Double
vel) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Maybe BodyRecord
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 BodyRecord
bMap
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe BodyRecord
rdforall 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 = forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Just (BodyRecord Ptr Body
b Body
_ IORef IntSet
_ IORef IntSet
_) <- 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 BodyRecord
bMap
V2 Double -> Velocity
Velocity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Body -> IO (V2 Double)
getVelocity Ptr Body
b
getAngle :: Ptr Body -> IO Double
getAngle :: Ptr Body -> IO Double
getAngle Ptr Body
bodyPtr = do
CDouble
angle <- [C.exp| double { cpBodyGetAngle ($(cpBody* bodyPtr)) } |]
forall (m :: * -> *) a. Monad m => a -> m a
return (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 (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);
} |]
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 = (forall a b. Space a -> Space b
cast :: Space Physics -> Space Angle) 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 Angle) where
explMembers :: Space Angle -> m (Vector Int)
explMembers Space Angle
s = forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (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 Double
angle) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Maybe BodyRecord
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 BodyRecord
bMap
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe BodyRecord
rd 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 = forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Just (BodyRecord Ptr Body
b Body
_ IORef IntSet
_ IORef IntSet
_) <- 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 BodyRecord
bMap
Double -> Angle
Angle forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Body -> IO Double
getAngle Ptr Body
b
getAngularVelocity :: Ptr Body -> IO Double
getAngularVelocity :: Ptr Body -> IO Double
getAngularVelocity Ptr Body
bodyPtr = do
CDouble
angle <- [C.exp| double { cpBodyGetAngularVelocity ($(cpBody* bodyPtr)) } |]
forall (m :: * -> *) a. Monad m => a -> m a
return (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 (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);
} |]
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 = (forall a b. Space a -> Space b
cast :: Space Physics -> Space AngularVelocity) 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 AngularVelocity) where
explMembers :: Space AngularVelocity -> m (Vector Int)
explMembers Space AngularVelocity
s = forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (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 Double
angle) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Maybe BodyRecord
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 BodyRecord
bMap
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe BodyRecord
rd 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 = forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Just (BodyRecord Ptr Body
b Body
_ IORef IntSet
_ IORef IntSet
_) <- 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 BodyRecord
bMap
Double -> AngularVelocity
AngularVelocity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Body -> IO Double
getAngularVelocity Ptr Body
b
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 } |]
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> a -> V2 a
V2 (forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
x) (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 (forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
x) (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 = (forall a b. Space a -> Space b
cast :: Space Physics -> Space Force) 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 Force) where
explMembers :: Space Force -> m (Vector Int)
explMembers Space Force
s = forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (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 V2 Double
frc) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Maybe BodyRecord
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 BodyRecord
bMap
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe BodyRecord
rdforall 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 = forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Just (BodyRecord Ptr Body
b Body
_ IORef IntSet
_ IORef IntSet
_) <- 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 BodyRecord
bMap
V2 Double -> Force
Force forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Body -> IO (V2 Double)
getForce Ptr Body
b
getBodyMass :: Ptr Body -> IO Double
getBodyMass :: Ptr Body -> IO Double
getBodyMass Ptr Body
bodyPtr = do
CDouble
angle <- [C.exp| double { cpBodyGetMass ($(cpBody* bodyPtr)) } |]
forall (m :: * -> *) a. Monad m => a -> m a
return (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 (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);
} |]
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 = (forall a b. Space a -> Space b
cast :: Space Physics -> Space BodyMass) 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 BodyMass) where
explMembers :: Space BodyMass -> m (Vector Int)
explMembers Space BodyMass
s = forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (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 Double
angle) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Maybe BodyRecord
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 BodyRecord
bMap
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe BodyRecord
rd 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 = forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Just (BodyRecord Ptr Body
b Body
_ IORef IntSet
_ IORef IntSet
_) <- 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 BodyRecord
bMap
Double -> BodyMass
BodyMass forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Body -> IO Double
getBodyMass Ptr Body
b
getMoment :: Ptr Body -> IO Double
getMoment :: Ptr Body -> IO Double
getMoment Ptr Body
bodyPtr = do
CDouble
angle <- [C.exp| double { cpBodyGetMoment ($(cpBody* bodyPtr)) } |]
forall (m :: * -> *) a. Monad m => a -> m a
return (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 (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);
} |]
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 = (forall a b. Space a -> Space b
cast :: Space Physics -> Space Moment) 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 Moment) where
explMembers :: Space Moment -> m (Vector Int)
explMembers Space Moment
s = forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (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 Double
angle) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Maybe BodyRecord
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 BodyRecord
bMap
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe BodyRecord
rd 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 = forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Just (BodyRecord Ptr Body
b Body
_ IORef IntSet
_ IORef IntSet
_) <- 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 BodyRecord
bMap
Double -> Moment
Moment forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Body -> IO Double
getMoment Ptr Body
b
getTorque :: Ptr Body -> IO Double
getTorque :: Ptr Body -> IO Double
getTorque Ptr Body
bodyPtr = do
CDouble
angle <- [C.exp| double { cpBodyGetTorque ($(cpBody* bodyPtr)) } |]
forall (m :: * -> *) a. Monad m => a -> m a
return (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 (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);
} |]
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 = (forall a b. Space a -> Space b
cast :: Space Physics -> Space Torque) 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 Torque) where
explMembers :: Space Torque -> m (Vector Int)
explMembers Space Torque
s = forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (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 Double
angle) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Maybe BodyRecord
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 BodyRecord
bMap
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe BodyRecord
rd 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 = forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Just (BodyRecord Ptr Body
b Body
_ IORef IntSet
_ IORef IntSet
_) <- 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 BodyRecord
bMap
Double -> Torque
Torque forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Body -> IO Double
getTorque Ptr Body
b
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 } |]
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> a -> V2 a
V2 (forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
x) (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 (forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
x) (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 = (forall a b. Space a -> Space b
cast :: Space Physics -> Space CenterOfGravity) 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 CenterOfGravity) where
explMembers :: Space CenterOfGravity -> m (Vector Int)
explMembers Space CenterOfGravity
s = forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (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 V2 Double
vel) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Maybe BodyRecord
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 BodyRecord
bMap
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe BodyRecord
rdforall 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 = forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Just (BodyRecord Ptr Body
b Body
_ IORef IntSet
_ IORef IntSet
_) <- 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 BodyRecord
bMap
V2 Double -> CenterOfGravity
CenterOfGravity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Body -> IO (V2 Double)
getCenterOfGravity Ptr Body
b
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 = (forall a b. Space a -> Space b
cast :: Space Physics -> Space ShapeList) 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 ShapeList) where
explMembers :: Space ShapeList -> m (Vector Int)
explMembers Space ShapeList
s = forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (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 = forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Just (BodyRecord Ptr Body
_ Body
_ IORef IntSet
sPtr IORef IntSet
_) <- 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 BodyRecord
bMap
[Entity] -> ShapeList
ShapeList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Entity
Entity forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
S.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IORef IntSet
sPtr
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 = (forall a b. Space a -> Space b
cast :: Space Physics -> Space ConstraintList) 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 ConstraintList) where
explMembers :: Space ConstraintList -> m (Vector Int)
explMembers Space ConstraintList
s = forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (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 = forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Just (BodyRecord Ptr Body
_ Body
_ IORef IntSet
_ IORef IntSet
cPtr) <- 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 BodyRecord
bMap
[Entity] -> ConstraintList
ConstraintList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Entity
Entity forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
S.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IORef IntSet
cPtr