{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE QuasiQuotes           #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE Strict                #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# LANGUAGE ViewPatterns          #-}

module Apecs.Physics.Shape where

import           Apecs.Core
import           Control.Monad
import           Control.Monad.IO.Class (liftIO, MonadIO)
import           Data.Bits
import qualified Data.IntMap          as M
import qualified Data.IntSet          as S
import           Data.IORef
import           Data.Monoid          ((<>))
import qualified Data.Vector.Storable as V
import qualified Data.Vector.Unboxed  as U
import           Foreign.ForeignPtr
import           Foreign.Ptr
import qualified Language.C.Inline    as C
import           Linear.V2

import           Apecs.Physics.Space  ()
import           Apecs.Physics.Types

C.context (phycsCtx <> C.vecCtx)
C.include "<chipmunk.h>"

maskAll, maskNone :: Bitmask
maskAll :: Bitmask
maskAll  = Bitmask -> Bitmask
forall a. Bits a => a -> a
complement Bitmask
forall a. Bits a => a
zeroBits
maskNone :: Bitmask
maskNone = Bitmask
forall a. Bits a => a
zeroBits
-- | Makes a bitmask from a list of indices
maskList :: [Int] -> Bitmask
maskList :: [Int] -> Bitmask
maskList = (Int -> Bitmask -> Bitmask) -> Bitmask -> [Int] -> Bitmask
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Bitmask -> Int -> Bitmask) -> Int -> Bitmask -> Bitmask
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bitmask -> Int -> Bitmask
forall a. Bits a => a -> Int -> a
setBit) Bitmask
maskNone

defaultFilter :: CollisionFilter
defaultFilter :: CollisionFilter
defaultFilter = CollisionGroup -> Bitmask -> Bitmask -> CollisionFilter
CollisionFilter CollisionGroup
0 Bitmask
maskAll Bitmask
maskAll

-- | A box with the given height, width, and center point
boxShape :: Double -> Double -> Vec -> Convex
boxShape :: Double -> Double -> Vec -> Convex
boxShape Double
w Double
h Vec
offset = [Vec] -> Double -> Convex
Convex ((Vec -> Vec -> Vec
forall a. Num a => a -> a -> a
+Vec
offset) (Vec -> Vec) -> [Vec] -> [Vec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Vec]
verts) Double
0
  where
    w' :: Double
w' = Double
wDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2
    h' :: Double
h' = Double
hDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2
    verts :: [Vec]
