Hey endofriends! I’m really excited to share the latest version of Aztecs, a modular game engine and Entity Component System (ECS) built with Haskell
The latest version now relies heavily on in-place mutation through a type-level Query
API, that provides compile-time guarantees for read and write access. A System
can then be implemented by taking some ECS access as input:
-- Components
newtype Position = Position Int
deriving (Show, Eq)
instance (Monad m) => Component m Position where
type ComponentStorage m Position = SparseStorage m
newtype Velocity = Velocity Int
deriving (Show, Eq)
instance (Monad m) => Component m Velocity where
type ComponentStorage m Velocity = SparseStorage m
-- System
data MoveSystem = MoveSystem
instance (PrimMonad m, MonadIO m) => System m MoveSystem where
type SystemIn m MoveSystem = Query (W m Position, R Velocity)
runSystem \_ = mapM\_ go
where
go (posRef, R (Velocity v)) = do
modifyW posRef $ \\(Position p) -> Position (p + v)
p <- readW posRef
liftIO $ putStrLn $ "Moved to: " ++ show p
System
s can then be automatically scheduled with Before
and After
constraints, and in-parallel (if possible), at the type-level (also with compile-time errors):
app ::
HSet
'[ Run '[] MoveSystem,
Run '[After MoveSystem] PhysicsSystem,
Run '[After PhysicsSystem] CombatSystem,
Run '[After CombatSystem] RenderSystem
]
I’m also really curious about how this generic ECS
class might be used, I’ve been trying to get it as minimal as possible to potentially support a wide-range of ECS backends (like Apecs or maybe bindings to something like Bevy or Flecs):
-- | Entity Component System (ECS) implementation.
class ECS m where
-- | Entity identifier.
type Entity m :: Type
-- | Task monad for running systems.
type Task m :: Type -> Type
-- | Spawn a new entity with a `Bundle` of components.
spawn :: Bundle (Entity m) m -> m (Entity m)
-- | Insert a `Bundle` of components into an existing entity
-- (otherwise this will do nothing).
insert :: Entity m -> Bundle (Entity m) m -> m ()
-- | Remove an entity and its components.
remove :: Entity m -> m ()
-- | Run a `Task`.
task :: (Task m) a -> m a