module Mischief.ECS.World.Spawn where

import Control.Monad
import Control.Monad.IO.Class
import Data.Foldable
import Data.IORef
import Data.Maybe
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.Log
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.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
    pure 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
  pure 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 = !elements, resources = !resources, external = !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 elements

  !archetype <- getArchetypeOnSpawn $ map (.id) bundleD.elements

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

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

  liftIO $ insertPointer entity entityPointer world.entities

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

  !supressEvents <- fromMaybe False <$> getPref @SupressEventsPref

  unless 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# #)

  !currentTick <- liftIO $ readIORef world.tick
  liftIO $ insertEntityIntoTables (ProcessedBundleData {elements = []}) currentTick [] world.tables (ArchetypeId 0) (entity, entityPointer)
  liftIO $ insertPointer entity entityPointer world.entities
  insert bundle entity

  insertNew (Name (show entity)) entity

-- | 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
    pure 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