module Mischief.ECS.World.Change where

import Control.Monad.Reader (MonadIO (liftIO))
import Data.Foldable
import Data.IORef
import Data.Maybe
import Data.Set qualified as Set
import GHC.Base (Int (..))
import GHC.Stack (HasCallStack)
import Mischief.ECS.App.SystemDef
import Mischief.ECS.Archetypes
import Mischief.ECS.Components
import Mischief.ECS.Components.Bundle
import Mischief.ECS.Entities
import Mischief.ECS.Tables
import Mischief.ECS.Vec qualified as Vec
import Mischief.ECS.World
import Mischief.ECS.World.Query
import Mischief.ECS.World.Query.Markers
import Mischief.ECS.World.Utils

data ChangeResult = ChangeResult
  { ChangeResult -> [ProcessedBundleElement]
requiredComponentsAdded :: [ProcessedBundleElement],
    ChangeResult -> [ProcessedBundleElement]
newComponents :: [ProcessedBundleElement]
  }

changeArchetype :: (HasCallStack) => Entity -> ArchetypeData -> Maybe ProcessedBundleData -> System ChangeResult
changeArchetype :: HasCallStack =>
Entity
-> ArchetypeData
-> Maybe ProcessedBundleData
-> System ChangeResult
changeArchetype Entity
entity ArchetypeData
newArchetype Maybe ProcessedBundleData
insertedBundle = do
  world <- System World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  currentTick <- liftIO $ readIORef world.tick

  reqAdded <- liftIO $ newIORef []
  newAdded <- liftIO $ newIORef []

  Just pointer <- liftIO $ getPointer entity world.entities
  (EntityPointer (# archetypeId', rowIndex' #)) <- liftIO $ readIORef pointer

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

  collected <- liftIO $ takeComponentsFromTable (EntityPointer (# archetypeId', rowIndex' #)) table

  -- TODO OPT: this whole thing can be greatly optimized
  newElements'' <-
    mapM
      ( \ComponentId
component -> do
          case Maybe ProcessedBundleData
insertedBundle of
            Maybe ProcessedBundleData
Nothing -> System ProcessedBundleElement
-> (ProcessedBundleElement -> System ProcessedBundleElement)
-> Maybe ProcessedBundleElement
-> System ProcessedBundleElement
forall b a. b -> (a -> b) -> Maybe a -> b
maybe System ProcessedBundleElement
forall a. HasCallStack => a
undefined ProcessedBundleElement -> System ProcessedBundleElement
forall a. a -> System a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ProcessedBundleElement -> Bool)
-> [ProcessedBundleElement] -> Maybe ProcessedBundleElement
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\ProcessedBundleElement
x -> ProcessedBundleElement
x.id ComponentId -> ComponentId -> Bool
forall a. Eq a => a -> a -> Bool
== ComponentId
component) ProcessedBundleData
collected.elements)
            Just ProcessedBundleData
bundle ->
              case (ProcessedBundleElement -> Bool)
-> [ProcessedBundleElement] -> Maybe ProcessedBundleElement
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\ProcessedBundleElement
x -> ProcessedBundleElement
x.id ComponentId -> ComponentId -> Bool
forall a. Eq a => a -> a -> Bool
== ComponentId
component) ProcessedBundleData
bundle.elements of
                Just ProcessedBundleElement
x -> do
                  case (ProcessedBundleElement -> Bool)
-> [ProcessedBundleElement] -> Maybe ProcessedBundleElement
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\ProcessedBundleElement
x -> ProcessedBundleElement
x.id ComponentId -> ComponentId -> Bool
forall a. Eq a => a -> a -> Bool
== ComponentId
component) ProcessedBundleData
collected.elements of
                    Maybe ProcessedBundleElement
Nothing -> do
                      IO () -> System ()