verts = [ Double -> Double -> Vec
forall a. a -> a -> V2 a
V2 (-Double
w') (-Double
h')
            , Double -> Double -> Vec
forall a. a -> a -> V2 a
V2 (-Double
w') Double
h'
            , Double -> Double -> Vec
forall a. a -> a -> V2 a
V2 Double
w' Double
h'
            , Double -> Double -> Vec
forall a. a -> a -> V2 a
V2 Double
w' (-Double
h') ]

instance Component Shape where
  type Storage Shape = Space Shape

instance (MonadIO m, Has w m Physics) => Has w m Shape where
  getStore :: SystemT w m (Storage Shape)
getStore = (Space Physics -> Space Shape
forall a b. Space a -> Space b
cast :: Space Physics -> Space Shape) (Space Physics -> Space Shape)
-> SystemT w m (Space Physics) -> SystemT w m (Space Shape)
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 Shape) where
  explMembers :: Space Shape -> m (Vector Int)
explMembers (Space IOMap BodyRecord
_ IOMap (Record Shape)
sMap 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 (Record Shape) -> [Int])
-> IntMap (Record Shape)
-> Vector Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap (Record Shape) -> [Int]
forall a. IntMap a -> [Int]
M.keys (IntMap (Record Shape) -> Vector Int)
-> IO (IntMap (Record Shape)) -> IO (Vector Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap (Record Shape) -> IO (IntMap (Record Shape))
forall a. IORef a -> IO a
readIORef IOMap (Record Shape)
sMap

instance MonadIO m => ExplDestroy m (Space Shape) where
  explDestroy :: Space Shape -> Int -> m ()
explDestroy (Space IOMap BodyRecord
bMap IOMap (Record Shape)
sMap IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
spc) Int
sEty = 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 (Record Shape)
rd <- Int -> IntMap (Record Shape) -> Maybe (Record Shape)
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
sEty (IntMap (Record Shape) -> Maybe (Record Shape))
-> IO (IntMap (Record Shape)) -> IO (Maybe (Record Shape))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap (Record Shape) -> IO (IntMap (Record Shape))
forall a. IORef a -> IO a
readIORef IOMap (Record Shape)
sMap
    Maybe (Record Shape) -> (Record Shape -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Record Shape)
rd ((Record Shape -> IO ()) -> IO ())
-> (Record Shape -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Record Ptr Shape
sPtr (Shape (Entity Int
bEty) Convex
_)) -> do
      Maybe BodyRecord
rd <- Int -> IntMap BodyRecord -> Maybe BodyRecord
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
bEty (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
bRec -> IORef IntSet -> (IntSet -> IntSet) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (BodyRecord -> IORef IntSet
brShapes BodyRecord
bRec) (Int -> IntSet -> IntSet
S.delete Int
sEty)
      IOMap (Record Shape)
-> (IntMap (Record Shape) -> IntMap (Record Shape)) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IOMap (Record Shape)
sMap (Int -> IntMap (Record Shape) -> IntMap (Record Shape)
forall a. Int -> IntMap a -> IntMap a
M.delete Int
sEty)
      SpacePtr -> Ptr Shape -> IO ()
destroyShape SpacePtr
spc Ptr Shape
sPtr

instance MonadIO m => ExplSet m (Space Shape) where
  explSet :: Space Shape -> Int -> Elem (Space Shape) -> m ()
explSet sp :: Space Shape
sp@(Space IOMap BodyRecord
bMap IOMap (Record Shape)
sMap IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
spcPtr) Int
sEty shape :: Elem (Space Shape)
shape@(Shape (Entity bEty) sh) = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Space Shape -> Int -> IO ()
forall (m :: * -> *) s. ExplDestroy m s => s -> Int -> m ()
explDestroy Space Shape
sp Int
sEty
    Maybe BodyRecord
rd <- Int -> IntMap BodyRecord -> Maybe BodyRecord
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
bEty (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
bRec -> do
      Ptr Shape
shPtr <- SpacePtr -> Ptr Body -> Convex -> Int -> IO (Ptr Shape)
newShape SpacePtr
spcPtr (BodyRecord -> Ptr Body
brPtr BodyRecord
bRec) Convex
sh Int
sEty
      IORef IntSet -> (IntSet -> IntSet) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' (BodyRecord -> IORef IntSet
brShapes BodyRecord
bRec) (Int -> IntSet -> IntSet
S.insert Int
sEty)
      IOMap (Record Shape)
-> (IntMap (Record Shape) -> IntMap (Record Shape)) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IOMap (Record Shape)
sMap (Int
-> Record Shape -> IntMap (Record Shape) -> IntMap (Record Shape)
forall a. Int -> a -> IntMap a -> IntMap a
M.insert Int
sEty (Ptr Shape -> Shape -> Record Shape
forall a. Ptr a -> a -> Record a
Record Ptr Shape
shPtr Elem (Space Shape)
Shape
shape))

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

newShape :: SpacePtr -> Ptr Body -> Convex -> Int -> IO (Ptr Shape)
newShape :: SpacePtr -> Ptr Body -> Convex -> Int -> IO (Ptr Shape)
newShape SpacePtr
spacePtr' Ptr Body
bodyPtr Convex
shape (Int -> CIntPtr
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> CIntPtr
ety) = SpacePtr -> (Ptr FrnSpace -> IO (Ptr Shape)) -> IO (Ptr Shape)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr SpacePtr
spacePtr' (Convex -> Ptr FrnSpace -> IO (Ptr Shape)
go Convex
shape)
  where

    go :: Convex -> Ptr FrnSpace -> IO (Ptr Shape)
go (Convex [(Double -> CDouble) -> Vec -> V2 CDouble
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac -> V2 CDouble
x CDouble
y] (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
radius)) Ptr FrnSpace
spacePtr = [C.block| cpShape* {
      const cpVect vec = { $(double x), $(double y) };
      cpShape* sh = cpCircleShapeNew($(cpBody* bodyPtr), $(double radius), vec);
      cpShapeSetUserData(sh, (void*) $(intptr_t ety));
      return cpSpaceAddShape( $(cpSpace* spacePtr), sh); } |]

    go (Convex [ (Double -> CDouble) -> Vec -> V2 CDouble
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac -> V2 CDouble
xa CDouble
ya
               , (Double -> CDouble) -> Vec -> V2 CDouble
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac -> V2 CDouble
xb CDouble
yb ]
                (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
radius)
       ) Ptr FrnSpace
spacePtr = [C.block| cpShape* {
       const cpVect va = { $(double xa), $(double ya) };
       const cpVect vb = { $(double xb), $(double yb) };
       cpShape* sh = cpSegmentShapeNew($(cpBody* bodyPtr), va, vb, $(double radius));
       cpShapeSetUserData(sh, (void*) $(intptr_t ety));
       return cpSpaceAddShape( $(cpSpace* spacePtr), sh); } |]

    go (Convex (((Vec -> V2 CDouble) -> [Vec] -> [V2 CDouble]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((Vec -> V2 CDouble) -> [Vec] -> [V2 CDouble])
-> ((Double -> CDouble) -> Vec -> V2 CDouble)
-> (Double -> CDouble)
-> [Vec]
-> [V2 CDouble]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Double -> CDouble) -> Vec -> V2 CDouble
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac -> [V2 CDouble]
verts)
               (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
radius)
       ) Ptr FrnSpace
spacePtr = IO (Ptr Shape) -> IO (Ptr Shape)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Shape) -> IO (Ptr Shape))
-> IO (Ptr Shape) -> IO (Ptr Shape)
forall a b. (a -> b) -> a -> b
$ do
         MVector RealWorld (V2 CDouble)
vec <- Vector (V2 CDouble) -> IO (MVector (PrimState IO) (V2 CDouble))
forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
Vector a -> m (MVector (PrimState m) a)
V.thaw ([V2 CDouble] -> Vector (V2 CDouble)
forall a. Storable a => [a] -> Vector a
V.fromList [V2 CDouble]
verts)
         [C.block| cpShape* {
           cpTransform trans = cpTransformIdentity;
           cpShape* sh = cpPolyShapeNew($(cpBody* bodyPtr), $vec-len:vec, $vec-ptr:(cpVect *vec), trans, $(double radius));
           cpShapeSetUserData(sh, (void*) $(intptr_t ety));
           return cpSpaceAddShape( $(cpSpace* spacePtr), sh); } |]

destroyShape :: SpacePtr -> Ptr Shape -> IO ()
destroyShape :: SpacePtr -> Ptr Shape -> IO ()
destroyShape SpacePtr
spacePtr Ptr Shape
shapePtr = 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 {
  cpShape *shape = $(cpShape* shapePtr);
  cpSpaceRemoveShape($(cpSpace* space), shape);
  cpShapeFree (shape); }|]

