module Mischief.ECS.World.Spawn where

import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Reader (MonadReader (..), ReaderT (runReaderT))
import Data.Data
import Data.IORef
import Data.Map qualified as Map
import Data.Maybe
import Data.Set qualified as Set
import GHC.Base (Int (..))
import GHC.Stack
import Mischief.ECS.Archetypes.Graph (getArchetypeOnSpawn)
import Mischief.ECS.Components
import Mischief.ECS.Components.Bundle
import Mischief.ECS.Components.Common
import Mischief.ECS.Entities
import Mischief.ECS.EventDef
import Mischief.ECS.Hidden
import Mischief.ECS.Log
import Mischief.ECS.Observer
import Mischief.ECS.Tables
import Mischief.ECS.Vec qualified as Vec
import Mischief.ECS.World
import Mischief.ECS.World.Change
import Mischief.ECS.World.Defer
import Mischief.ECS.World.Insert
import Mischief.ECS.World.Prefs
import Mischief.ECS.World.Remove
import Mischief.ECS.World.Utils

-- | Spawn an entity given a bundle of components.
spawn :: (HasCallStack, Bundle b) => b -> System Entity
spawn :: forall b. (HasCallStack, Bundle b) => b -> System Entity
spawn b
bundle =
  do
    world <- System World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
    entity <- liftIO $ getNewEntity world.entities

    spawnEntity entity bundle
    return entity

spawnDefer :: (Bundle b) => b -> ParSystem Entity
spawnDefer :: forall b. Bundle b => b -> ParSystem Entity
spawnDefer b
bundle = do
  world <- ParSystem World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  entity <- liftIO $ getNewEntity world.entities

  defer $ spawnEntity entity bundle
  return entity

data SpawnEventsSettings = WithSpawnEvents | WithoutSpawnEvents

spawnEntity :: (HasCallStack, Bundle b) => Entity -> b -> System ()
spawnEntity :: forall b. (HasCallStack, Bundle b) => Entity -> b -> System ()
spawnEntity Entity
entity b
bundle = do
  world <- System World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  let BundleData {elements} = addComponentToBundleData (Name (show entity)) $ bundleData bundle

  currentTick <- liftIO $ readIORef world.tick
  bundleD <- liftIO $ processBundleElements world ComponentTicks {changed = currentTick, added = currentTick} elements

  archetype <- getArchetypeOnSpawn $ map (\ProcessedBundleElement
x -> ProcessedBundleElement
x.id) bundleD.elements

  entityPointer <- liftIO $ newIORef $ EntityPointer (# 0#, 0# #)

  liftIO $ insertEntityIntoTables (ProcessedBundleData {elements = []}) world.tables (ArchetypeId 0) (entity, entityPointer)

  liftIO $ insertPointer entity entityPointer world.entities

  ChangeResult {requiredComponentsAdded} <- changeArchetype entity archetype (Just bundleD)

  unless world.prefs.supressEvents $ do
    triggerInsertEvent (ProcessedBundleData $ requiredComponentsAdded ++ bundleD.elements) entity

-- insertNew (Name (show entity)) entity

spawnEntityByInsert :: (Bundle b) => Entity -> b -> System ()
spawnEntityByInsert :: forall b. Bundle b => Entity -> b -> System ()
spawnEntityByInsert Entity
entity b
bundle = do
  world <- System World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld

  entityPointer <- liftIO $ newIORef $ EntityPointer (# 0#, 0# #)

  liftIO $ insertEntityIntoTables (ProcessedBundleData {elements = []}) world.tables (ArchetypeId 0) (entity, entityPointer)

  liftIO $ insertPointer entity entityPointer world.entities

  insert bundle entity

  insertNew (Name (show entity)) entity

spawnObserverOrdered :: forall e. (Event e) => Observer e -> Int -> System ()
spawnObserverOrdered :: forall e. Event e => Observer e -> Int -> System ()
spawnObserverOrdered Observer e
observer Int
order = do
  System Entity -> System ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (System Entity -> System ()) -> System Entity -> System ()
forall a b. (a -> b) -> a -> b
$ (Observer e, ObserverOrder) -> System Entity
forall b. (HasCallStack, Bundle b) => b -> System Entity
spawn (Observer e
observer, Int -> ObserverOrder
ObserverOrder Int
order)

spawnObserver :: forall e. (Event e) => Observer e -> System ()
spawnObserver :: forall e. Event e => Observer e -> System ()
spawnObserver Observer e
e = Observer e -> Int -> System ()
forall e. Event e => Observer e -> Int -> System ()
spawnObserverOrdered Observer e
e Int
0

-- | Spawn an entity given a bundle of components.
spawnIO :: (Bundle b) => World -> b -> IO Entity
spawnIO :: forall b. Bundle b => World -> b -> IO Entity
spawnIO World
world b
bundle =
  do
    entity <- IO Entity -> IO Entity
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Entity -> IO Entity) -> IO Entity -> IO Entity
forall a b. (a -> b) -> a -> b
$ Entities -> IO Entity
getNewEntity World
world.entities

    runSystem (spawnEntity entity bundle) world
    return entity

-- | Despawn an entity.
despawn :: Entity -> System ()
despawn :: Entity -> System ()
despawn Entity
entity =
  do
    world <- System World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
    pointer <- liftIO $ getPointer entity world.entities
    case pointer of
      Maybe (IORef EntityPointer)
Nothing -> Text -> System ()
forall w (m :: * -> *).
(HasCallStack, MonadSystem w m) =>
Text -> m ()
warn (Text -> System ()) -> Text -> System ()
forall a b. (a -> b) -> a -> b
$ Text
"Despawn failed: Entity " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Entity -> Text
forall a. Show a => a -> Text
text Entity
entity Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not alive."
      Just IORef EntityPointer
pointer -> do
        let Tables IOVec Table
tables = World
world.tables

        (EntityPointer (# archetypeId, _ #)) <- IO EntityPointer -> System EntityPointer
forall a. IO a -> System a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO EntityPointer -> System EntityPointer)
-> IO EntityPointer -> System EntityPointer
forall a b. (a -> b) -> a -> b
$ IORef EntityPointer -> IO EntityPointer
forall a. IORef a -> IO a
readIORef IORef EntityPointer
pointer

        table <- Vec.read tables (I# archetypeId)

        c <- liftIO $ collectComponentIdsFromTable table
        triggerRemoveEvent c entity

        (EntityPointer (# newArchetypeId, newRowIndex #)) <- liftIO $ readIORef pointer

        table <- Vec.read tables (I# newArchetypeId)
        void $ liftIO $ takeComponentsFromTable (EntityPointer (# newArchetypeId, newRowIndex #)) table
        liftIO $ removeEntity entity world.entities