{-# LANGUAGE AllowAmbiguousTypes #-}
module Mischief.ECS.Tables where
import Control.Monad (forM, when)
import Data.Foldable (Foldable (toList), find, for_)
import Data.IORef
import Data.Kind
import Data.List (transpose)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing)
import Data.Traversable (for)
import Data.Typeable (Proxy (Proxy), eqT, typeRep, type (:~:) (Refl))
import Data.Vector qualified as Vector
import GHC.Base (Int (..), Word (W#), eqWord#, isTrue#)
import GHC.Records
import GHC.TypeLits
import Mischief.ECS.Components
import Mischief.ECS.Components.Bundle
import Mischief.ECS.Entities
import Mischief.ECS.EntityDef (Entity# (Entity#), eqEntity#, liftEntity)
import Mischief.ECS.Utils
import Mischief.ECS.Vec (IOVec)
import Mischief.ECS.Vec qualified as Vec
newtype Tables = Tables {Tables -> IOVec Table
inner :: IOVec Table}
data Table = Table
{ Table -> IORef (Map ComponentId Column)
columns :: IORef (Map ComponentId Column),
Table -> [ComponentId]
components :: [ComponentId],
Table -> Vec RealWorld (Entity, IORef EntityPointer)
entities :: IOVec (Entity, IORef EntityPointer)
}
newtype Column = Column (IOVec ComponentData)
baseline_entities_cap :: Int
baseline_entities_cap :: Int
baseline_entities_cap = Int
64
emptyTables :: IO Tables
emptyTables :: IO Tables
emptyTables = do
v <- Int -> IO (Vec (PrimState IO) Table)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (Vec (PrimState m) a)
Vec.new Int
128
Vec.pushBack v =<< newTable []
pure $ Tables v
newTable :: [ComponentId] -> IO Table
newTable :: [ComponentId] -> IO Table
newTable [ComponentId]
components = do
cols <-
[ComponentId]
-> (ComponentId -> IO (ComponentId, Column))
-> IO [(ComponentId, Column)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [ComponentId]
components ((ComponentId -> IO (ComponentId, Column))
-> IO [(ComponentId, Column)])
-> (ComponentId -> IO (ComponentId, Column))
-> IO [(ComponentId, Column)]
forall a b. (a -> b) -> a -> b
$ \ComponentId
x -> do
empty_vec <- Int -> IO (Vec (PrimState IO) ComponentData)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (Vec (PrimState m) a)
Vec.new Int
baseline_entities_cap
pure (x, Column empty_vec)
columns <- newIORef $ Map.fromList (toList cols)
entities <- Vec.new baseline_entities_cap
return $ Table {columns = columns, components, entities}
tableIsEmpty :: Table -> IO Bool
tableIsEmpty :: Table -> IO Bool
tableIsEmpty Table
table = Vec (PrimState IO) (Entity, IORef EntityPointer) -> IO Bool
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> m Bool
Vec.null Table
table.entities
tapMap ::
(Monad m, Ord k) =>
Map k a ->
k ->
(a -> m ()) ->
m ()
tapMap :: forall (m :: * -> *) k a.
(Monad m, Ord k) =>
Map k a -> k -> (a -> m ()) -> m ()
tapMap Map k a
map k
k a -> m ()
act = do
m () -> (a -> m ()) -> Maybe a -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) a -> m ()
act (Maybe a -> m ()) -> Maybe a -> m ()
forall a b. (a -> b) -> a -> b
$ k -> Map k a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map k a
map
insertComponentsIntoMap :: ProcessedBundleData -> Map ComponentId Column -> IO ()
insertComponentsIntoMap :: ProcessedBundleData -> Map ComponentId Column -> IO ()
insertComponentsIntoMap ProcessedBundleData
bundle Map ComponentId Column
map =
[ProcessedBundleElement]
-> (ProcessedBundleElement -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ProcessedBundleData
bundle.elements ((ProcessedBundleElement -> IO ()) -> IO ())
-> (ProcessedBundleElement -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ProcessedBundleElement
el ->
Map ComponentId Column -> ComponentId -> (Column -> IO ()) -> IO ()
forall (m :: * -> *) k a.
(Monad m, Ord k) =>
Map k a -> k -> (a -> m ()) -> m ()
tapMap Map ComponentId Column
map ProcessedBundleElement
el.id ((Column -> IO ()) -> IO ()) -> (Column -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Column IOVec ComponentData
col) ->
Vec (PrimState IO) ComponentData -> ComponentData -> IO ()
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> a -> m ()
Vec.pushBack IOVec ComponentData
Vec (PrimState IO) ComponentData
col ProcessedBundleElement
el.component
insertComponentsIntoTable :: ProcessedBundleData -> Table -> IO ()
insertComponentsIntoTable :: ProcessedBundleData -> Table -> IO ()
insertComponentsIntoTable ProcessedBundleData
bundle Table
table = do
cols <- IORef (Map ComponentId Column) -> IO (Map ComponentId Column)
forall a. IORef a -> IO a
readIORef Table
table.columns
insertComponentsIntoMap bundle cols
replaceComponentsIntoMap ::
ProcessedBundleData ->
Maybe Tick ->
EntityPointer ->
Map ComponentId Column ->
IO ()
replaceComponentsIntoMap :: ProcessedBundleData
-> Maybe Tick -> EntityPointer -> Map ComponentId Column -> IO ()
replaceComponentsIntoMap ProcessedBundleData
bundle Maybe Tick
tick (EntityPointer (# Int#
archetypeId, Int#
rowIndex #)) Map ComponentId Column
tableMap = do
[ProcessedBundleElement]
-> (ProcessedBundleElement -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ProcessedBundleData
bundle.elements ((ProcessedBundleElement -> IO ()) -> IO ())
-> (ProcessedBundleElement -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ProcessedBundleElement
el ->
Map ComponentId Column -> ComponentId -> (Column -> IO ()) -> IO ()
forall (m :: * -> *) k a.
(Monad m, Ord k) =>
Map k a -> k -> (a -> m ()) -> m ()
tapMap Map ComponentId Column
tableMap ProcessedBundleElement
el.id ((Column -> IO ()) -> IO ()) -> (Column -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Column IOVec ComponentData
col) ->
case Maybe Tick
tick of
Just Tick
tick ->
Vec (PrimState IO) ComponentData
-> Int -> (ComponentData -> ComponentData) -> IO ()
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> Int -> (a -> a) -> m ()
Vec.modify_ IOVec ComponentData
Vec (PrimState IO) ComponentData
col (Int# -> Int
I# Int#
rowIndex) (\ComponentData {ErasedComponent
value :: ErasedComponent
value :: ComponentData -> ErasedComponent
value, ticks :: ComponentData -> ComponentTicks
ticks = ComponentTicks {Tick
changed :: Tick
changed :: ComponentTicks -> Tick
changed, Tick
added :: Tick
added :: ComponentTicks -> Tick
added}} -> ComponentData {value :: ErasedComponent
value = ProcessedBundleElement
el.component.value, ticks :: ComponentTicks
ticks = ComponentTicks {changed :: Tick
changed = Tick
tick, Tick
added :: Tick
added :: Tick
added}})
Maybe Tick
Nothing ->
Vec (PrimState IO) ComponentData
-> Int -> (ComponentData -> ComponentData) -> IO ()
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> Int -> (a -> a) -> m ()
Vec.modify_ IOVec ComponentData
Vec (PrimState IO) ComponentData
col (Int# -> Int
I# Int#
rowIndex) (\ComponentData {ErasedComponent
value :: ComponentData -> ErasedComponent
value :: ErasedComponent
value, ComponentTicks
ticks :: ComponentData -> ComponentTicks
ticks :: ComponentTicks
ticks} -> ComponentData {value :: ErasedComponent
value = ProcessedBundleElement
el.component.value, ComponentTicks
ticks :: ComponentTicks
ticks :: ComponentTicks
ticks})
replaceComponentsIntoTable ::
ProcessedBundleData ->
Maybe Tick ->
EntityPointer ->
Table ->
IO ()
replaceComponentsIntoTable :: ProcessedBundleData
-> Maybe Tick -> EntityPointer -> Table -> IO ()
replaceComponentsIntoTable ProcessedBundleData
bundle Maybe Tick
tick EntityPointer
pointer Table
table = do
cols <- IORef (Map ComponentId Column) -> IO (Map ComponentId Column)
forall a. IORef a -> IO a
readIORef Table
table.columns
replaceComponentsIntoMap bundle tick pointer cols
takeFromColumn :: EntityPointer -> Column -> IO ComponentData
takeFromColumn :: EntityPointer -> Column -> IO ComponentData
takeFromColumn (EntityPointer (# Int#
_, Int#
rowIndex #)) (Column IOVec ComponentData
col) = Vec (PrimState IO) ComponentData -> Int -> IO ComponentData
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> Int -> m a
Vec.takeSwap IOVec ComponentData
Vec (PrimState IO) ComponentData
col (Int# -> Int
I# Int#
rowIndex)
takeComponentsFromTable :: EntityPointer -> Table -> IO ProcessedBundleData
takeComponentsFromTable :: EntityPointer -> Table -> IO ProcessedBundleData
takeComponentsFromTable (EntityPointer (# Int#
archetypeId, Int#
rowIndex #)) Table
table = do
cols <- IORef (Map ComponentId Column) -> IO (Map ComponentId Column)
forall a. IORef a -> IO a
readIORef Table
table.columns
newColumns <- for cols $ takeFromColumn (EntityPointer (# archetypeId, rowIndex #))
removeEntityFromTable (I# rowIndex) table
let elements = ((ComponentId, ComponentData) -> ProcessedBundleElement)
-> [(ComponentId, ComponentData)] -> [ProcessedBundleElement]
forall a b. (a -> b) -> [a] -> [b]
map ((ComponentId -> ComponentData -> ProcessedBundleElement)
-> (ComponentId, ComponentData) -> ProcessedBundleElement
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ComponentId -> ComponentData -> ProcessedBundleElement
ProcessedBundleElement) ([(ComponentId, ComponentData)] -> [ProcessedBundleElement])
-> [(ComponentId, ComponentData)] -> [ProcessedBundleElement]
forall a b. (a -> b) -> a -> b
$ Map ComponentId ComponentData -> [(ComponentId, ComponentData)]
forall k a. Map k a -> [(k, a)]
Map.toList Map ComponentId ComponentData
newColumns
pure ProcessedBundleData {elements}
collectComponentIdsFromTable :: Table -> IO [ComponentId]
collectComponentIdsFromTable :: Table -> IO [ComponentId]
collectComponentIdsFromTable Table
table = do
cols <- IORef (Map ComponentId Column) -> IO (Map ComponentId Column)
forall a. IORef a -> IO a
readIORef Table
table.columns
return $ map fst $ Map.toList cols
removeComponentFromColumn :: EntityPointer -> Column -> IO ()
removeComponentFromColumn :: EntityPointer -> Column -> IO ()
removeComponentFromColumn (EntityPointer (# Int#
_, Int#
rowIndex #)) (Column IOVec ComponentData
col) = Vec (PrimState IO) ComponentData -> Int -> IO ()
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> Int -> m ()
Vec.removeSwap IOVec ComponentData
Vec (PrimState IO) ComponentData
col (Int# -> Int
I# Int#
rowIndex)
removeComponentsFromMap :: EntityPointer -> Map ComponentId Column -> IO ()
removeComponentsFromMap :: EntityPointer -> Map ComponentId Column -> IO ()
removeComponentsFromMap EntityPointer
pointer Map ComponentId Column
columnMap =
Map ComponentId Column -> (Column -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Map ComponentId Column
columnMap ((Column -> IO ()) -> IO ()) -> (Column -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ EntityPointer -> Column -> IO ()
removeComponentFromColumn EntityPointer
pointer
removeComponentsFromTable :: EntityPointer -> Table -> IO ()
removeComponentsFromTable :: EntityPointer -> Table -> IO ()
removeComponentsFromTable (EntityPointer (# Int#
archetypeId, Int#
rowIndex #)) Table
table = do
cols <- IORef (Map ComponentId Column) -> IO (Map ComponentId Column)
forall a. IORef a -> IO a
readIORef Table
table.columns
removeComponentsFromMap (EntityPointer (# archetypeId, rowIndex #)) cols
removeEntityFromTable (I# rowIndex) table
removeRow :: Int -> IOVec (Entity, IORef EntityPointer) -> IO ()
removeRow :: Int -> Vec RealWorld (Entity, IORef EntityPointer) -> IO ()
removeRow Int
row_idx Vec RealWorld (Entity, IORef EntityPointer)
vec = do
len <- Vec (PrimState IO) (Entity, IORef EntityPointer) -> IO Int
forall (m :: * -> *) a. PrimMonad m => Vec (PrimState m) a -> m Int
Vec.length Vec RealWorld (Entity, IORef EntityPointer)
Vec (PrimState IO) (Entity, IORef EntityPointer)
vec
Vec.removeSwap vec row_idx
when (row_idx < len - 1) $ do
Vec.tap vec row_idx $ \(Entity
_, IORef EntityPointer
ptr) ->
IORef EntityPointer -> (EntityPointer -> EntityPointer) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef EntityPointer
ptr ((EntityPointer -> EntityPointer) -> IO ())
-> (EntityPointer -> EntityPointer) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(EntityPointer (# Int#
archetypeId, Int#
_ #)) ->
let !(I# Int#
id) = Int
row_idx
in (# Int#, Int# #) -> EntityPointer
EntityPointer (# Int#
archetypeId, Int#
id #)
removeEntityFromTable :: Int -> Table -> IO ()
removeEntityFromTable :: Int -> Table -> IO ()
removeEntityFromTable Int
row Table
table = Int -> Vec RealWorld (Entity, IORef EntityPointer) -> IO ()
removeRow Int
row Table
table.entities
insertEntityIntoTables :: ProcessedBundleData -> Tables -> ArchetypeId -> (Entity, IORef EntityPointer) -> IO ()
insertEntityIntoTables :: ProcessedBundleData
-> Tables -> ArchetypeId -> (Entity, IORef EntityPointer) -> IO ()
insertEntityIntoTables ProcessedBundleData
bundle (Tables IOVec Table
tables) ArchetypeId
archetype (Entity, IORef EntityPointer)
pointerRef =
do
table <- Vec (PrimState IO) Table -> Int -> IO Table
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> Int -> m a
Vec.unsafeRead IOVec Table
Vec (PrimState IO) Table
tables ArchetypeId
archetype.id
rowIndex <- Vec.length table.entities
Vec.pushBack table.entities pointerRef
let !(I# archetype') = archetype.id
let !(I# rowIndex') = rowIndex
writeIORef (snd pointerRef) $ EntityPointer (# archetype', rowIndex' #)
insertComponentsIntoTable bundle table
tryGetComponentFromColumn :: forall c. (Component c) => Column -> EntityPointer -> IO (Maybe c)
tryGetComponentFromColumn :: forall c. Component c => Column -> EntityPointer -> IO (Maybe c)
tryGetComponentFromColumn (Column IOVec ComponentData
components) (EntityPointer (# Int#
_, Int#
rowIndex #)) = do
element <- Vec (PrimState IO) ComponentData -> Int -> IO ComponentData
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> Int -> m a
Vec.unsafeRead IOVec ComponentData
Vec (PrimState IO) ComponentData
components (Int# -> Int
I# Int#
rowIndex)
pure $ tryGetComponent element.value
tryGetRelCollectionFromTable :: forall c. (Component c) => Table -> Entity -> EntityPointer -> ComponentId -> IO (Maybe [Result (Rel c)])
tryGetRelCollectionFromTable :: forall c.
Component c =>
Table
-> Entity
-> EntityPointer
-> ComponentId
-> IO (Maybe [Result (Rel c)])
tryGetRelCollectionFromTable Table
table Entity
entity EntityPointer
pointer (ComponentId (# Word#
id, Maybe Entity
target #)) =
do
columns <- IORef (Map ComponentId Column) -> IO (Map ComponentId Column)
forall a. IORef a -> IO a
readIORef Table
table.columns
components' <- forM (Map.toList columns) $ \(ComponentId (# Word#
id', Maybe Entity
target' #), Column
column) -> do
if Int# -> Bool
isTrue# (Int# -> Bool) -> Int# -> Bool
forall a b. (a -> b) -> a -> b
$ Word# -> Word# -> Int#
eqWord# Word#
id Word#
id'
then do
case Maybe Entity
target' of
Maybe Entity
Nothing -> Maybe (c, Entity) -> IO (Maybe (c, Entity))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (c, Entity)
forall a. Maybe a
Nothing
Just Entity
entity -> do
component <- forall c. Component c => Column -> EntityPointer -> IO (Maybe c)
tryGetComponentFromColumn @c Column
column EntityPointer
pointer
return $ fmap (,entity) component
else Maybe (c, Entity) -> IO (Maybe (c, Entity))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (c, Entity)
forall a. Maybe a
Nothing
if null $ catMaybes components'
then
return Nothing
else do
return $ Just $ map (\(c
value, Entity
target) -> (Rel c, Entity) -> Result (Rel c)
forall c. (c, Entity) -> Result c
Result (c -> Entity -> Rel c
forall c. c -> Entity -> Rel c
Rel c
value Entity
target, Entity
entity)) $ catMaybes components'
tryGetComponentFromTable :: forall c. (Component c) => Table -> EntityPointer -> ComponentId -> IO (Maybe c)
tryGetComponentFromTable :: forall c.
Component c =>
Table -> EntityPointer -> ComponentId -> IO (Maybe c)
tryGetComponentFromTable Table
table EntityPointer
pointer ComponentId
componentId =
do
columns <- IORef (Map ComponentId Column) -> IO (Map ComponentId Column)
forall a. IORef a -> IO a
readIORef Table
table.columns
let column = ComponentId -> Map ComponentId Column -> Maybe Column
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ComponentId
componentId Map ComponentId Column
columns
case column of
Maybe Column
Nothing -> Maybe c -> IO (Maybe c)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe c
forall a. Maybe a
Nothing
Just Column
column -> Column -> EntityPointer -> IO (Maybe c)
forall c. Component c => Column -> EntityPointer -> IO (Maybe c)
tryGetComponentFromColumn Column
column EntityPointer
pointer
tryGetRelCollectionFromTables :: forall c. (Component c) => Tables -> Entity -> EntityPointer -> ComponentId -> IO (Maybe ([Result (Rel c)]))
tryGetRelCollectionFromTables :: forall c.
Component c =>
Tables
-> Entity
-> EntityPointer
-> ComponentId
-> IO (Maybe [Result (Rel c)])
tryGetRelCollectionFromTables (Tables IOVec Table
tables) Entity
entity (EntityPointer (# Int#
archetypeId, Int#
rowIndex #)) ComponentId
componentId =
do
table <- Vec (PrimState IO) Table -> Int -> IO Table
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> Int -> m a
Vec.unsafeRead IOVec Table
Vec (PrimState IO) Table
tables (Int# -> Int
I# Int#
archetypeId)
tryGetRelCollectionFromTable table entity (EntityPointer (# archetypeId, rowIndex #)) componentId
tryGetComponentFromTables :: forall c. (Component c) => Tables -> EntityPointer -> ComponentId -> IO (Maybe c)
tryGetComponentFromTables :: forall c.
Component c =>
Tables -> EntityPointer -> ComponentId -> IO (Maybe c)
tryGetComponentFromTables (Tables IOVec Table
tables) (EntityPointer (# Int#
archetypeId, Int#
rowIndex #)) ComponentId
componentId =
do
table <- Vec (PrimState IO) Table -> Int -> IO Table
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> Int -> m a
Vec.unsafeRead IOVec Table
Vec (PrimState IO) Table
tables (Int# -> Int
I# Int#
archetypeId)
tryGetComponentFromTable table (EntityPointer (# archetypeId, rowIndex #)) componentId
tryGetTicksFromColumn :: Column -> IO [ComponentTicks]
tryGetTicksFromColumn :: Column -> IO [ComponentTicks]
tryGetTicksFromColumn (Column IOVec ComponentData
components) = do
frozen <- Vec (PrimState IO) ComponentData -> IO (Vector ComponentData)
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> m (Vector a)
Vec.freeze IOVec ComponentData
Vec (PrimState IO) ComponentData
components
let x = (ComponentData -> ComponentTicks)
-> Vector ComponentData -> Vector ComponentTicks
forall a b. (a -> b) -> Vector a -> Vector b
Vector.map (\ComponentData
x -> ComponentData
x.ticks) Vector ComponentData
frozen
return $ Vector.toList x
tryGetEntityTicksFromColumn :: Column -> EntityPointer -> IO ComponentTicks
tryGetEntityTicksFromColumn :: Column -> EntityPointer -> IO ComponentTicks
tryGetEntityTicksFromColumn (Column IOVec ComponentData
components) (EntityPointer (# Int#
_, Int#
rowIndex #)) = (\ComponentData
x -> ComponentData
x.ticks) (ComponentData -> ComponentTicks)
-> IO ComponentData -> IO ComponentTicks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vec (PrimState IO) ComponentData -> Int -> IO ComponentData
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> Int -> m a
Vec.unsafeRead IOVec ComponentData
Vec (PrimState IO) ComponentData
components (Int# -> Int
I# Int#
rowIndex)
tryGetTicksFromTable :: Table -> ComponentId -> IO [Maybe ComponentTicks]
tryGetTicksFromTable :: Table -> ComponentId -> IO [Maybe ComponentTicks]
tryGetTicksFromTable Table
table ComponentId
componentId =
do
columns <- IORef (Map ComponentId Column) -> IO (Map ComponentId Column)
forall a. IORef a -> IO a
readIORef Table
table.columns
case Map.lookup componentId columns of
Maybe Column
Nothing -> do
l <- Vec (PrimState IO) (Entity, IORef EntityPointer) -> IO Int
forall (m :: * -> *) a. PrimMonad m => Vec (PrimState m) a -> m Int
Vec.length Table
table.entities
return $ map (const Nothing) [1 .. l]
Just Column
column -> do
(ComponentTicks -> Maybe ComponentTicks)
-> [ComponentTicks] -> [Maybe ComponentTicks]
forall a b. (a -> b) -> [a] -> [b]
map ComponentTicks -> Maybe ComponentTicks
forall a. a -> Maybe a
Just ([ComponentTicks] -> [Maybe ComponentTicks])
-> IO [ComponentTicks] -> IO [Maybe ComponentTicks]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Column -> IO [ComponentTicks]
tryGetTicksFromColumn Column
column
tryGetEntityTicksFromTable :: Table -> EntityPointer -> ComponentId -> IO (Maybe ComponentTicks)
tryGetEntityTicksFromTable :: Table -> EntityPointer -> ComponentId -> IO (Maybe ComponentTicks)
tryGetEntityTicksFromTable Table
table EntityPointer
pointer ComponentId
componentId =
do
columns <- IORef (Map ComponentId Column) -> IO (Map ComponentId Column)
forall a. IORef a -> IO a
readIORef Table
table.columns
case Map.lookup componentId columns of
Maybe Column
Nothing -> Maybe ComponentTicks -> IO (Maybe ComponentTicks)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ComponentTicks
forall a. Maybe a
Nothing
Just Column
column -> ComponentTicks -> Maybe ComponentTicks
forall a. a -> Maybe a
Just (ComponentTicks -> Maybe ComponentTicks)
-> IO ComponentTicks -> IO (Maybe ComponentTicks)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Column -> EntityPointer -> IO ComponentTicks
tryGetEntityTicksFromColumn Column
column EntityPointer
pointer
tryGetTicksFromArchetype :: ArchetypeId -> IOVec Table -> ComponentId -> IO [Maybe ComponentTicks]
tryGetTicksFromArchetype :: ArchetypeId
-> IOVec Table -> ComponentId -> IO [Maybe ComponentTicks]
tryGetTicksFromArchetype ArchetypeId
archetype IOVec Table
tables ComponentId
componentId = do
table <- Vec (PrimState IO) Table -> Int -> IO Table
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> Int -> m a
Vec.unsafeRead IOVec Table
Vec (PrimState IO) Table
tables ArchetypeId
archetype.id
tryGetTicksFromTable table componentId
tryGetEntityTicksFromArchetype :: ArchetypeId -> IOVec Table -> EntityPointer -> ComponentId -> IO (Maybe ComponentTicks)
tryGetEntityTicksFromArchetype :: ArchetypeId
-> IOVec Table
-> EntityPointer
-> ComponentId
-> IO (Maybe ComponentTicks)
tryGetEntityTicksFromArchetype ArchetypeId
archetype IOVec Table
tables EntityPointer
pointer ComponentId
componentId = do
table <- Vec (PrimState IO) Table -> Int -> IO Table
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> Int -> m a
Vec.unsafeRead IOVec Table
Vec (PrimState IO) Table
tables ArchetypeId
archetype.id
tryGetEntityTicksFromTable table pointer componentId
tryGetTicksFromTables :: Tables -> [ArchetypeId] -> ComponentId -> IO [Maybe ComponentTicks]
tryGetTicksFromTables :: Tables -> [ArchetypeId] -> ComponentId -> IO [Maybe ComponentTicks]
tryGetTicksFromTables (Tables IOVec Table
tables) [ArchetypeId]
archetypes ComponentId
componentId =
do
results <- (ArchetypeId -> IO [Maybe ComponentTicks])
-> [ArchetypeId] -> IO [[Maybe ComponentTicks]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\ArchetypeId
archetype -> ArchetypeId
-> IOVec Table -> ComponentId -> IO [Maybe ComponentTicks]
tryGetTicksFromArchetype ArchetypeId
archetype IOVec Table
tables ComponentId
componentId) [ArchetypeId]
archetypes
return $ concat results
tryGetEntityTicksFromTables :: Tables -> EntityPointer -> ComponentId -> IO (Maybe ComponentTicks)
tryGetEntityTicksFromTables :: Tables -> EntityPointer -> ComponentId -> IO (Maybe ComponentTicks)
tryGetEntityTicksFromTables (Tables IOVec Table
tables) (EntityPointer (# Int#
archetypeId, Int#
rowIndex #)) ComponentId
componentId =
do
ArchetypeId
-> IOVec Table
-> EntityPointer
-> ComponentId
-> IO (Maybe ComponentTicks)
tryGetEntityTicksFromArchetype (Int -> ArchetypeId
ArchetypeId (Int -> ArchetypeId) -> Int -> ArchetypeId
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
archetypeId) IOVec Table
tables ((# Int#, Int# #) -> EntityPointer
EntityPointer (# Int#
archetypeId, Int#
rowIndex #)) ComponentId
componentId
tryGetComponentsFromColumn :: forall c. (Component c) => Column -> IO [c]
tryGetComponentsFromColumn :: forall c. Component c => Column -> IO [c]
tryGetComponentsFromColumn (Column IOVec ComponentData
components) = do
frozen <- Vec (PrimState IO) ComponentData -> IO (Vector ComponentData)
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> m (Vector a)
Vec.freeze IOVec ComponentData
Vec (PrimState IO) ComponentData
components
let x = (ComponentData -> Maybe c)
-> Vector ComponentData -> Maybe (Vector c)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
Vector.mapM (\ComponentData
x -> ErasedComponent -> Maybe c
forall c. Component c => ErasedComponent -> Maybe c
tryGetComponent ComponentData
x.value) Vector ComponentData
frozen
pure $ maybe [] Vector.toList x
tryGetRelCollectionsFromTable :: forall c. (Component c) => Table -> ComponentId -> IO [(Entity, [Result (Rel c)])]
tryGetRelCollectionsFromTable :: forall c.
Component c =>
Table -> ComponentId -> IO [(Entity, [Result (Rel c)])]
tryGetRelCollectionsFromTable Table
table (ComponentId (# Word#
id, Maybe Entity
target #)) =
do
columns <- IORef (Map ComponentId Column) -> IO (Map ComponentId Column)
forall a. IORef a -> IO a
readIORef Table
table.columns
components' :: [Maybe [(c, Entity)]] <- forM (Map.toList columns) $ \(ComponentId (# Word#
id', Maybe Entity
target' #), Column
column) -> do
if Int# -> Bool
isTrue# (Int# -> Bool) -> Int# -> Bool
forall a b. (a -> b) -> a -> b
$ Word# -> Word# -> Int#
eqWord# Word#
id Word#
id'
then do
case Maybe Entity
target' of
Maybe Entity
Nothing -> Maybe [(c, Entity)] -> IO (Maybe [(c, Entity)])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [(c, Entity)]
forall a. Maybe a
Nothing
Just Entity
entity -> do
components <- forall c. Component c => Column -> IO [c]
tryGetComponentsFromColumn @c Column
column
return $ Just $ map (,entity) components
else Maybe [(c, Entity)] -> IO (Maybe [(c, Entity)])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [(c, Entity)]
forall a. Maybe a
Nothing
entities <- Vec.toList table.entities
let components'' = [Entity] -> [[(c, Entity)]] -> [(Entity, [(c, Entity)])]
forall a b. [a] -> [b] -> [(a, b)]
zip (((Entity, IORef EntityPointer) -> Entity)
-> [(Entity, IORef EntityPointer)] -> [Entity]
forall a b. (a -> b) -> [a] -> [b]
map (Entity, IORef EntityPointer) -> Entity
forall a b. (a, b) -> a
fst [(Entity, IORef EntityPointer)]
entities) ([[(c, Entity)]] -> [(Entity, [(c, Entity)])])
-> [[(c, Entity)]] -> [(Entity, [(c, Entity)])]
forall a b. (a -> b) -> a -> b
$ [[(c, Entity)]] -> [[(c, Entity)]]
forall a. [[a]] -> [[a]]
transpose ([[(c, Entity)]] -> [[(c, Entity)]])
-> [[(c, Entity)]] -> [[(c, Entity)]]
forall a b. (a -> b) -> a -> b
$ [Maybe [(c, Entity)]] -> [[(c, Entity)]]
forall a. [Maybe a] -> [a]
catMaybes [Maybe [(c, Entity)]]
components'
return $
map
(\(Entity
entity, [(c, Entity)]
components) -> (Entity
entity, ((c, Entity) -> Result (Rel c))
-> [(c, Entity)] -> [Result (Rel c)]
forall a b. (a -> b) -> [a] -> [b]
map (\(c
value, Entity
target) -> (Rel c, Entity) -> Result (Rel c)
forall c. (c, Entity) -> Result c
Result (c -> Entity -> Rel c
forall c. c -> Entity -> Rel c
Rel c
value Entity
target, Entity
entity)) [(c, Entity)]
components))
components''
tryGetComponentsFromTable :: forall c. (Component c) => Table -> ComponentId -> IO [(Entity, Result c)]
tryGetComponentsFromTable :: forall c.
Component c =>
Table -> ComponentId -> IO [(Entity, Result c)]
tryGetComponentsFromTable Table
table ComponentId
componentId =
do
columns <- IORef (Map ComponentId Column) -> IO (Map ComponentId Column)
forall a. IORef a -> IO a
readIORef Table
table.columns
case Map.lookup componentId columns of
Maybe Column
Nothing -> IO [(Entity, Result c)]
forall a. HasCallStack => a
undefined
Just Column
column -> do
results <- forall c. Component c => Column -> IO [c]
tryGetComponentsFromColumn @c Column
column
entities <- Vec.toList table.entities
let zipped = [Entity] -> [c] -> [(Entity, c)]
forall a b. [a] -> [b] -> [(a, b)]
zip (((Entity, IORef EntityPointer) -> Entity)
-> [(Entity, IORef EntityPointer)] -> [Entity]
forall a b. (a -> b) -> [a] -> [b]
map (Entity, IORef EntityPointer) -> Entity
forall a b. (a, b) -> a
fst [(Entity, IORef EntityPointer)]
entities) [c]
results
return $ map (\(Entity
e, c
r) -> (Entity
e, (c, Entity) -> Result c
forall c. (c, Entity) -> Result c
Result (c
r, Entity
e))) zipped
tryGetEntitiesFromTable :: Table -> IO [Entity]
tryGetEntitiesFromTable :: Table -> IO [Entity]
tryGetEntitiesFromTable Table
table =
do
entities <- Vec (PrimState IO) (Entity, IORef EntityPointer)
-> IO [(Entity, IORef EntityPointer)]
forall (m :: * -> *) a. PrimMonad m => Vec (PrimState m) a -> m [a]
Vec.toList Table
table.entities
return $ map fst entities
tryGetComponentsFromTableMaybe :: forall c. (Component c) => Table -> ComponentId -> IO [(Entity, Maybe (Result c))]
tryGetComponentsFromTableMaybe :: forall c.
Component c =>
Table -> ComponentId -> IO [(Entity, Maybe (Result c))]
tryGetComponentsFromTableMaybe Table
table ComponentId
componentId =
do
columns <- IORef (Map ComponentId Column) -> IO (Map ComponentId Column)
forall a. IORef a -> IO a
readIORef Table
table.columns
case Map.lookup componentId columns of
Maybe Column
Nothing -> do
entities <- Vec (PrimState IO) (Entity, IORef EntityPointer)
-> IO [(Entity, IORef EntityPointer)]
forall (m :: * -> *) a. PrimMonad m => Vec (PrimState m) a -> m [a]
Vec.toList Table
table.entities
return $ map ((,Nothing) . fst) entities
Just Column
column -> do
results <- forall c. Component c => Column -> IO [c]
tryGetComponentsFromColumn @c Column
column
entities <- Vec.toList table.entities
return $ zipWith (\c
x Entity
e -> (Entity
e, Result c -> Maybe (Result c)
forall a. a -> Maybe a
Just (Result c -> Maybe (Result c)) -> Result c -> Maybe (Result c)
forall a b. (a -> b) -> a -> b
$ (c, Entity) -> Result c
forall c. (c, Entity) -> Result c
Result (c
x, Entity
e))) results (map fst entities)
tryGetRelCollectionsFromArchetype :: forall c. (Component c) => ArchetypeId -> IOVec Table -> ComponentId -> IO [(Entity, [Result (Rel c)])]
tryGetRelCollectionsFromArchetype :: forall c.
Component c =>
ArchetypeId
-> IOVec Table -> ComponentId -> IO [(Entity, [Result (Rel c)])]
tryGetRelCollectionsFromArchetype ArchetypeId
archetype IOVec Table
tables ComponentId
componentId = do
table <- Vec (PrimState IO) Table -> Int -> IO Table
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> Int -> m a
Vec.unsafeRead IOVec Table
Vec (PrimState IO) Table
tables ArchetypeId
archetype.id
tryGetRelCollectionsFromTable table componentId
tryGetComponentsFromArchetype :: forall c. (Component c) => ArchetypeId -> IOVec Table -> ComponentId -> IO [(Entity, Result c)]
tryGetComponentsFromArchetype :: forall c.
Component c =>
ArchetypeId
-> IOVec Table -> ComponentId -> IO [(Entity, Result c)]
tryGetComponentsFromArchetype ArchetypeId
archetype IOVec Table
tables ComponentId
componentId = do
table <- Vec (PrimState IO) Table -> Int -> IO Table
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> Int -> m a
Vec.unsafeRead IOVec Table
Vec (PrimState IO) Table
tables ArchetypeId
archetype.id
tryGetComponentsFromTable table componentId
tryGetEntitiesFromArchetype :: ArchetypeId -> IOVec Table -> IO [Entity]
tryGetEntitiesFromArchetype :: ArchetypeId -> IOVec Table -> IO [Entity]
tryGetEntitiesFromArchetype ArchetypeId
archetype IOVec Table
tables = do
table <- Vec (PrimState IO) Table -> Int -> IO Table
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> Int -> m a
Vec.unsafeRead IOVec Table
Vec (PrimState IO) Table
tables ArchetypeId
archetype.id
tryGetEntitiesFromTable table
tryGetComponentsFromArchetypeMaybe :: forall c. (Component c) => ArchetypeId -> IOVec Table -> ComponentId -> IO [(Entity, Maybe (Result c))]
tryGetComponentsFromArchetypeMaybe :: forall c.
Component c =>
ArchetypeId
-> IOVec Table -> ComponentId -> IO [(Entity, Maybe (Result c))]
tryGetComponentsFromArchetypeMaybe ArchetypeId
archetype IOVec Table
tables ComponentId
componentId = do
table <- Vec (PrimState IO) Table -> Int -> IO Table
forall (m :: * -> *) a.
PrimMonad m =>
Vec (PrimState m) a -> Int -> m a
Vec.unsafeRead IOVec Table
Vec (PrimState IO) Table
tables ArchetypeId
archetype.id
tryGetComponentsFromTableMaybe table componentId
tryGetRelCollectionsFromTables :: forall c. (Component c) => Tables -> [ArchetypeId] -> ComponentId -> IO [(Entity, [Result (Rel c)])]
tryGetRelCollectionsFromTables :: forall c.
Component c =>
Tables
-> [ArchetypeId] -> ComponentId -> IO [(Entity, [Result (Rel c)])]
tryGetRelCollectionsFromTables (Tables IOVec Table
tables) [ArchetypeId]
archetypes ComponentId
componentId =
do
results <- (ArchetypeId -> IO [(Entity, [Result (Rel c)])])
-> [ArchetypeId] -> IO [[(Entity, [Result (Rel c)])]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\ArchetypeId
archetype -> ArchetypeId
-> IOVec Table -> ComponentId -> IO [(Entity, [Result (Rel c)])]
forall c.
Component c =>
ArchetypeId
-> IOVec Table -> ComponentId -> IO [(Entity, [Result (Rel c)])]
tryGetRelCollectionsFromArchetype ArchetypeId
archetype IOVec Table
tables ComponentId
componentId) [ArchetypeId]
archetypes
return $ concat results
tryGetComponentsFromTables :: forall c. (Component c) => Tables -> [ArchetypeId] -> ComponentId -> IO [(Entity, Result c)]
tryGetComponentsFromTables :: forall c.
Component c =>
Tables -> [ArchetypeId] -> ComponentId -> IO [(Entity, Result c)]
tryGetComponentsFromTables (Tables IOVec Table
tables) [ArchetypeId]
archetypes ComponentId
componentId =
do
results <- (ArchetypeId -> IO [(Entity, Result c)])
-> [ArchetypeId] -> IO [[(Entity, Result c)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\ArchetypeId
archetype -> ArchetypeId
-> IOVec Table -> ComponentId -> IO [(Entity, Result c)]
forall c.
Component c =>
ArchetypeId
-> IOVec Table -> ComponentId -> IO [(Entity, Result c)]
tryGetComponentsFromArchetype ArchetypeId
archetype IOVec Table
tables ComponentId
componentId) [ArchetypeId]
archetypes
return $ concat results
tryGetEntitiesFromTables :: Tables -> [ArchetypeId] -> IO [Entity]
tryGetEntitiesFromTables :: Tables -> [ArchetypeId] -> IO [Entity]
tryGetEntitiesFromTables (Tables IOVec Table
tables) [ArchetypeId]
archetypes =
do
results <- (ArchetypeId -> IO [Entity]) -> [ArchetypeId] -> IO [[Entity]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ArchetypeId -> IOVec Table -> IO [Entity]
`tryGetEntitiesFromArchetype` IOVec Table
tables) [ArchetypeId]
archetypes
return $ concat results
tryGetComponentsFromTablesMaybe :: forall c. (Component c) => Tables -> [ArchetypeId] -> ComponentId -> IO [(Entity, Maybe (Result c))]
tryGetComponentsFromTablesMaybe :: forall c.
Component c =>
Tables
-> [ArchetypeId] -> ComponentId -> IO [(Entity, Maybe (Result c))]
tryGetComponentsFromTablesMaybe (Tables IOVec Table
tables) [ArchetypeId]
archetypes ComponentId
componentId =
do
results <- (ArchetypeId -> IO [(Entity, Maybe (Result c))])
-> [ArchetypeId] -> IO [[(Entity, Maybe (Result c))]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\ArchetypeId
archetype -> ArchetypeId
-> IOVec Table -> ComponentId -> IO [(Entity, Maybe (Result c))]
forall c.
Component c =>
ArchetypeId
-> IOVec Table -> ComponentId -> IO [(Entity, Maybe (Result c))]
tryGetComponentsFromArchetypeMaybe ArchetypeId
archetype IOVec Table
tables ComponentId
componentId) [ArchetypeId]
archetypes
return $ concat results
newtype Result c = Result (c, Entity)
data ErasedResult where
ErasedResult :: Result c -> ErasedResult
value :: Result c -> c
value :: forall c. Result c -> c
value (Result (c
c, Entity
_)) = c
c
type family IsComp a where
IsComp (Rel a) = False
IsComp a = True
entityOf :: Result c -> Entity
entityOf :: forall c. Result c -> Entity
entityOf (Result (c
_, Entity
e)) = Entity
e
instance (Show c) => Show (Result c) where
show :: Result c -> String
show :: Result c -> String
show = c -> String
forall a. Show a => a -> String
show (c -> String) -> (Result c -> c) -> Result c -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result c -> c
forall c. Result c -> c
value
instance (Eq c) => Eq (Result c) where
(==) :: Result c -> Result c -> Bool
== :: Result c -> Result c -> Bool
(==) Result c
a Result c
b = Result c -> c
forall c. Result c -> c
value Result c
a c -> c -> Bool
forall a. Eq a => a -> a -> Bool
== Result c -> c
forall c. Result c -> c
value Result c
b
instance (Ord c) => Ord (Result c) where
compare :: Result c -> Result c -> Ordering
compare :: Result c -> Result c -> Ordering
compare Result c
a Result c
b = c -> c -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Result c -> c
forall c. Result c -> c
value Result c
a) (Result c -> c
forall c. Result c -> c
value Result c
b)
instance (HasField a b c) => HasField a (Result b) c where
getField :: Result b -> c
getField Result b
a = forall (x :: k) r a. HasField x r a => r -> a
forall {k} (x :: k) r a. HasField x r a => r -> a
getField @a (Result b -> b
forall c. Result c -> c
value Result b
a)
class DeepValue' flag c i | flag c -> i where
deepValue' :: c -> i
instance DeepValue' True (Result c) c where
deepValue' :: Result c -> c
deepValue' = Result c -> c
forall c. Result c -> c
value
instance DeepValue' False (Result (Rel c)) c where
deepValue' :: Result (Rel c) -> c
deepValue' Result (Rel c)
x = Result (Rel c)
x.comp
class DeepValue c i | c -> i where
deepValue :: c -> i
instance (DeepValue' (IsComp c) (Result c) i) => DeepValue (Result c) i where
deepValue :: Result c -> i
deepValue = forall (flag :: Bool) c i. DeepValue' flag c i => c -> i
forall {k} (flag :: k) c i. DeepValue' flag c i => c -> i
deepValue' @(IsComp c)