Archetypes.hs

module Mischief.ECS.Archetypes where

import Data.IORef
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Set (Set)
import Data.Set qualified as Set
import Mischief.ECS.Components
import Mischief.ECS.Vec
import Mischief.ECS.Vec qualified as Vec

newtype Archetypes = Archetypes {graph :: ArchetypeGraph}

data ArchetypeGraph = ArchetypeGraph {nodes :: IOVec ArchetypeNode, lookup :: IORef (Map (Set ComponentId) Int), counter :: IORef Int, allArchetypes :: IORef (Set ArchetypeId)}

newArchetypeGraph :: IO ArchetypeGraph
newArchetypeGraph = do
  !nodes <- Vec.new 1024

  -- Add the empty archetype to the graph.
  Vec.pushBack nodes ArchetypeNode {archetype = ArchetypeData {id = ArchetypeId 0, components = Set.empty}, insert = Map.empty, remove = Map.empty}

  !counter <- newIORef 1
  !lookup <- newIORef $ Map.singleton Set.empty 0
  allArchetypes <- newIORef $ Set.singleton $ ArchetypeId 0
  pure ArchetypeGraph {nodes, lookup, counter, allArchetypes}

data ArchetypeNode = ArchetypeNode
  { archetype :: ArchetypeData,
    insert :: Map ComponentId Int,
    remove :: Map ComponentId Int
  }

data ArchetypeData = ArchetypeData
  { id :: ArchetypeId,
    components :: Set ComponentId
  }

-- Construct an empty 'Archetypes'.
emptyArchetypes :: IO Archetypes
emptyArchetypes =
  Archetypes <$> newArchetypeGraph