Skip to content

Commit 1041803

Browse files
matthunzmatthunz
committed
fix: Bundle
1 parent 9b233f5 commit 1041803

7 files changed

Lines changed: 45 additions & 78 deletions

File tree

‎aztecs.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -29,6 +29,7 @@ library
2929
Aztecs.ECS
3030
Aztecs.ECS.Access
3131
Aztecs.ECS.Access.Internal
32+
Aztecs.ECS.Bundle
3233
Aztecs.ECS.Class
3334
Aztecs.ECS.Commands
3435
Aztecs.ECS.Executor

‎examples/Scheduler.hs‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -113,9 +113,9 @@ runSchedulerExample = do
113113
where
114114
go :: AztecsT '[Position, Velocity, Health, Damage] IO ()
115115
go = do
116-
_ <- spawn (W.bundle (Position 0) <> W.bundle (Velocity 5) <> W.bundle (Health 100))
117-
_ <- spawn (W.bundle (Position 10) <> W.bundle (Velocity 3) <> W.bundle (Health 75) <> W.bundle (Damage 10))
118-
_ <- spawn (W.bundle (Position (-5)) <> W.bundle (Velocity 2) <> W.bundle (Health 50))
116+
_ <- spawn (bundle (Position 0) <> bundle (Velocity 5) <> bundle (Health 100))
117+
_ <- spawn (bundle (Position 10) <> bundle (Velocity 3) <> bundle (Health 75) <> bundle (Damage 10))
118+
_ <- spawn (bundle (Position (-5)) <> bundle (Velocity 2) <> bundle (Health 50))
119119
runSchedule app
120120
return ()
121121

@@ -126,9 +126,9 @@ runSchedulerExampleSmall = do
126126
where
127127
go :: AztecsT '[Position, Velocity, Health, Damage] IO ()
128128
go = do
129-
_ <- spawn (W.bundle (Position 0) <> W.bundle (Velocity 5) <> W.bundle (Health 100))
130-
_ <- spawn (W.bundle (Position 10) <> W.bundle (Velocity 3) <> W.bundle (Health 75) <> W.bundle (Damage 10))
131-
_ <- spawn (W.bundle (Position (-5)) <> W.bundle (Velocity 2) <> W.bundle (Health 50))
129+
_ <- spawn (bundle (Position 0) <> bundle (Velocity 5) <> bundle (Health 100))
130+
_ <- spawn (bundle (Position 10) <> bundle (Velocity 3) <> bundle (Health 75) <> bundle (Damage 10))
131+
_ <- spawn (bundle (Position (-5)) <> bundle (Velocity 2) <> bundle (Health 50))
132132
runSchedule appSmall
133133
return ()
134134

‎src/Aztecs/ECS/Class.hs‎

Lines changed: 4 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,7 @@
77

88
module Aztecs.ECS.Class (ECS (..), Bundleable (..)) where
99

10+
import Aztecs.ECS.Bundle
1011
import Aztecs.ECS.HSet
1112
import Data.Kind
1213

@@ -18,18 +19,15 @@ class ECS m where
1819
-- | Components that can be stored or accessed.
1920
type Components m :: [Type]
2021

21-
-- | Bundle of components that can be stored in an entity.
22-
type Bundle m :: Type
23-
2422
-- | Task monad for running systems.
2523
type Task m :: Type -> Type
2624

2725
-- | Spawn a new entity with a `Bundle` of components.
28-
spawn :: Bundle m -> m (Entity m)
26+
spawn :: Bundle (Entity m) m -> m (Entity m)
2927

3028
-- | Insert a `Bundle` of components into an existing entity
3129
-- (otherwise this will do nothing).
32-
insert :: Entity m -> Bundle m -> m ()
30+
insert :: Entity m -> Bundle (Entity m) m -> m ()
3331

3432
-- | Remove an entity and its components.
3533
remove :: Entity m -> m ()
@@ -38,4 +36,4 @@ class ECS m where
3836
task :: (Task m) a -> m a
3937

4038
class Bundleable c m where
41-
bundle :: c -> Bundle m
39+
bundle :: c -> Bundle (Entity m) m

‎src/Aztecs/Internal.hs‎

Lines changed: 30 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,7 @@ module Aztecs.Internal (AztecsT (..), runAztecsT_) where
1515

