packages feed

ohhecs-0.0.1: src/Games/ECS/System.hs

-- |
-- Module      :  Games.ECS.System
-- Description : System definitions
-- Copyright   :  (C) 2020 Sophie Taylor
-- License     :  AGPL-3.0-or-later
-- Maintainer  :  Sophie Taylor <sophie@spacekitteh.moe>
-- Stability   :  experimental
-- Portability: GHC
--
-- Infrastructure for defining ECS Systems.
module Games.ECS.System where

import Control.Lens
import Data.Kind
import Data.Proxy
import Debug.Trace
import GHC.TypeLits
import Games.ECS.Entity
import Games.ECS.World

-- TODO: Generate a "UsingSystem" class a la UsingComponents

-- type SystemFunc w = World w => w Storing -> w Storing
-- type IndividualFunc m w = (World w, MonadState (w Storing) m) => m (w Individual) -> m (w Individual)

-- | A system which operates on entities which matches certain constraints on components.
class (World w, Monad m, KnownSymbol (AppendSymbol name " started"), KnownSymbol (AppendSymbol name " finished")) => System (name :: Symbol) sys w m | name -> sys, sys -> name where
  -- Remember to use '[] rather than [] to specify type-level lists!

  -- | What this systems runs after
  type RunsAfter sys :: [Symbol]

  type RunsAfter sys = '[]

  -- | What this systems runs before
  type RunsBefore sys :: [Symbol]

  type RunsBefore sys = '[]

  -- | Constraints required to run the system.
  type ComponentFilters name sys w m :: Constraint

  type ComponentFilters name sys w m = ()

  -- | The filter on components which the system affects
  componentFilter :: (ComponentFilters name sys w m, Monoid r) => Getting r (w Storing) IntersectionOfEntities
  componentFilter = mempty

  -- | Should this entity be processed?
  processPredicate :: (ComponentFilters name sys w m) => w Individual -> Bool
  processPredicate = const True

  -- | Process a single entity
  processEntity :: (ComponentFilters name sys w m) => w Individual -> m (w Individual)
  processEntity = pure

  -- | Initialise the system with preliminary data based on a fresh world. The system is allowed to modify the
  -- world if it wishes.
  initialiseSystem :: w Storing -> m (w Storing)
  initialiseSystem = pure

  -- | Run the system. By default, it runs `processEntity` for each entity.
  runSystem :: (ComponentFilters name sys w m) => w Storing -> m (w Storing)
  runSystem world = do
    traceMarker (symbolVal (Proxy :: Proxy (AppendSymbol name " started"))) (pure ())
    processedWorld <- traverseOf (entitiesWith (componentFilter @name @sys @w @m) . filtered (processPredicate @name @sys @w @m)) (processEntity @name) world
    finished <- postTickCleanup @name @sys processedWorld
    traceMarker (symbolVal (Proxy :: Proxy (AppendSymbol name " started"))) (pure finished)

  -- | Run any cleanup necessary at the end of a tick, such as clearing cached data only necessary for the tick, or marking things as dirty.
  postTickCleanup :: (ComponentFilters name sys w m) => w Storing -> m (w Storing)
  postTickCleanup = pure

  -- | Ran after the effect system has finished. This is so that one can, for example, collect all effects to
  -- apply during the effect system processing; and once all effects are collected, apply them all at once.
  -- This can eliminate redundant processing, as well as later effects not overriding previously-processed
  -- effects.
  runAfterEffects :: w Storing -> m (w Storing)
  runAfterEffects = pure

{-
collectGarbage :: SystemFunc w
collectGarbage = undefined

markUselessEntitiesForDeletion :: (Foldable f, World w) => w Storing -> f Entity
markUselessEntitiesForDeletion = undefined

removeMarked :: Foldable f => f Entity -> SystemFunc w
removeMarked = undefined
-}