forall a. IO a -> System a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> System ()) -> IO () -> System ()
forall a b. (a -> b) -> a -> b
$ IORef [ProcessedBundleElement]
-> ([ProcessedBundleElement] -> [ProcessedBundleElement]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef [ProcessedBundleElement]
newAdded ([ProcessedBundleElement]
-> [ProcessedBundleElement] -> [ProcessedBundleElement]
forall a. [a] -> [a] -> [a]
++ [ProcessedBundleElement
x])
                    Just ProcessedBundleElement
_ -> () -> System ()
forall a. a -> System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                  ProcessedBundleElement -> System ProcessedBundleElement
forall a. a -> System a
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessedBundleElement
x
                Maybe ProcessedBundleElement
Nothing ->
                  case (ProcessedBundleElement -> Bool)
-> [ProcessedBundleElement] -> Maybe ProcessedBundleElement
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\ProcessedBundleElement
x -> ProcessedBundleElement
x.id ComponentId -> ComponentId -> Bool
forall a. Eq a => a -> a -> Bool
== ComponentId
component) ProcessedBundleData
collected.elements of
                    Just ProcessedBundleElement
x -> ProcessedBundleElement -> System ProcessedBundleElement
forall a. a -> System a
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessedBundleElement
x
                    Maybe ProcessedBundleElement
Nothing -> do
                      r <- ComponentId -> System ProcessedBundleElement
getDefault ComponentId
component
                      liftIO $ modifyIORef' reqAdded (++ [r])
                      return r
      )
      $ Set.toList newArchetype.components

  let newElements = case Maybe ProcessedBundleData
insertedBundle of
        Maybe ProcessedBundleData
Nothing -> [ProcessedBundleElement] -> ProcessedBundleData
ProcessedBundleData [ProcessedBundleElement]
newElements''
        Just ProcessedBundleData
bundle ->
          let newElements' :: ProcessedBundleData
newElements' = ProcessedBundleData
-> (ComponentId -> Bool) -> Tick -> ProcessedBundleData
setChangedTickOfComponents ([ProcessedBundleElement] -> ProcessedBundleData
ProcessedBundleData [ProcessedBundleElement]
newElements'') (\ComponentId
id -> ProcessedBundleData -> ComponentId -> Bool
isInProcessedBundle ProcessedBundleData
bundle ComponentId
id Bool -> Bool -> Bool
&& ProcessedBundleData -> ComponentId -> Bool
isInProcessedBundle ProcessedBundleData
collected ComponentId
id) Tick
currentTick
           in ProcessedBundleData
-> (ComponentId -> Bool) -> Tick -> ProcessedBundleData
setAddedTickOfComponents ProcessedBundleData
newElements' (\ComponentId
id -> ProcessedBundleData -> ComponentId -> Bool
isInProcessedBundle ProcessedBundleData
bundle ComponentId
id Bool -> Bool -> Bool
&& Bool -> Bool
not (ProcessedBundleData -> ComponentId -> Bool
isInProcessedBundle ProcessedBundleData
collected ComponentId
id)) Tick
currentTick

  liftIO $ insertEntityIntoTables newElements world.tables newArchetype.id (entity, pointer)

  requiredComponentsAdded <- liftIO $ readIORef reqAdded
  newComponents <- liftIO $ readIORef newAdded
  return ChangeResult {requiredComponentsAdded, newComponents}

getDefault :: ComponentId -> System ProcessedBundleElement
getDefault :: ComponentId -> System ProcessedBundleElement
getDefault (ComponentId (# Word#
id, Maybe Entity
e #)) = do
  world <- System World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld

  Just x <- single $ mkGet (Entity (# id, 0## #)) (C @DefaultValue)
  let dv = DefaultValue
x
  let (DefaultValue value) = dv

  let (SystemId sys) = world.systemId
  currentSystemTick <- fromMaybe (SystemTick $ Tick (0, 0)) <$> single (mkGet sys (C @SystemTick))

  return
    ProcessedBundleElement
      { id = ComponentId (# id, e #),
        component =
          ComponentData
            { value,
              ticks = ComponentTicks {changed = currentSystemTick.inner, added = currentSystemTick.inner}
            }
      }