Utils.hs

{-# LANGUAGE AllowAmbiguousTypes #-}

module Mischief.ECS.World.Utils where

import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.Bifunctor qualified
import Data.IORef
import Data.Proxy
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Typeable
import Mischief.ECS.Components
import Mischief.ECS.Components.Bundle
import Mischief.ECS.Components.Spawn
import Mischief.ECS.Entities
import Mischief.ECS.Tables
import Mischief.ECS.World

-- | Process a 'BundleElement', turning its 'TypeRep' into a 'ComponentId'.
processBundleElement :: World -> BundleElement ErasedComponent -> IO ProcessedBundleElement
processBundleElement !world BundleElement {rep = (ComponentRep !r), component = !component} =
  do
    !id <- runSystem (getOrAddComponentId r) world
    pure
      ProcessedBundleElement
        { id,
          component
        }
processBundleElement !world BundleElement {rep = (PairRep (!r, !entity)), component = !component} =
  do
    !id <- runSystem (getOrAddPairId (Pair (r, entity))) world
    pure
      ProcessedBundleElement
        { id,
          component
        }

-- | Process a set of 'BundleElement's into a 'ProcessedBundleData'.
processBundleElements :: World -> Set (BundleElement ErasedComponent) -> IO ProcessedBundleData
processBundleElements !world !elements =
  do
    !elements <- mapM (processBundleElement world) (Set.toList elements)
    pure
      ProcessedBundleData {elements}

-- | Combine two 'ProcessedBundleData's, merging their sets of elements.
combineProcessedBundles :: ProcessedBundleData -> ProcessedBundleData -> ProcessedBundleData
combineProcessedBundles !bundle1 !bundle2 =
  let !elements = Set.toList $ Set.union (Set.fromList bundle1.elements) (Set.fromList bundle2.elements)
   in ProcessedBundleData {elements}

-- | Check if a 'ComponentId' is inside a 'ProcessedBundleData'.
isInProcessedBundle :: ProcessedBundleData -> ComponentId -> Bool
isInProcessedBundle ProcessedBundleData {elements = !elements} !id = id `elem` map (.id) elements

-- | Sets the change tick of certain elements of the bundle to the specified 'Tick'.
-- setChangedTickOfComponents :: ProcessedBundleData -> (ComponentId -> Bool) -> Tick -> ProcessedBundleData
-- setChangedTickOfComponents ProcessedBundleData {elements = !elements} !shouldChange !tick =
--   ProcessedBundleData
--     { elements =
--         map
--           ( \ProcessedBundleElement {id = !id, component = ComponentData {value = !value, ticks = ComponentTicks {added = !added, changed = !changed}}} ->
--               if shouldChange id
--                 then ProcessedBundleElement {id, component = ComponentData {value, ticks = ComponentTicks {added, changed = tick}}}
--                 else ProcessedBundleElement {id, component = ComponentData {value, ticks = ComponentTicks {added, changed}}}
--           )
--           elements
--     }

-- | Sets the added tick of certain elements of the bundle to the specified 'Tick'.
-- setAddedTickOfComponents :: ProcessedBundleData -> (ComponentId -> Bool) -> Tick -> ProcessedBundleData
-- setAddedTickOfComponents ProcessedBundleData {elements = !elements} !shouldChange !tick =
--   ProcessedBundleData
--     { elements =
--         map
--           ( \ProcessedBundleElement {id = !id, component = ComponentData {value = !value, ticks = ComponentTicks {added = !added, changed = !changed}}} ->
--               if shouldChange id
--                 then ProcessedBundleElement {id, component = ComponentData {value, ticks = ComponentTicks {added = tick, changed}}}
--                 else ProcessedBundleElement {id, component = ComponentData {value, ticks = ComponentTicks {added, changed}}}
--           )
--           elements
--     }
removeComponentFromProcessedBundle :: ComponentId -> ProcessedBundleData -> ProcessedBundleData
removeComponentFromProcessedBundle !componentId !bundle =
  do
    let elements = filter ((/= componentId) . (.id)) bundle.elements
     in ProcessedBundleData {elements}

tryGetEntityRelCollection :: forall c. (Component c) => World -> Entity -> IO (Maybe (Maybe [Rel c]))
tryGetEntityRelCollection !world !entity =
  do
    !componentId <- getComponentId (typeRep $ Proxy @c) world.components
    case componentId of
      Nothing -> pure Nothing
      Just !componentId -> do
        !pointer <- getPointer entity world.entities
        case pointer of
          Nothing -> do
            pure Nothing
          Just !pointer ->
            do
              !pointer <- readIORef pointer
              !res <- tryGetRelCollectionFromTables world.tables entity pointer componentId
              pure $ Just $ fmap (map snd) res

tryGetEntityComponent :: forall c. (Component c) => World -> Entity -> IO (Maybe (Maybe c))
tryGetEntityComponent !world !entity =
  do
    !pointer <- getPointer entity world.entities

    case pointer of
      Nothing -> pure Nothing
      Just !pointer ->
        do
          !componentId <- getComponentId (typeRep $ Proxy @c) world.components
          case componentId of
            Nothing -> pure $ Just Nothing
            Just !componentId -> do
              !pointer <- readIORef pointer
              !res <- tryGetComponentFromTables world.tables pointer componentId
              pure $ Just res

tryGetEntityRel :: forall c. (Component c) => Entity -> World -> Entity -> IO (Maybe (Maybe c))
tryGetEntityRel !target !world !entity =
  do
    !pointer <- getPointer entity world.entities

    case pointer of
      Nothing -> pure Nothing
      Just !pointer ->
        do
          !componentId <- getComponentId (typeRep $ Proxy @c) world.components
          case componentId of
            Nothing -> return Nothing
            Just (ComponentId (# !id, _ #)) -> do
              !pointer <- readIORef pointer
              !res <- tryGetComponentFromTables world.tables pointer (ComponentId (# id, Just target #))
              pure $ Just res

tryGetRelCollections :: forall c. (Component c) => World -> [ArchetypeId] -> IO [(Entity, [Rel c])]
tryGetRelCollections !world !archetypes =
  do
    !componentId <- getComponentId (typeRep $ Proxy @c) world.components
    case componentId of
      Nothing -> pure []
      Just !componentId ->
        tryGetRelCollectionsFromTables world.tables archetypes componentId

tryGetComponents :: forall c. (Component c) => World -> [ArchetypeId] -> IO [(Entity, c)]
tryGetComponents !world !archetypes =
  do
    !componentId <- getComponentId (typeRep $ Proxy @c) world.components
    case componentId of
      Nothing -> pure []
      Just !componentId ->
        tryGetComponentsFromTables world.tables archetypes componentId

tryGetEntities :: World -> [ArchetypeId] -> IO [Entity]
tryGetEntities !world = tryGetEntitiesFromTables world.tables

tryGetRels :: forall c. (Component c) => Entity -> World -> [ArchetypeId] -> IO [(Entity, Rel c)]
tryGetRels !target !world !archetypes =
  do
    !componentId <- getComponentId (typeRep $ Proxy @c) world.components
    case componentId of
      Nothing -> pure []
      Just !componentId -> do
        !res <- tryGetComponentsFromTables world.tables archetypes (setCompIdTarget (Just target) componentId) -- {entity = Just target}
        pure $ map (\(!e, !res) -> (e, Rel res target)) res

tryGetRelsMaybe :: forall c. (Component c) => Entity -> World -> [ArchetypeId] -> IO [(Entity, Maybe (Rel c))]
tryGetRelsMaybe !target !world !archetypes =
  do
    !componentId <- getComponentId (typeRep $ Proxy @c) world.components
    case componentId of
      Nothing -> do
        !e <- tryGetEntities world archetypes
        pure $ map (,Nothing) e
      Just !componentId -> do
        !res <- tryGetComponentsFromTablesMaybe world.tables archetypes (setCompIdTarget (Just target) componentId) -- {entity = Just target}
        pure $
          map
            ( Data.Bifunctor.second
                (fmap (`Rel` target))
            )
            res

tryGetComponentsMaybe :: forall c. (Component c) => World -> [ArchetypeId] -> IO [(Entity, Maybe c)]
tryGetComponentsMaybe !world !archetypes =
  do
    !componentId <- getComponentId (typeRep $ Proxy @c) world.components
    case componentId of
      Nothing -> do
        !e <- tryGetEntities world archetypes
        pure $ map (,Nothing) e
      Just !componentId ->
        tryGetComponentsFromTablesMaybe world.tables archetypes componentId

tryGetTicks :: ComponentId -> World -> [ArchetypeId] -> IO [Maybe ComponentTick]
tryGetTicks !componentId !world !archetypes = tryGetTicksFromTables world.tables archetypes componentId

-- tryGetEntityTicks :: Entity -> ComponentId -> World -> IO (Maybe ComponentTicks)
-- tryGetEntityTicks !entity !componentId !world = do
--   !pointer <- getPointer entity world.entities
--   case pointer of
--     Nothing -> pure Nothing
--     Just !pointer -> do
--       !pointer <- readIORef pointer
--       tryGetEntityTicksFromTables world.tables pointer componentId

isAlive :: forall m w. (MonadSystem w m) => Entity -> m Bool
isAlive !entity = do
  !world <- unsafeGetWorld
  liftIO $ isAliveIO entity world.entities

newtype GetSystem = GetSystem (forall c. (Component c) => Proxy c -> Entity -> System (Maybe c))