-- Sensor
getSensor :: Ptr Shape -> IO Bool
getSensor :: Ptr Shape -> IO Bool
getSensor Ptr Shape
shape = Int -> Bool
forall a. Enum a => Int -> a
toEnum (Int -> Bool) -> (CInt -> Int) -> CInt -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Bool) -> IO CInt -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [C.exp| int {
  cpShapeGetSensor($(cpShape* shape)) }|]

setSensor :: Ptr Shape -> Bool -> IO ()
setSensor :: Ptr Shape -> Bool -> IO ()
setSensor Ptr Shape
shape (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum -> CInt
isSensor) = [C.exp| void {
  cpShapeSetSensor($(cpShape* shape), $(int isSensor)) }|]

instance Component Sensor where
  type Storage Sensor = Space Sensor
instance (MonadIO m, Has w m Physics) => Has w m Sensor where
  getStore :: SystemT w m (Storage Sensor)
getStore = (Space Physics -> Space Sensor
forall a b. Space a -> Space b
cast :: Space Physics -> Space Sensor) (Space Physics -> Space Sensor)
-> SystemT w m (Space Physics) -> SystemT w m (Space Sensor)
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 Sensor) where
  explMembers :: Space Sensor -> m (Vector Int)
explMembers Space Sensor
s = Space Shape -> m (Vector Int)
forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (Space Sensor -> Space Shape
forall a b. Space a -> Space b
cast Space Sensor
s :: Space Shape)

instance MonadIO m => ExplSet m (Space Sensor) where
  explSet :: Space Sensor -> Int -> Elem (Space Sensor) -> m ()
explSet (Space IOMap BodyRecord
_ IOMap (Record Shape)
sMap IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety (Sensor isSensor) = 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 (Record Shape)
rd <- Int -> IntMap (Record Shape) -> Maybe (Record Shape)
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap (Record Shape) -> Maybe (Record Shape))
-> IO (IntMap (Record Shape)) -> IO (Maybe (Record Shape))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap (Record Shape) -> IO (IntMap (Record Shape))
forall a. IORef a -> IO a
readIORef IOMap (Record Shape)
sMap
    Maybe (Record Shape) -> (Record Shape -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Record Shape)
rd((Record Shape -> IO ()) -> IO ())
-> (Record Shape -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Record Ptr Shape
s Shape
_) -> Ptr Shape -> Bool -> IO ()
setSensor Ptr Shape
s Bool
isSensor

instance MonadIO m => ExplGet m (Space Sensor) where
  explExists :: Space Sensor -> Int -> m Bool
explExists Space Sensor
s 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
$ Space Shape -> Int -> IO Bool
forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (Space Sensor -> Space Shape
forall a b. Space a -> Space b
cast Space Sensor
s :: Space Shape) Int
ety
  explGet :: Space Sensor -> Int -> m (Elem (Space Sensor))
explGet (Space IOMap BodyRecord
_ IOMap (Record Shape)
sMap IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety = IO Sensor -> m Sensor
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Sensor -> m Sensor) -> IO Sensor -> m Sensor
forall a b. (a -> b) -> a -> b
$ do
    Just (Record Ptr Shape
s Shape
_) <- Int -> IntMap (Record Shape) -> Maybe (Record Shape)
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap (Record Shape) -> Maybe (Record Shape))
-> IO (IntMap (Record Shape)) -> IO (Maybe (Record Shape))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap (Record Shape) -> IO (IntMap (Record Shape))
forall a. IORef a -> IO a
readIORef IOMap (Record Shape)
sMap
    Bool -> Sensor
Sensor (Bool -> Sensor) -> IO Bool -> IO Sensor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Shape -> IO Bool
getSensor Ptr Shape
s

-- Elasticity
getElasticity :: Ptr Shape -> IO Double
getElasticity :: Ptr Shape -> IO Double
getElasticity Ptr Shape
shape = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> Double) -> IO CDouble -> IO Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [C.exp| double {
  cpShapeGetElasticity($(cpShape* shape)) }|]

setElasticity :: Ptr Shape -> Double -> IO ()
setElasticity :: Ptr Shape -> Double -> IO ()
setElasticity Ptr Shape
shape (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
elasticity) = [C.exp| void {
  cpShapeSetElasticity($(cpShape* shape), $(double elasticity)) }|]

instance Component Elasticity where
  type Storage Elasticity = Space Elasticity
instance (MonadIO m, Has w m Physics) => Has w m Elasticity where
  getStore :: SystemT w m (Storage Elasticity)