1616
import Aztecs.ECS.Access.Internal
1717
import qualified Aztecs.ECS.Access.Internal as A
18+
import Aztecs.ECS.Bundle
1819
import Aztecs.ECS.Class
1920
import Aztecs.ECS.Commands
2021
import Aztecs.ECS.Executor
@@ -29,13 +30,16 @@ import qualified Aztecs.ECS.Scheduler as Scheduler
2930
import Aztecs.ECS.System
3031
import Aztecs.Entities
3132
import qualified Aztecs.Entities as E
32-
import Aztecs.World (ComponentStorage, bundle)
33+
import Aztecs.World (ComponentStorage)
3334
import qualified Aztecs.World as W
3435
import Control.Monad.Identity
3536
import Control.Monad.Primitive
3637
import Control.Monad.State.Strict
38+
import qualified Data.IntMap.Strict as IntMap
39+
import qualified Data.Map.Strict as Map
3740
import Data.Maybe
3841
import qualified Data.Set as Set
42+
import qualified Data.SparseSet.Strict as S
3943
import qualified Data.SparseSet.Strict.Mutable as MS
4044
import Data.Typeable
4145
import Data.Word
@@ -49,20 +53,17 @@ instance MonadTrans (AztecsT cs) where
4953

5054
instance (PrimMonad m) => ECS (AztecsT cs m) where
5155
type Entity (AztecsT cs m) = E.Entity
52-
type Bundle (AztecsT cs m) = W.Bundle cs m
5356
type Components (AztecsT cs m) = cs
5457
type Task (AztecsT cs m) = (Commands (AztecsT cs) m)
5558

