{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Aztecs.ECS.World.Entities
( Entities (..),
empty,
spawn,
spawnWithArchetypeId,
insert,
insertDyn,
insertUntracked,
lookup,
remove,
removeWithId,
despawn,
)
where
import Aztecs.ECS.Access.Internal (Access)
import Aztecs.ECS.Component
import Aztecs.ECS.Entity
import qualified Aztecs.ECS.World.Archetype as A
import Aztecs.ECS.World.Archetypes (ArchetypeID, Node (..))
import qualified Aztecs.ECS.World.Archetypes as AS
import Aztecs.ECS.World.Bundle
import Aztecs.ECS.World.Bundle.Dynamic
import qualified Aztecs.ECS.World.Components as CS
import Aztecs.ECS.World.Entities.Internal (Entities (..))
import Data.Dynamic
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.Map as Map
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
import Prelude hiding (lookup)
empty :: Entities m
empty :: forall (m :: * -> *). Entities m
empty =
Entities
{ archetypes :: Archetypes m
archetypes = Archetypes m
forall (m :: * -> *). Archetypes m
AS.empty,
components :: Components
components = Components
CS.empty,
entities :: Map EntityID ArchetypeID
entities = Map EntityID ArchetypeID
forall a. Monoid a => a
mempty
}
spawn :: (Monad m) => EntityID -> BundleT m -> Entities m -> (Entities m, Access m ())
spawn :: forall (m :: * -> *).
Monad m =>
EntityID -> BundleT m -> Entities m -> (Entities m, Access m ())
spawn EntityID
eId BundleT m
b Entities m
w =
let (Set ComponentID
cIds, Components
components', DynamicBundle m
dynB) = BundleT m
-> Components -> (Set ComponentID, Components, DynamicBundle m)
forall (m :: * -> *).
BundleT m
-> Components -> (Set ComponentID, Components, DynamicBundle m)
unBundle BundleT m
b (Entities m -> Components
forall (m :: * -> *). Entities m -> Components
components Entities m
w)
in case Set ComponentID -> Archetypes m -> Maybe ArchetypeID
forall (m :: * -> *).
Set ComponentID -> Archetypes m -> Maybe ArchetypeID
AS.lookupArchetypeId Set ComponentID
cIds (Entities m -> Archetypes m
forall (m :: * -> *). Entities m -> Archetypes m
archetypes Entities m
w) of
Just ArchetypeID
aId -> case ArchetypeID -> Archetypes m -> Maybe (Node m)
forall (m :: * -> *). ArchetypeID -> Archetypes m -> Maybe (Node m)
AS.lookup ArchetypeID
aId (Archetypes m -> Maybe (Node m)) -> Archetypes m -> Maybe (Node m)
forall a b. (a -> b) -> a -> b
$ Entities m -> Archetypes m
forall (m :: * -> *). Entities m -> Archetypes m
archetypes Entities m
w of
Just Node m
node ->
let (Archetype m
arch', Access m ()
hook) =
DynamicBundle m
-> EntityID -> Archetype m -> (Archetype m, Access m ())
forall (m :: * -> *).
DynamicBundle m
-> EntityID -> Archetype m -> (Archetype m, Access m ())
runDynamicBundle
DynamicBundle m
dynB
EntityID
eId
( (Node m -> Archetype m
forall (m :: * -> *). Node m -> Archetype m
nodeArchetype Node m
node)
{ A.entities = Set.insert eId . A.entities $ nodeArchetype node
}
)
in ( Entities m
w
{ archetypes = (archetypes w) {AS.nodes = Map.insert aId node {nodeArchetype = arch'} (AS.nodes $ archetypes w)},
components = components',
entities = Map.insert eId aId (entities w)
},
Access m ()
hook
)
Maybe (Node m)
Nothing -> (Entities m
w, () -> Access m ()
forall a. a -> Access m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
Maybe ArchetypeID
Nothing ->
let (Archetype m
arch', Access m ()
hook) = DynamicBundle m
-> EntityID -> Archetype m -> (Archetype m, Access m ())
forall (m :: * -> *).
DynamicBundle m
-> EntityID -> Archetype m -> (Archetype m, Access m ())
runDynamicBundle DynamicBundle m
dynB EntityID
eId (Archetype m -> (Archetype m, Access m ()))
-> Archetype m -> (Archetype m, Access m ())
forall a b. (a -> b) -> a -> b
$ EntityID -> Archetype m
forall (m :: * -> *). EntityID -> Archetype m
A.singleton EntityID
eId
node' :: Node m
node' = Node {nodeComponentIds :: Set ComponentID
nodeComponentIds = Set ComponentID
cIds, nodeArchetype :: Archetype m
nodeArchetype = Archetype m
arch'}
(ArchetypeID
aId, Archetypes m
arches) = Set ComponentID
-> Node m -> Archetypes m -> (ArchetypeID, Archetypes m)
forall (m :: * -> *).
Set ComponentID
-> Node m -> Archetypes m -> (ArchetypeID, Archetypes m)
AS.insertArchetype Set ComponentID
cIds Node m
node' (Archetypes m -> (ArchetypeID, Archetypes m))
-> Archetypes m -> (ArchetypeID, Archetypes m)
forall a b. (a -> b) -> a -> b
$ Entities m -> Archetypes m
forall (m :: * -> *). Entities m -> Archetypes m
archetypes Entities m
w
in ( Entities m
w
{ archetypes = arches,
entities = Map.insert eId aId (entities w),
components = components'
},
Access m ()
hook
)
spawnWithArchetypeId ::
(Monad m) =>
EntityID ->
ArchetypeID ->
DynamicBundle m ->
Entities m ->
(Entities m, Access m ())
spawnWithArchetypeId :: forall (m :: * -> *).
Monad m =>
EntityID
-> ArchetypeID
-> DynamicBundle m
-> Entities m
-> (Entities m, Access m ())
spawnWithArchetypeId EntityID
e ArchetypeID
aId DynamicBundle m
b Entities m
w =
let f :: Node m -> (Node m, Access m ())
f Node m
n =
let (Archetype m
arch', Access m ()
hook) = DynamicBundle m
-> EntityID -> Archetype m -> (Archetype m, Access m ())
forall (m :: * -> *).
DynamicBundle m
-> EntityID -> Archetype m -> (Archetype m, Access m ())
runDynamicBundle DynamicBundle m
b EntityID
e ((Node m -> Archetype m
forall (m :: * -> *). Node m -> Archetype m
nodeArchetype Node m
n) {A.entities = Set.insert e . A.entities $ nodeArchetype n})
in (Node m
n {nodeArchetype = arch'}, Access m ()
hook)
(Access m ()
hooks, Map ArchetypeID (Node m)
nodes') =
(Maybe (Node m) -> (Access m (), Maybe (Node m)))
-> ArchetypeID
-> Map ArchetypeID (Node m)
-> (Access m (), Map ArchetypeID (Node m))
forall (f :: * -> *) k a.
(Functor f, Ord k) =>
(Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
Map.alterF
( \Maybe (Node m)
maybeN -> case Maybe (Node m)
maybeN of
Just Node m
n -> let (Node m
n', Access m ()
hook) = Node m -> (Node m, Access m ())
f Node m
n in (Access m ()
hook, Node m -> Maybe (Node m)
forall a. a -> Maybe a
Just Node m
n')
Maybe (Node m)
Nothing -> (() -> Access m ()
forall a. a -> Access m a
forall (m :: * -> *) a. Monad m => a -> m a
return (), Maybe (Node m)
forall a. Maybe a
Nothing)
)
ArchetypeID
aId
(Archetypes m -> Map ArchetypeID (Node m)
forall (m :: * -> *). Archetypes m -> Map ArchetypeID (Node m)
AS.nodes (Archetypes m -> Map ArchetypeID (Node m))
-> Archetypes m -> Map ArchetypeID (Node m)
forall a b. (a -> b) -> a -> b
$ Entities m -> Archetypes m
forall (m :: * -> *). Entities m -> Archetypes m
archetypes Entities m
w)
in ( Entities m
w
{ archetypes = (archetypes w) {AS.nodes = nodes'},
entities = Map.insert e aId (entities w)
},
Access m ()
hooks
)
insert :: (Monad m) => EntityID -> BundleT m -> Entities m -> (Entities m, Access m ())
insert :: forall (m :: * -> *).
Monad m =>
EntityID -> BundleT m -> Entities m -> (Entities m, Access m ())
insert EntityID
e BundleT m
b Entities m
w =
let !(Set ComponentID
cIds, Components
components', DynamicBundle m
dynB) = BundleT m
-> Components -> (Set ComponentID, Components, DynamicBundle m)
forall (m :: * -> *).
BundleT m
-> Components -> (Set ComponentID, Components, DynamicBundle m)
unBundle BundleT m
b (Entities m -> Components
forall (m :: * -> *). Entities m -> Components
components Entities m
w)
in EntityID
-> Set ComponentID
-> DynamicBundle m
-> Entities m
-> (Entities m, Access m ())
forall (m :: * -> *).
Monad m =>
EntityID
-> Set ComponentID
-> DynamicBundle m
-> Entities m
-> (Entities m, Access m ())
insertDyn EntityID
e Set ComponentID
cIds DynamicBundle m
dynB Entities m
w {components = components'}
insertDyn :: (Monad m) => EntityID -> Set ComponentID -> DynamicBundle m -> Entities m -> (Entities m, Access m ())
insertDyn :: forall (m :: * -> *).
Monad m =>
EntityID
-> Set ComponentID
-> DynamicBundle m
-> Entities m
-> (Entities m, Access m ())
insertDyn EntityID
e Set ComponentID
cIds DynamicBundle m
b Entities m
w = case EntityID -> Map EntityID ArchetypeID -> Maybe ArchetypeID
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup EntityID
e (Map EntityID ArchetypeID -> Maybe ArchetypeID)
-> Map EntityID ArchetypeID -> Maybe ArchetypeID
forall a b. (a -> b) -> a -> b
$ Entities m -> Map EntityID ArchetypeID
forall (m :: * -> *). Entities m -> Map EntityID ArchetypeID
entities Entities m
w of
Just ArchetypeID
aId ->
let (Maybe ArchetypeID
maybeNextAId, Archetypes m
arches, Access m ()
hook) = EntityID
-> ArchetypeID
-> Set ComponentID
-> DynamicBundle m
-> Archetypes m
-> (Maybe ArchetypeID, Archetypes m, Access m ())
forall (m :: * -> *).
Monad m =>
EntityID
-> ArchetypeID
-> Set ComponentID
-> DynamicBundle m
-> Archetypes m
-> (Maybe ArchetypeID, Archetypes m, Access m ())
AS.insert EntityID
e ArchetypeID
aId Set ComponentID
cIds DynamicBundle m
b (Archetypes m -> (Maybe ArchetypeID, Archetypes m, Access m ()))
-> Archetypes m -> (Maybe ArchetypeID, Archetypes m, Access m ())
forall a b. (a -> b) -> a -> b
$ Entities m -> Archetypes m
forall (m :: * -> *). Entities m -> Archetypes m
archetypes Entities m
w
es :: Map EntityID ArchetypeID
es = case Maybe ArchetypeID
maybeNextAId of
Just ArchetypeID
nextAId -> EntityID
-> ArchetypeID
-> Map EntityID ArchetypeID
-> Map EntityID ArchetypeID
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert EntityID
e ArchetypeID
nextAId (Map EntityID ArchetypeID -> Map EntityID ArchetypeID)
-> Map EntityID ArchetypeID -> Map EntityID ArchetypeID
forall a b. (a -> b) -> a -> b
$ Entities m -> Map EntityID ArchetypeID
forall (m :: * -> *). Entities m -> Map EntityID ArchetypeID
entities Entities m
w
Maybe ArchetypeID
Nothing -> Entities m -> Map EntityID ArchetypeID
forall (m :: * -> *). Entities m -> Map EntityID ArchetypeID
entities Entities m
w
in (Entities m
w {archetypes = arches, entities = es}, Access m ()
hook)
Maybe ArchetypeID
Nothing -> case Set ComponentID -> Archetypes m -> Maybe ArchetypeID
forall (m :: * -> *).
Set ComponentID -> Archetypes m -> Maybe ArchetypeID
AS.lookupArchetypeId Set ComponentID
cIds (Archetypes m -> Maybe ArchetypeID)
-> Archetypes m -> Maybe ArchetypeID
forall a b. (a -> b) -> a -> b
$ Entities m -> Archetypes m
forall (m :: * -> *). Entities m -> Archetypes m
archetypes Entities m
w of
Just ArchetypeID
aId -> EntityID
-> ArchetypeID
-> DynamicBundle m
-> Entities m
-> (Entities m, Access m ())
forall (m :: * -> *).
Monad m =>
EntityID
-> ArchetypeID
-> DynamicBundle m
-> Entities m
-> (Entities m, Access m ())
spawnWithArchetypeId EntityID
e ArchetypeID
aId DynamicBundle m
b Entities m
w
Maybe ArchetypeID
Nothing ->
let (Archetype m
arch, Access m ()
hook) = DynamicBundle m
-> EntityID -> Archetype m -> (Archetype m, Access m ())
forall (m :: * -> *).
DynamicBundle m
-> EntityID -> Archetype m -> (Archetype m, Access m ())
runDynamicBundle DynamicBundle m
b EntityID
e (Archetype m -> (Archetype m, Access m ()))
-> Archetype m -> (Archetype m, Access m ())
forall a b. (a -> b) -> a -> b
$ EntityID -> Archetype m
forall (m :: * -> *). EntityID -> Archetype m
A.singleton EntityID
e
node :: Node m
node = Node {nodeComponentIds :: Set ComponentID
nodeComponentIds = Set ComponentID
cIds, nodeArchetype :: Archetype m
nodeArchetype = Archetype m
arch}
(ArchetypeID
aId, Archetypes m
arches) = Set ComponentID
-> Node m -> Archetypes m -> (ArchetypeID, Archetypes m)
forall (m :: * -> *).
Set ComponentID
-> Node m -> Archetypes m -> (ArchetypeID, Archetypes m)
AS.insertArchetype Set ComponentID
cIds Node m
node (Archetypes m -> (ArchetypeID, Archetypes m))
-> Archetypes m -> (ArchetypeID, Archetypes m)
forall a b. (a -> b) -> a -> b
$ Entities m -> Archetypes m
forall (m :: * -> *). Entities m -> Archetypes m
archetypes Entities m
w
in (Entities m
w {archetypes = arches, entities = Map.insert e aId (entities w)}, Access m ()
hook)
insertUntracked :: (Monad m) => EntityID -> BundleT m -> Entities m -> Entities m
insertUntracked :: forall (m :: * -> *).
Monad m =>
EntityID -> BundleT m -> Entities m -> Entities m
insertUntracked EntityID
e BundleT m
b Entities m
w = (Entities m, Access m ()) -> Entities m
forall a b. (a, b) -> a
fst ((Entities m, Access m ()) -> Entities m)
-> (Entities m, Access m ()) -> Entities m
forall a b. (a -> b) -> a -> b
$ EntityID -> BundleT m -> Entities m -> (Entities m, Access m ())
forall (m :: * -> *).
Monad m =>
EntityID -> BundleT m -> Entities m -> (Entities m, Access m ())
insert EntityID
e BundleT m
b Entities m
w
lookup :: forall m a. (Component m a) => EntityID -> Entities m -> Maybe a
lookup :: forall (m :: * -> *) a.
Component m a =>
EntityID -> Entities m -> Maybe a
lookup EntityID
e Entities m
w = do
!ComponentID
cId <- forall a. Typeable a => Components -> Maybe ComponentID
CS.lookup @a (Components -> Maybe ComponentID)
-> Components -> Maybe ComponentID
forall a b. (a -> b) -> a -> b
$ Entities m -> Components
forall (m :: * -> *). Entities m -> Components
components Entities m
w
!ArchetypeID
aId <- EntityID -> Map EntityID ArchetypeID -> Maybe ArchetypeID
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup EntityID
e (Map EntityID ArchetypeID -> Maybe ArchetypeID)
-> Map EntityID ArchetypeID -> Maybe ArchetypeID
forall a b. (a -> b) -> a -> b
$ Entities m -> Map EntityID ArchetypeID
forall (m :: * -> *). Entities m -> Map EntityID ArchetypeID
entities Entities m
w
!Node m
node <- ArchetypeID -> Archetypes m -> Maybe (Node m)
forall (m :: * -> *). ArchetypeID -> Archetypes m -> Maybe (Node m)
AS.lookup ArchetypeID
aId (Archetypes m -> Maybe (Node m)) -> Archetypes m -> Maybe (Node m)
forall a b. (a -> b) -> a -> b
$ Entities m -> Archetypes m
forall (m :: * -> *). Entities m -> Archetypes m
archetypes Entities m
w
EntityID -> ComponentID -> Archetype m -> Maybe a
forall (m :: * -> *) a.
Component m a =>
EntityID -> ComponentID -> Archetype m -> Maybe a
A.lookupComponent EntityID
e ComponentID
cId (Archetype m -> Maybe a) -> Archetype m -> Maybe a
forall a b. (a -> b) -> a -> b
$ Node m -> Archetype m
forall (m :: * -> *). Node m -> Archetype m
nodeArchetype Node m
node
remove :: forall m a. (Component m a) => EntityID -> Entities m -> (Maybe a, Entities m, Access m ())
remove :: forall (m :: * -> *) a.
Component m a =>
EntityID -> Entities m -> (Maybe a, Entities m, Access m ())
remove EntityID
e Entities m
w =
let !(ComponentID
cId, Components
components') = forall a (m :: * -> *).
Component m a =>
Components -> (ComponentID, Components)
CS.insert @a @m (Entities m -> Components
forall (m :: * -> *). Entities m -> Components
components Entities m
w)
in EntityID
-> ComponentID -> Entities m -> (Maybe a, Entities m, Access m ())
forall (m :: * -> *) a.
Component m a =>
EntityID
-> ComponentID -> Entities m -> (Maybe a, Entities m, Access m ())
removeWithId EntityID
e ComponentID
cId Entities m
w {components = components'}
removeWithId :: forall m a. (Component m a) => EntityID -> ComponentID -> Entities m -> (Maybe a, Entities m, Access m ())
removeWithId :: forall (m :: * -> *) a.
Component m a =>
EntityID
-> ComponentID -> Entities m -> (Maybe a, Entities m, Access m ())
removeWithId EntityID
e ComponentID
cId Entities m
w = case EntityID -> Map EntityID ArchetypeID -> Maybe ArchetypeID
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup EntityID
e (Entities m -> Map EntityID ArchetypeID
forall (m :: * -> *). Entities m -> Map EntityID ArchetypeID
entities Entities m
w) of
Just ArchetypeID
aId ->
let (Maybe (a, ArchetypeID)
res, Archetypes m
as, Access m ()
hook) = forall (m :: * -> *) a.
Component m a =>
EntityID
-> ArchetypeID
-> ComponentID
-> Archetypes m
-> (Maybe (a, ArchetypeID), Archetypes m, Access m ())
AS.remove @m @a EntityID
e ArchetypeID
aId ComponentID
cId (Archetypes m
-> (Maybe (a, ArchetypeID), Archetypes m, Access m ()))
-> Archetypes m
-> (Maybe (a, ArchetypeID), Archetypes m, Access m ())
forall a b. (a -> b) -> a -> b
$ Entities m -> Archetypes m
forall (m :: * -> *). Entities m -> Archetypes m
archetypes Entities m
w
(Maybe a
maybeA, Map EntityID ArchetypeID
es) = case Maybe (a, ArchetypeID)
res of
Just (a
a, ArchetypeID
nextAId) -> (a -> Maybe a
forall a. a -> Maybe a
Just a
a, EntityID
-> ArchetypeID
-> Map EntityID ArchetypeID
-> Map EntityID ArchetypeID
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert EntityID
e ArchetypeID
nextAId (Entities m -> Map EntityID ArchetypeID
forall (m :: * -> *). Entities m -> Map EntityID ArchetypeID
entities Entities m
w))
Maybe (a, ArchetypeID)
Nothing -> (Maybe a
forall a. Maybe a
Nothing, Entities m -> Map EntityID ArchetypeID
forall (m :: * -> *). Entities m -> Map EntityID ArchetypeID
entities Entities m
w)
in (Maybe a
maybeA, Entities m
w {archetypes = as, entities = es}, Access m ()
hook)
Maybe ArchetypeID
Nothing -> (Maybe a
forall a. Maybe a
Nothing, Entities m
w, () -> Access m ()
forall a. a -> Access m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
despawn :: EntityID -> Entities m -> (IntMap Dynamic, Entities m)
despawn :: forall (m :: * -> *).
EntityID -> Entities m -> (IntMap Dynamic, Entities m)
despawn EntityID
e Entities m
w =
let res :: Maybe (ArchetypeID, Node m)
res = do
!ArchetypeID
aId <- EntityID -> Map EntityID ArchetypeID -> Maybe ArchetypeID
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup EntityID
e (Map EntityID ArchetypeID -> Maybe ArchetypeID)
-> Map EntityID ArchetypeID -> Maybe ArchetypeID
forall a b. (a -> b) -> a -> b
$ Entities m -> Map EntityID ArchetypeID
forall (m :: * -> *). Entities m -> Map EntityID ArchetypeID
entities Entities m
w
!Node m
node <- ArchetypeID -> Archetypes m -> Maybe (Node m)
forall (m :: * -> *). ArchetypeID -> Archetypes m -> Maybe (Node m)
AS.lookup ArchetypeID
aId (Archetypes m -> Maybe (Node m)) -> Archetypes m -> Maybe (Node m)
forall a b. (a -> b) -> a -> b
$ Entities m -> Archetypes m
forall (m :: * -> *). Entities m -> Archetypes m
archetypes Entities m
w
(ArchetypeID, Node m) -> Maybe (ArchetypeID, Node m)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (ArchetypeID
aId, Node m
node)
in case Maybe (ArchetypeID, Node m)
res of
Just (ArchetypeID
aId, Node m
node) ->
let !(IntMap Dynamic
dynAcc, Archetype m
arch') = EntityID -> Archetype m -> (IntMap Dynamic, Archetype m)
forall (m :: * -> *).
EntityID -> Archetype m -> (IntMap Dynamic, Archetype m)
A.remove EntityID
e (Node m -> Archetype m
forall (m :: * -> *). Node m -> Archetype m
nodeArchetype Node m
node)
in ( IntMap Dynamic
dynAcc,
Entities m
w
{ archetypes = (archetypes w) {AS.nodes = Map.insert aId node {nodeArchetype = arch'} (AS.nodes $ archetypes w)},
entities = Map.delete e (entities w)
}
)
Maybe (ArchetypeID, Node m)
Nothing -> (IntMap Dynamic
forall a. IntMap a
IntMap.empty, Entities m
w)