getStore = (Space Physics -> Space Elasticity
forall a b. Space a -> Space b
cast :: Space Physics -> Space Elasticity) (Space Physics -> Space Elasticity)
-> SystemT w m (Space Physics) -> SystemT w m (Space Elasticity)
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 Elasticity) where
  explMembers :: Space Elasticity -> m (Vector Int)
explMembers Space Elasticity
s = Space Shape -> m (Vector Int)
forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (Space Elasticity -> Space Shape
forall a b. Space a -> Space b
cast Space Elasticity
s :: Space Shape)

instance MonadIO m => ExplSet m (Space Elasticity) where
  explSet :: Space Elasticity -> Int -> Elem (Space Elasticity) -> m ()
explSet (Space IOMap BodyRecord
_ IOMap (Record Shape)
sMap IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety (Elasticity elasticity) = 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 (Record Shape)
rd <- Int -> IntMap (Record Shape) -> Maybe (Record Shape)
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap (Record Shape) -> Maybe (Record Shape))
-> IO (IntMap (Record Shape)) -> IO (Maybe (Record Shape))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap (Record Shape) -> IO (IntMap (Record Shape))
forall a. IORef a -> IO a
readIORef IOMap (Record Shape)
sMap
    Maybe (Record Shape) -> (Record Shape -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Record Shape)
rd((Record Shape -> IO ()) -> IO ())
-> (Record Shape -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Record Ptr Shape
s Shape
_) -> Ptr Shape -> Double -> IO ()
setElasticity Ptr Shape
s Double
elasticity

instance MonadIO m => ExplGet m (Space Elasticity) where
  explExists :: Space Elasticity -> Int -> m Bool
explExists Space Elasticity
s 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
$ Space Shape -> Int -> IO Bool
forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (Space Elasticity -> Space Shape
forall a b. Space a -> Space b
cast Space Elasticity
s :: Space Shape) Int
ety
  explGet :: Space Elasticity -> Int -> m (Elem (Space Elasticity))
explGet (Space IOMap BodyRecord
_ IOMap (Record Shape)
sMap IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety = IO Elasticity -> m Elasticity
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Elasticity -> m Elasticity) -> IO Elasticity -> m Elasticity
forall a b. (a -> b) -> a -> b
$ do
    Just (Record Ptr Shape
s Shape
_) <- Int -> IntMap (Record Shape) -> Maybe (Record Shape)
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap (Record Shape) -> Maybe (Record Shape))
-> IO (IntMap (Record Shape)) -> IO (Maybe (Record Shape))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap (Record Shape) -> IO (IntMap (Record Shape))
forall a. IORef a -> IO a
readIORef IOMap (Record Shape)
sMap
    Double -> Elasticity
Elasticity (Double -> Elasticity) -> IO Double -> IO Elasticity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Shape -> IO Double
getElasticity Ptr Shape
s

-- Mass
getMass :: Ptr Shape -> IO Double
getMass :: Ptr Shape -> IO Double
getMass Ptr Shape
shape = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> Double) -> IO CDouble -> IO Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [C.exp| double {
  cpShapeGetMass($(cpShape* shape)) }|]

setMass :: Ptr Shape -> Double -> IO ()
setMass :: Ptr Shape -> Double -> IO ()
setMass Ptr Shape
shape (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
mass) = [C.exp| void {
  cpShapeSetMass($(cpShape* shape), $(double mass)) }|]

instance Component Mass where
  type Storage Mass = Space Mass
instance (MonadIO m, Has w m Physics) => Has w m Mass where
  getStore :: SystemT w m (Storage Mass)
getStore = (Space Physics -> Space Mass
forall a b. Space a -> Space b
cast :: Space Physics -> Space Mass) (Space Physics -> Space Mass)
-> SystemT w m (Space Physics) -> SystemT w m (Space Mass)
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 Mass) where
  explMembers :: Space Mass -> m (Vector Int)
explMembers Space Mass
s = Space Shape -> m (Vector Int)
forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (Space Mass -> Space Shape
forall a b. Space a -> Space b
cast Space Mass
s :: Space Shape)

instance MonadIO m => ExplSet m (Space Mass) where
  explSet :: Space Mass -> Int -> Elem (Space Mass) -> m ()
explSet (Space IOMap BodyRecord
_ IOMap (Record Shape)
sMap IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety (Mass mass) = 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 (Record Shape)
rd <- Int -> IntMap (Record Shape) -> Maybe (Record Shape)
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap (Record Shape) -> Maybe (Record Shape))
-> IO (IntMap (Record Shape)) -> IO (Maybe (Record Shape))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap (Record Shape) -> IO (IntMap (Record Shape))
forall a. IORef a -> IO a
readIORef IOMap (Record Shape)
sMap
    Maybe (Record Shape) -> (Record Shape -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Record Shape)
rd((Record Shape -> IO ()) -> IO ())
-> (Record Shape -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Record Ptr Shape
s Shape
_) -> Ptr Shape -> Double -> IO ()
setMass Ptr Shape
s Double
mass

instance MonadIO m => ExplGet m (Space Mass) where
  explExists :: Space Mass -> Int -> m Bool
explExists Space Mass
s 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
$ Space Shape -> Int -> IO Bool
forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (Space Mass -> Space Shape
forall a b. Space a -> Space b
cast Space Mass
s :: Space Shape) Int
ety
  explGet :: Space Mass -> Int -> m (Elem (Space Mass))
