module Mischief.ECS.World.Spawn where

import Control.Monad
import Control.Monad.IO.Class
import Data.Foldable
import Data.IORef
import Data.Text qualified as T
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.Components.Spawn
import Mischief.ECS.Entities
import Mischief.ECS.EventDef
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

-- | Same as 'spawn' but discards the returned entity.
spawn_ :: (HasCallStack, Bundle b) => b -> System ()
spawn_ :: forall b. (HasCallStack, Bundle b) => b -> System ()
spawn_ = System Entity -> System ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (System Entity -> System ())
-> (b -> System Entity) -> b -> System ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> System Entity
forall b. (HasCallStack, Bundle b) => b -> System Entity
spawn

-- | Spawn an entity given a bundle of components, inside a @ParSystem@.
--
-- This will immediately reserve and return an Entity index which can be used, while defering
-- the actual spawn.
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

-- | Spawn an Entity given an existing, reserved id. This is not meant for general use.
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, resources, external} = addComponentToBundleData (Name (show entity)) $ bundleData bundle

  for_ external $ \(Entity
e, BundleData ErasedComponent
s) -> do
    forall b. (HasCallStack, Bundle b) => b -> Entity -> System ()
BundleData ErasedComponent -> Entity -> System ()
forall b. Bundle b => b -> Entity -> System ()
insert BundleData ErasedComponent
s Entity
e

  for_ resources $ \BundleElement {component :: forall e. BundleElement e -> e
component = ErasedComponent (c
val :: c)} -> do
    m <- forall c. Component c => System Entity
meta @c
    insert val m

  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
    let d = [ProcessedBundleElement] -> ProcessedBundleData
ProcessedBundleData ([ProcessedBundleElement] -> ProcessedBundleData)
-> [ProcessedBundleElement] -> ProcessedBundleData
forall a b. (a -> b) -> a -> b
$ [ProcessedBundleElement]
requiredComponentsAdded [ProcessedBundleElement]
-> [ProcessedBundleElement] -> [ProcessedBundleElement]
forall a. [a] -> [a] -> [a]
++ ProcessedBundleData
bundleD.elements
    triggerAddEvent d entity
    triggerSetEvent d entity

-- Spawn an entity as having no components and then immediately insert a bundle on it. Useful for certain engine internals, should be avoided.
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, in IO.
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. This will trigger the @OnRemove@ events and hooks on all its components.
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
T.show 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