mischief-ecs 0.2.0.0 → 0.2.1.0

raw patch · 9 files changed

+102/−44 lines, 9 filesdep ~mischief-ecsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: mischief-ecs

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−1
• README.md +1/−1
• mischief-ecs.cabal +2/−2
• src/Mischief/ECS/Archetypes.hs +3/−2
• src/Mischief/ECS/Archetypes/Graph.hs +33/−19
• src/Mischief/ECS/Relationships/ChildOf.hs +1/−1
• src/Mischief/ECS/Schedules.hs +0/−1
• src/Mischief/ECS/World/Change.hs +0/−3
• src/Mischief/ECS/World/Query.hs +56/−14

@@ -1,4 +1,9 @@-# Revision history for mischief+# Revision history for mischief-ecs++## 0.2.0.1++* Fixed bug related to ChildOf hierarchy traversal +* Significantly improved query filter performance    ## 0.2.0.0  

@@ -1,4 +1,4 @@-# Mischief +# mischief-ecs   This is the ECS library for the Mischief game engine. It is the root of every other library that's part of the engine. In other words, this is the source of all Mischief.  

@@ -18,7 +18,7 @@ -- PVP summary:     +-+------- breaking API changes --                  | | +----- non-breaking API additions --                  | | | +--- code changes with no API change-version: 0.2.0.0+version: 0.2.1.0 -- A short (one-line) description of the package. synopsis: An archetype ECS engine built in Haskell. homepage: https://codeberg.org/mischief/mischief@@ -263,7 +263,7 @@   build-depends:     base >=4.21.0.0 && <4.22,     containers,-    mischief-ecs ==0.2.0.0,+    mischief-ecs,     primitive,     text,     transformers,