explGet (Space IOMap BodyRecord
_ IOMap (Record Shape)
sMap IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety = IO Mass -> m Mass
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Mass -> m Mass) -> IO Mass -> m Mass
forall a b. (a -> b) -> a -> b
$ do
    Just (Record Ptr Shape
s Shape
_) <- Int -> IntMap (Record Shape) -> Maybe (Record Shape)
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap (Record Shape) -> Maybe (Record Shape))
-> IO (IntMap (Record Shape)) -> IO (Maybe (Record Shape))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap (Record Shape) -> IO (IntMap (Record Shape))
forall a. IORef a -> IO a
readIORef IOMap (Record Shape)
sMap
    Double -> Mass
Mass (Double -> Mass) -> IO Double -> IO Mass
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Shape -> IO Double
getMass Ptr Shape
s

-- Density
getDensity :: Ptr Shape -> IO Double
getDensity :: Ptr Shape -> IO Double
getDensity Ptr Shape
shape = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> Double) -> IO CDouble -> IO Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [C.exp| double {
  cpShapeGetDensity($(cpShape* shape)) }|]

setDensity :: Ptr Shape -> Double -> IO ()
setDensity :: Ptr Shape -> Double -> IO ()
setDensity Ptr Shape
shape (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
density) = [C.exp| void {
  cpShapeSetDensity($(cpShape* shape), $(double density)) }|]

instance Component Density where
  type Storage Density = Space Density
instance (MonadIO m, Has w m Physics) => Has w m Density where
  getStore :: SystemT w m (Storage Density)
getStore = (Space Physics -> Space Density
forall a b. Space a -> Space b
cast :: Space Physics -> Space Density) (Space Physics -> Space Density)
-> SystemT w m (Space Physics) -> SystemT w m (Space Density)
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 Density) where
  explMembers :: Space Density -> m (Vector Int)
explMembers Space Density
s = Space Shape -> m (Vector Int)
forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (Space Density -> Space Shape
forall a b. Space a -> Space b
cast Space Density
s :: Space Shape)

instance MonadIO m => ExplSet m (Space Density) where
  explSet :: Space Density -> Int -> Elem (Space Density) -> m ()
explSet (Space IOMap BodyRecord
_ IOMap (Record Shape)
sMap IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety (Density density) = 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 (Record Shape)
rd <- Int -> IntMap (Record Shape) -> Maybe (Record Shape)
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap (Record Shape) -> Maybe (Record Shape))
-> IO (IntMap (Record Shape)) -> IO (Maybe (Record Shape))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap (Record Shape) -> IO (IntMap (Record Shape))
forall a. IORef a -> IO a
readIORef IOMap (Record Shape)
sMap
    Maybe (Record Shape) -> (Record Shape -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Record Shape)
rd((Record Shape -> IO ()) -> IO ())
-> (Record Shape -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Record Ptr Shape
s Shape
_) -> Ptr Shape -> Double -> IO ()
setDensity Ptr Shape
s Double
density

instance MonadIO m => ExplGet m (Space Density) where
  explExists :: Space Density -> Int -> m Bool
explExists Space Density
s 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
$ Space Shape -> Int -> IO Bool
forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (Space Density -> Space Shape
forall a b. Space a -> Space b
cast Space Density
s :: Space Shape) Int
ety
  explGet :: Space Density -> Int -> m (Elem (Space Density))
explGet (Space IOMap BodyRecord
_ IOMap (Record Shape)
sMap IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety = IO Density -> m Density
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Density -> m Density) -> IO Density -> m Density
forall a b. (a -> b) -> a -> b
$ do
    Just (Record Ptr Shape
s Shape
_) <- Int -> IntMap (Record Shape) -> Maybe (Record Shape)
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap (Record Shape) -> Maybe (Record Shape))
-> IO (IntMap (Record Shape)) -> IO (Maybe (Record Shape))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap (Record Shape) -> IO (IntMap (Record Shape))
forall a. IORef a -> IO a
readIORef IOMap (Record Shape)
sMap
    Double -> Density
Density (Double -> Density) -> IO Double -> IO Density
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Shape -> IO Double
getDensity Ptr Shape
s

-- Friction
getFriction :: Ptr Shape -> IO Double
getFriction :: Ptr Shape -> IO Double
getFriction Ptr Shape
shape = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> Double) -> IO CDouble -> IO Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [C.exp| double {
  cpShapeGetFriction($(cpShape* shape)) }|]

setFriction :: Ptr Shape -> Double -> IO ()
setFriction :: Ptr Shape -> Double -> IO ()
setFriction Ptr Shape
shape (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac -> CDouble
friction) = [C.exp| void {
  cpShapeSetFriction($(cpShape* shape), $(double friction)) }|]

instance Component Friction where
  type Storage Friction = Space Friction
instance (MonadIO m, Has w m Physics) => Has w m Friction where
  getStore :: SystemT w m (Storage Friction)
getStore = (Space Physics -> Space Friction
forall a b. Space a -> Space b
cast :: Space Physics -> Space Friction) (Space Physics -> Space Friction)
-> SystemT w m (Space Physics) -> SystemT w m (Space Friction)
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 Friction) where
  explMembers :: Space Friction -> m (Vector Int)