56-
spawn b = AztecsT $ do
57-
w <- get
58-
(e, w') <- lift $ W.spawn b w
59-
put w'
59+
spawn b = do
60+
w <- AztecsT $ get
61+
let (e, counter) = mkEntityWithCounter (W.worldEntities w)
62+
AztecsT $ put w {W.worldEntities = counter}
63+
runBundle b e
6064
return e
6165
{-# INLINE spawn #-}
62-
insert e b = AztecsT $ do
63-
w <- get
64-
w' <- lift $ W.insert e b w
65-
put w'
66+
insert e b = runBundle b e
6667
{-# INLINE insert #-}
6768
remove e = AztecsT $ do
6869
w <- get
@@ -73,10 +74,27 @@ instance (PrimMonad m) => ECS (AztecsT cs m) where
7374
{-# INLINE task #-}
7475

7576
instance
76-
(PrimMonad m, Typeable c, AdjustM m (ComponentStorage (PrimState m)) c cs) =>
77+
( PrimMonad m,
78+
Typeable c,
79+
AdjustM m (ComponentStorage (PrimState m)) c cs
80+
) =>
7781
Bundleable c (AztecsT cs m)
7882
where
79-
bundle = W.bundle
83+
bundle c = Bundle $ \entity -> do
84+
w <- AztecsT $ get
85+
let entityIdx = fromIntegral (entityIndex entity)
86+
componentType = typeOf c
87+
go s = do
88+
s' <- S.freeze s
89+
S.thaw $ S.insert (entityIndex entity) c s'
90+
cs <- lift . HS.adjustM go $ W.worldComponents w
91+
let entityComponents' =
92+
IntMap.insertWith
93+
Map.union
94+
entityIdx
95+
(Map.singleton componentType (W.removeComponent' @m @c entity))
96+
(W.worldEntityComponents w)
97+
AztecsT $ put w {W.worldComponents = cs, W.worldEntityComponents = entityComponents'}
8098

8199
runAztecsT_ :: (Monad m) => AztecsT cs m a -> W.World m cs -> m a
82100
runAztecsT_ (AztecsT m) = evalStateT m

‎src/Aztecs/R.hs‎

Lines changed: 0 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -6,29 +6,14 @@
66

77
module Aztecs.R (R (..)) where
88

9-
import Aztecs.ECS.Access.Internal
10-
import qualified Aztecs.ECS.Access.Internal as A
11-
import Aztecs.ECS.Class
12-
import Aztecs.ECS.Executor
139
import Aztecs.ECS.HSet (HSetT (..), Lookup (..))
14-
import qualified Aztecs.ECS.HSet as HS
1510
import Aztecs.ECS.Query
16-
import Aztecs.ECS.Queryable
1711
import Aztecs.ECS.Queryable.Internal
18-
import Aztecs.ECS.Schedule
19-
import Aztecs.ECS.Scheduler
20-
import qualified Aztecs.ECS.Scheduler as Scheduler
2112
import Aztecs.ECS.System
22-
import Aztecs.Entities
23-
import qualified Aztecs.Entities as E
2413
import Aztecs.Internal
25-
import Aztecs.World (ComponentStorage, bundle)
2614
import qualified Aztecs.World as W
27-
import Control.Monad.Identity
2815
import Control.Monad.Primitive
2916
import Control.Monad.State.Strict
30-
import Data.Maybe
31-
import qualified Data.Set as Set
3217
import qualified Data.SparseSet.Strict.Mutable as MS
3318
import Data.Word
3419
import Prelude hiding (Read, lookup)

‎src/Aztecs/W.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -35,7 +35,7 @@ import Aztecs.ECS.System
3535
import Aztecs.Entities
3636
import qualified Aztecs.Entities as E
3737
import Aztecs.Internal
38-
import Aztecs.World (ComponentStorage, bundle)
38+
import Aztecs.World (ComponentStorage)
3939
import qualified Aztecs.World as W
4040
import Control.Monad.Identity
4141
import Control.Monad.Primitive

‎src/Aztecs/World.hs‎

Lines changed: 3 additions & 38 deletions
Original file line numberDiff line numberDiff line change
@@ -10,19 +10,17 @@
1010
{-# LANGUAGE UndecidableInstances #-}
1111

1212
module Aztecs.World
13-
( Bundle (..),
14-
bundle,
15-
World (..),
13+
( World (..),
1614
empty,
17-
spawn,
18-
insert,
1915
removeComponent,
16+
removeComponent',
2017
remove,
2118
Components,
2219
ComponentStorage,
2320
)
2421
where
2522

23+
import Aztecs.ECS.Bundle
2624
import Aztecs.ECS.HSet hiding (empty)
2725
import qualified Aztecs.ECS.HSet as HS
2826
import Aztecs.ECS.Query
@@ -43,29 +41,6 @@ import Data.Typeable
4341
import Data.Word
4442
import Prelude hiding (Read, lookup)
4543

46-
newtype Bundle cs m = Bundle {runBundle :: Entity -> World m cs -> m (World m cs)}
47-
48-
instance (Monad m) => Semigroup (Bundle cs m) where
49-
Bundle f <> Bundle g = Bundle $ \entity w -> f entity w >>= g entity
50-
51-
instance (Monad m) => Monoid (Bundle cs m) where
52-
mempty = Bundle $ \_ w -> return w
53-
54-
bundle ::
55-
forall cs m c.
56-
(AdjustM m (MSparseSet (PrimState m) Word32) c cs, PrimMonad m, Typeable c) =>
57-
c ->
58-
Bundle cs m
59-
bundle c = Bundle $ \entity w -> do
60-
let entityIdx = fromIntegral (entityIndex entity)
61-
componentType = typeOf c
62-
go s = do
63-
s' <- S.freeze s
64-
S.thaw $ S.insert (entityIndex entity) c s'
65-
cs <- HS.adjustM go $ worldComponents w
66-
let entityComponents' = IntMap.insertWith Map.union entityIdx (Map.singleton componentType (removeComponent' @m @c entity)) (worldEntityComponents w)
67-
return w {worldComponents = cs, worldEntityComponents = entityComponents'}
68-
6944
type ComponentStorage s = MSparseSet s Word32
7045

7146
type Components s = HSetT (ComponentStorage s)
@@ -81,16 +56,6 @@ empty = do
8156
cs <- HS.empty
8257
return $ World cs emptyEntities IntMap.empty
8358

84-
spawn :: (Monad m) => Bundle cs m -> World m cs -> m (Entity, World m cs)
85-
spawn c w = do
86-
let (newEntity, counter) = mkEntityWithCounter (worldEntities w)
87-
world' = w {worldEntities = counter}
88-
world'' <- runBundle c newEntity world'
89-
return (newEntity, world'')
90-
91-
insert :: Entity -> Bundle cs m -> World m cs -> m (World m cs)
92-
insert entity b = runBundle b entity
93-
9459
removeComponent ::
9560
forall m cs c.
9661
(AdjustM m (MSparseSet (PrimState m) Word32) c cs, PrimMonad m, Typeable c) =>

0 commit comments

Comments
 (0)