@@ -11,7 +11,7 @@  newtype Archetypes = Archetypes {graph :: ArchetypeGraph} -data ArchetypeGraph = ArchetypeGraph {nodes :: IOVec ArchetypeNode, lookup :: IORef (Map (Set ComponentId) Int), counter :: IORef Int}+data ArchetypeGraph = ArchetypeGraph {nodes :: IOVec ArchetypeNode, lookup :: IORef (Map (Set ComponentId) Int), counter :: IORef Int, allArchetypes :: IORef (Set ArchetypeId)}  newArchetypeGraph :: IO ArchetypeGraph newArchetypeGraph = do@@ -22,7 +22,8 @@    !counter <- newIORef 1   !lookup <- newIORef $ Map.singleton Set.empty 0-  pure $ ArchetypeGraph {nodes, lookup, counter}+  allArchetypes <- newIORef $ Set.singleton $ ArchetypeId 0+  pure ArchetypeGraph {nodes, lookup, counter, allArchetypes}  data ArchetypeNode = ArchetypeNode   { archetype :: ArchetypeData,

@@ -5,7 +5,6 @@ import Data.Data import Data.Foldable import Data.IORef-import Data.List import Data.Map qualified as Map import Data.Maybe import Data.Set (Set)@@ -33,6 +32,7 @@    !id <- liftIO $ getNewId graph   liftIO $ modifyIORef' graph.lookup $ Map.insert components id+  liftIO $ modifyIORef' graph.allArchetypes $ Set.insert (ArchetypeId id)   Vec.pushBack graph.nodes ArchetypeNode {archetype = ArchetypeData {id = ArchetypeId id, components}, insert = Map.empty, remove = Map.empty}    -- comps <-@@ -225,36 +225,50 @@  data ComponentQuery = ComponentQuery | RelationshipQueryAny | RelationshipQuery -findMatchingArchetypes :: forall m w. (MonadSystem w m) => [(ComponentId, ComponentQuery)] -> Archetypes -> m [ArchetypeId]-findMatchingArchetypes [] _ = allArchetypes-findMatchingArchetypes components Archetypes {graph} = do+findMatchingArchetypes :: forall m w. (MonadSystem w m) => [(ComponentId, ComponentQuery)] -> m (Set ArchetypeId)+findMatchingArchetypes [] = allArchetypes+findMatchingArchetypes components = do   !archetypes'' <- forM components $ \(ComponentId (# id, target #), q) -> do     case q of       ComponentQuery -> do         !x <- fromMaybe (ComponentArchetypes Set.empty) <$> worldGet (Proxy @ComponentArchetypes) (Entity (# id, 0## #))-        return x.inner+        pure x.inner       RelationshipQueryAny -> do         Just !x <- worldGet (Proxy @ComponentPairs) (Entity (# id, 0## #))-        return x.any+        pure x.any       RelationshipQuery -> do         case target of           Nothing -> undefined           Just !target -> do             Just !x <- worldGet (Proxy @ComponentPairs) (Entity (# id, 0## #))-            return $ fromMaybe undefined $ Map.lookup target x.pairs--  case map Set.toList archetypes'' of-    [] -> return []-    !h : !tail -> do-      let !archetypes = foldr intersect h tail+            pure $ fromMaybe Set.empty $ Map.lookup target x.pairs -      mapM-        ( \(ArchetypeId !x) -> do-            pure $ ArchetypeId x-        )-        archetypes+  -- TODO: use Set.intersections from containers >=0.8+  pure $ case archetypes'' of+    [] -> Set.empty+    !h : !t -> foldr Set.intersection h t -allArchetypes :: forall m w. (MonadSystem w m) => m [ArchetypeId]+allArchetypes :: forall m w. (MonadSystem w m) => m (Set ArchetypeId) allArchetypes = do   !world <- unsafeGetWorld-  map (\(!x) -> x.archetype.id) <$> Vec.toList world.archetypes.graph.nodes+  liftIO $ readIORef world.archetypes.graph.allArchetypes++archetypesWith :: forall m w. (MonadSystem w m) => (ComponentId, ComponentQuery) -> m (Set ArchetypeId)+archetypesWith (ComponentId (# id, _ #), ComponentQuery) = do+  !x <- fromMaybe (ComponentArchetypes Set.empty) <$> worldGet (Proxy @ComponentArchetypes) (Entity (# id, 0## #))+  pure x.inner+archetypesWith (ComponentId (# id, _ #), RelationshipQueryAny) = do+  Just !x <- worldGet (Proxy @ComponentPairs) (Entity (# id, 0## #))+  pure x.any+archetypesWith (ComponentId (# id, target #), RelationshipQuery) = do+  case target of+    Nothing -> undefined+    Just !target -> do+      Just !x <- worldGet (Proxy @ComponentPairs) (Entity (# id, 0## #))+      pure $ fromMaybe Set.empty $ Map.lookup target x.pairs++archetypesWithout :: forall m w. (MonadSystem w m) => (ComponentId, ComponentQuery) -> m (Set ArchetypeId)+archetypesWithout x = do+  x <- archetypesWith x+  a <- allArchetypes+  pure $ Set.difference a x

@@ -18,4 +18,4 @@     _ -> Nothing  children :: forall m w. (MonadSystem w m) => Entity -> m [Entity]-children = outgoing' @ChildOf+children = incoming @ChildOf

@@ -2,7 +2,6 @@  module Mischief.ECS.Schedules where -import Language.Haskell.TH (Extension (AllowAmbiguousTypes)) import Mischief.ECS.App import Mischief.ECS.App.Schedules import Mischief.ECS.Entities

@@ -5,7 +5,6 @@ import Data.IORef import Data.Maybe import Data.Set qualified as Set-import Data.Text qualified as T import GHC.Base (Int (..)) import GHC.Stack (HasCallStack) import Mischief.ECS.App.SystemDef@@ -13,13 +12,11 @@ import Mischief.ECS.Components import Mischief.ECS.Components.Bundle import Mischief.ECS.Entities-import Mischief.ECS.Log import Mischief.ECS.Tables import Mischief.ECS.Vec qualified as Vec import Mischief.ECS.World import Mischief.ECS.World.Query import Mischief.ECS.World.Query.Markers-import Mischief.ECS.World.Utils  data ChangeResult = ChangeResult   { requiredComponentsAdded :: [ProcessedBundleElement],

@@ -8,6 +8,7 @@ import Data.Data import Data.Foldable import Data.Maybe+import Data.Set (Set) import Data.Set qualified as Set import Data.Traversable import Mischief.ECS.Archetypes.Graph@@ -22,7 +23,7 @@ import Mischief.ECS.World.Query.Queryable import Prelude hiding (and) -findArchetypes :: forall qd m w output. (Queryable qd output, MonadSystem w m) => qd -> m [ArchetypeId]+findArchetypes :: forall qd m w output. (Queryable qd output, MonadSystem w m) => qd -> m (Set ArchetypeId) findArchetypes !query = do   !world <- unsafeGetWorld   !components <-@@ -42,7 +43,7 @@         )         (Set.toList (queryTypes query)) -  findMatchingArchetypes (catMaybes components) world.archetypes+  findMatchingArchetypes (catMaybes components)  -- runQuery :: forall qd m w output a. (Queryable qd output, MonadSystem w m) => qd -> QueryFilter -> World -> m [output] -- runQuery query filter world =@@ -228,18 +229,8 @@   !world <- unsafeGetWorld   !archetypes' <- findArchetypes qd -  !archetypes <--    liftIO-      ( filterM-          ( \a -> do-              let Tables tables = world.tables-              table <- Vec.unsafeRead tables a.id-              filterArchetype qf world table-          )-          archetypes'-      )--  !x <- liftIO $ runQueryInternal (E, qd) archetypes world+  !archetypes <- filterArchetypes archetypes' qf+  !x <- liftIO $ runQueryInternal (E, qd) (Set.toList archetypes) world   pure $! mapMaybe (\case (_, False, _) -> Nothing; (_, True, x) -> Just x) x qrun (BuildQuery !qd !qf (Just [!entity])) = do   !world <- unsafeGetWorld@@ -403,3 +394,54 @@           [] -> Nothing           (a : _) -> Just a     )++filterToQuery :: (ToFilterComponent a) => World -> a -> IO (Maybe (ComponentId, ComponentQuery))+filterToQuery world a = do+  let FilterComponent x = toFilterComponent a+  case x of+    (c, Nothing, Nothing) -> do+      x <- getComponentId c world.components+      pure $ fmap (,ComponentQuery) x+    (c, Just e, Nothing) -> do+      x <- fmap (setCompIdTarget $ Just e) <$> getComponentId c world.components+      pure $ fmap (,RelationshipQuery) x+    (c, _, Just _) -> do+      x <- getComponentId c world.components+      pure $ fmap (,RelationshipQueryAny) x++filterArchetypes :: (MonadSystem w m) => Set ArchetypeId -> QueryFilter -> m (Set ArchetypeId)+filterArchetypes prev NoFilter = pure prev+filterArchetypes prev (With x) = do+  world <- unsafeGetWorld+  f <- liftIO $ filterToQuery world x+  case f of+    Nothing -> pure Set.empty+    Just f -> do+      a <- archetypesWith f+      pure $ Set.intersection prev a+filterArchetypes prev (Without x) = do+  world <- unsafeGetWorld+  f <- liftIO $ filterToQuery world x+  case f of+    Nothing -> pure prev+    Just f -> do+      a <- archetypesWithout f+      pure $ Set.intersection prev a+filterArchetypes prev (Changed x f1 f2) = do+  world <- unsafeGetWorld+  -- TODO: use Set.filterA from containers>=0.8.1+  Set.fromList+    <$> filterM+      ( \a -> do+          let Tables tables = world.tables+          table <- Vec.unsafeRead tables a.id+          liftIO $ filterArchetype (Changed x f1 f2) world table+      )+      (Set.toList prev)+filterArchetypes prev (And x y) = do+  prev' <- filterArchetypes prev x+  filterArchetypes prev' y+filterArchetypes prev (Or x y) = do+  a <- filterArchetypes prev x+  b <- filterArchetypes prev y+  pure $ Set.union a b