explMembers Space Friction
s = Space Shape -> m (Vector Int)
forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (Space Friction -> Space Shape
forall a b. Space a -> Space b
cast Space Friction
s :: Space Shape)

instance MonadIO m => ExplSet m (Space Friction) where
  explSet :: Space Friction -> Int -> Elem (Space Friction) -> m ()
explSet (Space IOMap BodyRecord
_ IOMap (Record Shape)
sMap IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety (Friction friction) = 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 (Record Shape)
rd <- Int -> IntMap (Record Shape) -> Maybe (Record Shape)
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap (Record Shape) -> Maybe (Record Shape))
-> IO (IntMap (Record Shape)) -> IO (Maybe (Record Shape))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap (Record Shape) -> IO (IntMap (Record Shape))
forall a. IORef a -> IO a
readIORef IOMap (Record Shape)
sMap
    Maybe (Record Shape) -> (Record Shape -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Record Shape)
rd((Record Shape -> IO ()) -> IO ())
-> (Record Shape -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Record Ptr Shape
s Shape
_) -> Ptr Shape -> Double -> IO ()
setFriction Ptr Shape
s Double
friction

instance MonadIO m => ExplGet m (Space Friction) where
  explExists :: Space Friction -> Int -> m Bool
explExists Space Friction
s 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
$ Space Shape -> Int -> IO Bool
forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (Space Friction -> Space Shape
forall a b. Space a -> Space b
cast Space Friction
s :: Space Shape) Int
ety
  explGet :: Space Friction -> Int -> m (Elem (Space Friction))
explGet (Space IOMap BodyRecord
_ IOMap (Record Shape)
sMap IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety = IO Friction -> m Friction
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Friction -> m Friction) -> IO Friction -> m Friction
forall a b. (a -> b) -> a -> b
$ do
    Just (Record Ptr Shape
s Shape
_) <- Int -> IntMap (Record Shape) -> Maybe (Record Shape)
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap (Record Shape) -> Maybe (Record Shape))
-> IO (IntMap (Record Shape)) -> IO (Maybe (Record Shape))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap (Record Shape) -> IO (IntMap (Record Shape))
forall a. IORef a -> IO a
readIORef IOMap (Record Shape)
sMap
    Double -> Friction
Friction (Double -> Friction) -> IO Double -> IO Friction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Shape -> IO Double
getFriction Ptr Shape
s

-- SurfaceVelocity
getSurfaceVelocity :: Ptr Shape -> IO Vec
getSurfaceVelocity :: Ptr Shape -> IO Vec
getSurfaceVelocity Ptr Shape
shape = do
 CDouble
x <- [C.exp| double { cpShapeGetSurfaceVelocity($(cpShape* shape)).x }|]
 CDouble
y <- [C.exp| double { cpShapeGetSurfaceVelocity($(cpShape* shape)).y }|]
 Vec -> IO Vec
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Double -> Vec
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))

setSurfaceVelocity :: Ptr Shape -> Vec -> IO ()
setSurfaceVelocity :: Ptr Shape -> Vec -> IO ()
setSurfaceVelocity Ptr Shape
shape (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 vec = { $(double x), $(double y) };
  cpShapeSetSurfaceVelocity($(cpShape* shape), vec);
  }|]

instance Component SurfaceVelocity where
  type Storage SurfaceVelocity = Space SurfaceVelocity
instance (MonadIO m, Has w m Physics) => Has w m SurfaceVelocity where
  getStore :: SystemT w m (Storage SurfaceVelocity)
getStore = (Space Physics -> Space SurfaceVelocity
forall a b. Space a -> Space b
cast :: Space Physics -> Space SurfaceVelocity) (Space Physics -> Space SurfaceVelocity)
-> SystemT w m (Space Physics)
-> SystemT w m (Space SurfaceVelocity)
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 SurfaceVelocity) where
  explMembers :: Space SurfaceVelocity -> m (Vector Int)
explMembers Space SurfaceVelocity
s = Space Shape -> m (Vector Int)
forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (Space SurfaceVelocity -> Space Shape
forall a b. Space a -> Space b
cast Space SurfaceVelocity
s :: Space Shape)

instance MonadIO m => ExplSet m (Space SurfaceVelocity) where
  explSet :: Space SurfaceVelocity
-> Int -> Elem (Space SurfaceVelocity) -> m ()
explSet (Space IOMap BodyRecord
_ IOMap (Record Shape)
sMap IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety (SurfaceVelocity svel) = 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 (Record Shape)
rd <- Int -> IntMap (Record Shape) -> Maybe (Record Shape)
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap (Record Shape) -> Maybe (Record Shape))
-> IO (IntMap (Record Shape)) -> IO (Maybe (Record Shape))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap (Record Shape) -> IO (IntMap (Record Shape))
forall a. IORef a -> IO a
readIORef IOMap (Record Shape)
sMap
    Maybe (Record Shape) -> (Record Shape -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Record Shape)
rd((Record Shape -> IO ()) -> IO ())
-> (Record Shape -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Record Ptr Shape
s Shape
_) -> Ptr Shape -> Vec -> IO ()
setSurfaceVelocity Ptr Shape
s Vec
svel

