{-# LANGUAGE AllowAmbiguousTypes #-}

module Mischief.ECS.App where

-- import Data.Map
-- import Data.Map qualified as Map

import Control.Monad (forever, void)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Reader (MonadReader (..), asks)
import Control.Monad.Trans.Reader (ReaderT (..))
import Data.Data
import Data.Default
import Data.Foldable
import Data.IORef
import Mischief.ECS.App.Plugins
import Mischief.ECS.App.Schedules
import Mischief.ECS.App.SystemConfig hiding (Before)
import Mischief.ECS.App.SystemDef
import Mischief.ECS.App.Systems (ScheduledIn (ScheduledIn), SystemFunction (SystemFunction), Systems, systemEntity)
import Mischief.ECS.App.Systems qualified as Systems
import Mischief.ECS.Components
import Mischief.ECS.Components.Bundle
import Mischief.ECS.Components.Runnable (Runnable, runFor)
import Mischief.ECS.Components.Spawn (getOrAddComponentId, meta)
import Mischief.ECS.Entities
import Mischief.ECS.Events
import Mischief.ECS.Hidden
import Mischief.ECS.Log
import Mischief.ECS.Mappable
import Mischief.ECS.Relationships.Order
import Mischief.ECS.Resources
import Mischief.ECS.Systems qualified as Systems
import Mischief.ECS.Tables
import Mischief.ECS.World
import Mischief.ECS.World.Defer
import Mischief.ECS.World.Insert
import Mischief.ECS.World.Query
import Mischief.ECS.World.Query.QueryFilter
import Mischief.ECS.World.Query.QueryType
import Mischief.ECS.World.Query.Queryable
import Mischief.ECS.World.Spawn

data App = App
  { App -> World
world :: World,
    App -> Systems
systems :: Systems
  }

newApp :: (Plugin p) => p -> IO App
newApp :: forall p. Plugin p => p -> IO App
newApp p
plugin = do
  world <- SystemTools -> IO World
newWorld SystemTools
getTools
  systems <- Systems.newSystems

  let app = App {World
world :: World
world :: World
world, Systems
systems :: Systems
systems :: Systems
systems}

  runSystem appInit app.world
  runSystem (Systems.add Init $ runPluginRec plugin) app.world

  return app

runApp :: App -> IO ()
runApp :: App -> IO ()
runApp App
app = (System () -> World -> IO ()) -> World -> System () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip System () -> World -> IO ()
forall a. System a -> World -> IO a
runSystem App
app.world (System () -> IO ()) -> System () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  startups <- [Entity] -> System [Entity]
orderEntities ([Entity] -> System [Entity]) -> System [Entity] -> System [Entity]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< E -> With (C StartupSchedule) -> System [Entity]
forall qd (m :: * -> *) w out qf.
(Queryable qd out, MonadSystem w m, Collectable qf QueryFilter) =>
qd -> qf -> m [out]
query' E
E (C StartupSchedule -> With (C StartupSchedule)
forall c. c -> With c
With (forall a. C a
forall {k} (a :: k). C a
C @StartupSchedule))
  updates <- orderEntities =<< query' E (With (C @UpdateSchedule))

  liftIO $ runSchedules startups
  liftIO $ runSchedulesLoop updates
  where
    runSchedulesLoop :: [Entity] -> IO ()
runSchedulesLoop [Entity]
schedules = do
      IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        [Entity] -> IO ()
runSchedules [Entity]
schedules
        IORef Frame -> (Frame -> Frame) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' App
app.world.frame (\(Frame Int
x) -> Int -> Frame
Frame (Int -> Frame) -> Int -> Frame
forall a b. (a -> b) -> a -> b
$ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

    runSchedules :: [Entity] -> IO ()
runSchedules [Entity]
schedules =
      [Entity] -> (Entity -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Entity]
schedules ((Entity -> IO ()) -> IO ()) -> (Entity -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Entity
schedule -> do
        System () -> World -> IO ()
forall a. System a -> World -> IO a
runSystem (Entity -> System ()
runSchedule' Entity
schedule) App
app.world

runSchedule :: (Schedule sch) => sch -> System ()
runSchedule :: forall sch. Schedule sch => sch -> System ()
runSchedule sch
sch = sch -> System Entity
forall sch. Schedule sch => sch -> System Entity
scheduleEntity sch
sch System Entity -> (Entity -> System ()) -> System ()
forall a b. System a -> (a -> System b) -> System b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Entity -> System ()
runSchedule'

runSchedule' :: Entity -> System ()
runSchedule' :: Entity -> System ()
runSchedule' Entity
schedule = do
  world <- System World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  systems <- orderEntities =<< query' E (With (R @ScheduledIn schedule))

  for_ systems $ \Entity
systemId -> do
    Just (systemFunction, lastSystemTick) <- (C SystemFunction, C SystemTick)
-> Entity
-> System (Maybe (Result SystemFunction, Result SystemTick))
forall qd (m :: * -> *) w out.
(Queryable qd out, MonadSystem w m) =>
qd -> Entity -> m (Maybe out)
get (forall a. C a
forall {k} (a :: k). C a
C @SystemFunction, forall a. C a
forall {k} (a :: k). C a
C @SystemTick) Entity
systemId
    currentSystemTick <- liftIO $ readIORef world.tick

    set lastSystemTick (SystemTick currentSystemTick)
    insert (LastSystemTick lastSystemTick.inner) systemId

    Control.Monad.Reader.local (hide . setSystemId (SystemId systemId) . unhide) $ do
      systemFunction.inner
      flush
      flushAsync
      flushEvents
      tick

appInit :: System ()
appInit :: System ()
appInit = do
  Schedules -> System ()
forall r. (Component r, Bundle r) => r -> System ()
insertRes (Schedules -> System ()) -> Schedules -> System ()
forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def @Schedules

  systems <- IO Systems -> System Systems
forall a. IO a -> System a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Systems
Systems.newSystems
  insertRes systems

  init <- scheduleEntity Init
  pre <- scheduleEntity PreStartup
  startup <- scheduleEntity Startup
  post <- scheduleEntity PostStartup

  for_ [init, pre, startup, post] $ insert StartupSchedule

  insert (Rel Before pre) init
  insert (Rel Before startup) pre
  insert (Rel Before post) startup

  first <- scheduleEntity First
  pre <- scheduleEntity PreUpdate
  update <- scheduleEntity Update
  post <- scheduleEntity PostUpdate

  for_ [first, pre, update, post] $ insert UpdateSchedule

  insert (Rel Before pre) first
  insert (Rel Before update) pre
  insert (Rel Before post) update

register :: forall c. (Runnable c) => System ()
register :: forall {k} (c :: k). Runnable c => System ()
register = forall (c :: k).
Runnable c =>
(forall d. (Component d, Bundle d) => Proxy d -> System ())
-> System ()
forall {k} (c :: k).
Runnable c =>
(forall d. (Component d, Bundle d) => Proxy d -> System ())
-> System ()
runFor @c Proxy d -> System ()
forall c. Component c => Proxy c -> System ()
forall d. (Component d, Bundle d) => Proxy d -> System ()
registerComponent

registerComponent :: forall c. (Component c) => Proxy c -> System ()
registerComponent :: forall c. Component c => Proxy c -> System ()
registerComponent Proxy c
c = do
  _ <- ComponentType -> System ComponentId
getOrAddComponentId (Proxy c -> ComponentType
forall c. Component c => Proxy c -> ComponentType
ComponentType Proxy c
c)
  return ()

getTools :: SystemTools
getTools :: SystemTools
getTools =
  SystemTools
    { get :: forall c (m :: * -> *) w.
(MonadSystem w m, QueryType c) =>
Proxy c -> Entity -> m (Maybe c)
get = Proxy c -> Entity -> m (Maybe c)
forall c (m :: * -> *) w.
(MonadSystem w m, QueryType c) =>
Proxy c -> Entity -> m (Maybe c)
toolsGet,
      getRAny :: forall c (m :: * -> *) w.
(Component c, MonadSystem w m, RelExclusivity c ~ 'Inclusive) =>
Proxy c -> Entity -> m (Maybe [Rel c])
getRAny = Proxy c -> Entity -> m (Maybe [Rel c])
forall c (m :: * -> *) w.
(Component c, MonadSystem w m, RelExclusivity c ~ 'Inclusive) =>
Proxy c -> Entity -> m (Maybe [Rel c])
toolsGetRAny,
      set :: forall b. Bundle b => b -> Entity -> System ()
set = c -> Entity -> System ()
forall b. Bundle b => b -> Entity -> System ()
toolsSet,
      spawnByInsert :: forall b. Bundle b => Entity -> b -> System ()
spawnByInsert = Entity -> b -> System ()
forall b. Bundle b => Entity -> b -> System ()
toolsSpawnByInsert
    }

toolsGet :: forall c m w. (MonadSystem w m, QueryType c) => Proxy c -> Entity -> m (Maybe c)
toolsGet :: forall c (m :: * -> *) w.
(MonadSystem w m, QueryType c) =>
Proxy c -> Entity -> m (Maybe c)
toolsGet Proxy c
_ = Val (C c) -> Entity -> m (Maybe c)
forall qd (m :: * -> *) w out.
(Queryable qd out, MonadSystem w m) =>
qd -> Entity -> m (Maybe out)
get (C c -> Val (C c)
forall a. a -> Val a
Val (forall a. C a
forall {k} (a :: k). C a
C @c))

toolsSet :: forall c. (Bundle c) => c -> Entity -> System ()
toolsSet :: forall b. Bundle b => b -> Entity -> System ()
toolsSet = c -> Entity -> System ()
forall b. (HasCallStack, Bundle b) => b -> Entity -> System ()
forall b. Bundle b => b -> Entity -> System ()
insert

toolsGetRAny :: forall c m w. (Component c, MonadSystem w m, RelExclusivity c ~ Inclusive) => Proxy c -> Entity -> m (Maybe [Rel c])
toolsGetRAny :: forall c (m :: * -> *) w.
(Component c, MonadSystem w m, RelExclusivity c ~ 'Inclusive) =>
Proxy c -> Entity -> m (Maybe [Rel c])
toolsGetRAny Proxy c
_ = Val (R c Any) -> Entity -> m (Maybe [Rel c])
forall qd (m :: * -> *) w out.
(Queryable qd out, MonadSystem w m) =>
qd -> Entity -> m (Maybe out)
get (R c Any -> Val (R c Any)
forall a. a -> Val a
Val (forall {k} (a :: k) b. b -> R a b
forall a b. b -> R a b
R @c Any
Any))

toolsSpawnByInsert :: forall b. (Bundle b) => Entity -> b -> System ()
toolsSpawnByInsert :: forall b. Bundle b => Entity -> b -> System ()
toolsSpawnByInsert = Entity -> b -> System ()
forall b. Bundle b => Entity -> b -> System ()
spawnEntityByInsert

incTick :: Tick -> Maybe Tick
incTick :: Tick -> Maybe Tick
incTick (Tick (Int
a, Int
b)) | Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
maxBound Bool -> Bool -> Bool
&& Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
maxBound = Maybe Tick
forall a. Maybe a
Nothing
incTick (Tick (Int
a, Int
b)) | Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
maxBound = Tick -> Maybe Tick
forall a. a -> Maybe a
Just (Tick -> Maybe Tick) -> Tick -> Maybe Tick
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Tick
Tick (Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
0)
incTick (Tick (Int
a, Int
b)) = Tick -> Maybe Tick
forall a. a -> Maybe a
Just (Tick -> Maybe Tick) -> Tick -> Maybe Tick
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Tick
Tick (Int
a, Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- | Increment the World's Tick.
tick :: System ()
tick :: System ()
tick = do
  world <- System World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  tick <- liftIO $ incTick <$> readIORef world.tick
  case tick of
    Maybe Tick
Nothing -> do
      Text -> System ()
forall w (m :: * -> *).
(HasCallStack, MonadSystem w m) =>
Text -> m ()
warn Text
"Reached maximum Tick. Resetting count. Previous changed will not be detected."
      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 Tick -> Tick -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef World
world.tick (Tick -> IO ()) -> Tick -> IO ()
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Tick
Tick (Int
0, Int
0)
    Just Tick
t -> 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 Tick -> Tick -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef World
world.tick Tick
t