instance MonadIO m => ExplGet m (Space SurfaceVelocity) where
  explExists :: Space SurfaceVelocity -> Int -> m Bool
explExists Space SurfaceVelocity
s 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
$ Space Shape -> Int -> IO Bool
forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (Space SurfaceVelocity -> Space Shape
forall a b. Space a -> Space b
cast Space SurfaceVelocity
s :: Space Shape) Int
ety
  explGet :: Space SurfaceVelocity -> Int -> m (Elem (Space SurfaceVelocity))
explGet (Space IOMap BodyRecord
_ IOMap (Record Shape)
sMap IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety = IO SurfaceVelocity -> m SurfaceVelocity
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SurfaceVelocity -> m SurfaceVelocity)
-> IO SurfaceVelocity -> m SurfaceVelocity
forall a b. (a -> b) -> a -> b
$ do
    Just (Record Ptr Shape
s Shape
_) <- Int -> IntMap (Record Shape) -> Maybe (Record Shape)
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap (Record Shape) -> Maybe (Record Shape))
-> IO (IntMap (Record Shape)) -> IO (Maybe (Record Shape))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap (Record Shape) -> IO (IntMap (Record Shape))
forall a. IORef a -> IO a
readIORef IOMap (Record Shape)
sMap
    Vec -> SurfaceVelocity
SurfaceVelocity (Vec -> SurfaceVelocity) -> IO Vec -> IO SurfaceVelocity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Shape -> IO Vec
getSurfaceVelocity Ptr Shape
s

-- CollisionFilter
getFilter :: Ptr Shape -> IO CollisionFilter
getFilter :: Ptr Shape -> IO CollisionFilter
getFilter Ptr Shape
shape = do
 CollisionGroup
group <- [C.exp| unsigned int { cpShapeGetFilter($(cpShape* shape)).group }|]
 CollisionGroup
cats  <- [C.exp| unsigned int { cpShapeGetFilter($(cpShape* shape)).categories }|]
 CollisionGroup
mask  <- [C.exp| unsigned int { cpShapeGetFilter($(cpShape* shape)).mask }|]
 CollisionFilter -> IO CollisionFilter
forall (m :: * -> *) a. Monad m => a -> m a
return(CollisionFilter -> IO CollisionFilter)
-> CollisionFilter -> IO CollisionFilter
forall a b. (a -> b) -> a -> b
$ CollisionGroup -> Bitmask -> Bitmask -> CollisionFilter
CollisionFilter CollisionGroup
group (CollisionGroup -> Bitmask
Bitmask CollisionGroup
cats) (CollisionGroup -> Bitmask
Bitmask CollisionGroup
mask)

setFilter :: Ptr Shape -> CollisionFilter -> IO ()
setFilter :: Ptr Shape -> CollisionFilter -> IO ()
setFilter Ptr Shape
shape (CollisionFilter CollisionGroup
group (Bitmask CollisionGroup
cats) (Bitmask CollisionGroup
mask)) =
  [C.block| void {
    const cpShapeFilter filter = { $(unsigned int group)
                                 , $(unsigned int cats)
                                 , $(unsigned int mask) };
    cpShapeSetFilter($(cpShape* shape), filter);
  }|]

instance Component CollisionFilter where
  type Storage CollisionFilter = Space CollisionFilter
instance (MonadIO m, Has w m Physics) => Has w m CollisionFilter where
  getStore :: SystemT w m (Storage CollisionFilter)
getStore = (Space Physics -> Space CollisionFilter
forall a b. Space a -> Space b
cast :: Space Physics -> Space CollisionFilter) (Space Physics -> Space CollisionFilter)
-> SystemT w m (Space Physics)
-> SystemT w m (Space CollisionFilter)
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 CollisionFilter) where
  explMembers :: Space CollisionFilter -> m (Vector Int)
explMembers Space CollisionFilter
s = Space Shape -> m (Vector Int)
forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (Space CollisionFilter -> Space Shape
forall a b. Space a -> Space b
cast Space CollisionFilter
s :: Space Shape)

instance MonadIO m => ExplSet m (Space CollisionFilter) where
  explSet :: Space CollisionFilter
-> Int -> Elem (Space CollisionFilter) -> m ()
explSet (Space IOMap BodyRecord
_ IOMap (Record Shape)
sMap IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety Elem (Space CollisionFilter)
cfilter = 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 (Record Shape)
rd <- Int -> IntMap (Record Shape) -> Maybe (Record Shape)
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap (Record Shape) -> Maybe (Record Shape))
-> IO (IntMap (Record Shape)) -> IO (Maybe (Record Shape))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap (Record Shape) -> IO (IntMap (Record Shape))
forall a. IORef a -> IO a
readIORef IOMap (Record Shape)
sMap
    Maybe (Record Shape) -> (Record Shape -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Record Shape)
rd((Record Shape -> IO ()) -> IO ())
-> (Record Shape -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Record Ptr Shape
s Shape
_) -> Ptr Shape -> CollisionFilter -> IO ()
setFilter Ptr Shape
s Elem (Space CollisionFilter)
CollisionFilter
cfilter

instance MonadIO m => ExplGet m (Space CollisionFilter) where
  explExists :: Space CollisionFilter -> Int -> m Bool
explExists Space CollisionFilter
s 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
$ Space Shape -> Int -> IO Bool
forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (Space CollisionFilter -> Space Shape
forall a b. Space a -> Space b
cast Space CollisionFilter
s :: Space Shape) Int
ety
  explGet :: Space CollisionFilter -> Int -> m (Elem (Space CollisionFilter))
explGet (Space IOMap BodyRecord
_ IOMap (Record Shape)
sMap IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety = IO CollisionFilter -> m CollisionFilter
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CollisionFilter -> m CollisionFilter)
-> IO CollisionFilter -> m CollisionFilter
forall a b. (a -> b) -> a -> b
$ do
    Just (Record Ptr Shape
s Shape
_) <- Int -> IntMap (Record Shape) -> Maybe (Record Shape)
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap (Record Shape) -> Maybe (Record Shape))
-> IO (IntMap (Record Shape)) -> IO (Maybe (Record Shape))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap (Record Shape) -> IO (IntMap (Record Shape))
forall a. IORef a -> IO a
readIORef IOMap (Record Shape)
sMap
    Ptr Shape -> IO CollisionFilter
getFilter Ptr Shape
s

-- CollisionType
getCollisionType :: Ptr Shape -> IO C.CUIntPtr
getCollisionType :: Ptr Shape -> IO CUIntPtr
getCollisionType Ptr Shape
shape = [C.exp| uintptr_t {
  cpShapeGetCollisionType($(cpShape* shape)) }|]

setCollisionType :: Ptr Shape -> C.CUIntPtr -> IO ()
setCollisionType :: Ptr Shape -> CUIntPtr -> IO ()
setCollisionType Ptr Shape
shape CUIntPtr
ctype = [C.exp| void {
  cpShapeSetCollisionType($(cpShape* shape), $(uintptr_t ctype)) }|]

instance Component CollisionType where
  type Storage CollisionType = Space CollisionType
instance (MonadIO m, Has w m Physics) => Has w m CollisionType where
  getStore :: SystemT w m (Storage CollisionType)
getStore = (Space Physics -> Space CollisionType
forall a b. Space a -> Space b
cast :: Space Physics -> Space CollisionType) (Space Physics -> Space CollisionType)
-> SystemT w m (Space Physics) -> SystemT w m (Space CollisionType)
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 CollisionType) where
  explMembers :: Space CollisionType -> m (Vector Int)
explMembers Space CollisionType
s = Space Shape -> m (Vector Int)
forall (m :: * -> *) s. ExplMembers m s => s -> m (Vector Int)
explMembers (Space CollisionType -> Space Shape
forall a b. Space a -> Space b
cast Space CollisionType
s :: Space Shape)

instance MonadIO m => ExplSet m (Space CollisionType) where
  explSet :: Space CollisionType -> Int -> Elem (Space CollisionType) -> m ()
explSet (Space IOMap BodyRecord
_ IOMap (Record Shape)
sMap IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety (CollisionType ctype) = 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 (Record Shape)
rd <- Int -> IntMap (Record Shape) -> Maybe (Record Shape)
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap (Record Shape) -> Maybe (Record Shape))
-> IO (IntMap (Record Shape)) -> IO (Maybe (Record Shape))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap (Record Shape) -> IO (IntMap (Record Shape))
forall a. IORef a -> IO a
readIORef IOMap (Record Shape)
sMap
    Maybe (Record Shape) -> (Record Shape -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Record Shape)
rd((Record Shape -> IO ()) -> IO ())
-> (Record Shape -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Record Ptr Shape
s Shape
_) -> Ptr Shape -> CUIntPtr -> IO ()
setCollisionType Ptr Shape
s CUIntPtr
ctype

instance MonadIO m => ExplGet m (Space CollisionType) where
  explExists :: Space CollisionType -> Int -> m Bool
explExists Space CollisionType
s 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
$ Space Shape -> Int -> IO Bool
forall (m :: * -> *) s. ExplGet m s => s -> Int -> m Bool
explExists (Space CollisionType -> Space Shape
forall a b. Space a -> Space b
cast Space CollisionType
s :: Space Shape) Int
ety
  explGet :: Space CollisionType -> Int -> m (Elem (Space CollisionType))
explGet (Space IOMap BodyRecord
_ IOMap (Record Shape)
sMap IOMap (Record Constraint)
_ IOMap (Record CollisionHandler)
_ SpacePtr
_) Int
ety = IO CollisionType -> m CollisionType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CollisionType -> m CollisionType)
-> IO CollisionType -> m CollisionType
forall a b. (a -> b) -> a -> b
$ do
    Just (Record Ptr Shape
s Shape
_) <- Int -> IntMap (Record Shape) -> Maybe (Record Shape)
forall a. Int -> IntMap a -> Maybe a
M.lookup Int
ety (IntMap (Record Shape) -> Maybe (Record Shape))
-> IO (IntMap (Record Shape)) -> IO (Maybe (Record Shape))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOMap (Record Shape) -> IO (IntMap (Record Shape))
forall a. IORef a -> IO a
readIORef IOMap (Record Shape)
sMap
    CUIntPtr -> CollisionType
CollisionType (CUIntPtr -> CollisionType) -> IO CUIntPtr -> IO CollisionType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Shape -> IO CUIntPtr
getCollisionType Ptr Shape
s