{-# 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 (..))
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.SystemDef
import Mischief.ECS.App.Systems (ScheduledIn, SystemFunction, Systems)
import Mischief.ECS.App.Systems qualified as Systems
import Mischief.ECS.Components
import Mischief.ECS.Components.Bundle
import Mischief.ECS.Components.Spawn (getOrAddComponentId)
import Mischief.ECS.Entities
import Mischief.ECS.Events
import Mischief.ECS.Hidden
import Mischief.ECS.Log
import Mischief.ECS.Relationships.Order
import Mischief.ECS.Resources
import Mischief.ECS.World
import Mischief.ECS.World.Defer
import Mischief.ECS.World.Insert
import Mischief.ECS.World.Query
import Mischief.ECS.World.Query.Markers
import Mischief.ECS.World.Query.QueryFilter
import Mischief.ECS.World.Spawn

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

newApp :: IO App
newApp :: IO App
newApp = do
  world <- SystemTools -> IO World
newWorld SystemTools
getTools
  runSystem (spawnEntity (Entity (# 0##, 0## #)) ()) world

  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

addPlugin :: forall p. (Plugin p) => App -> IO ()
addPlugin :: forall p. Plugin p => App -> IO ()
addPlugin App
app = System () -> World -> IO ()
forall a. System a -> World -> IO a
runSystem (forall p. Plugin p => System ()
addPluginRec @p) App
app.world

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
  x <- forall sch. Schedule sch => System Entity
forall {k} (sch :: k). Schedule sch => System Entity
scheduleEntity @Init
  liftIO $ runSchedules [x]

  startups <- orderEntities =<< query (mkQuery' E (With (C @StartupSchedule)))
  updates <- orderEntities =<< query (mkQuery' 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 :: forall sch. (Schedule sch) => System ()
runSchedule :: forall {k} (sch :: k). Schedule sch => System ()
runSchedule = forall (sch :: k). Schedule sch => System Entity
forall {k} (sch :: k). Schedule sch => System Entity
scheduleEntity @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 (mkQuery' E (With (R @ScheduledIn schedule)))

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

    insert (SystemTick currentSystemTick) systemId
    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

  pre <- scheduleEntity @PreStartup
  startup <- scheduleEntity @Startup
  post <- scheduleEntity @PostStartup

  for_ [pre, startup, post] $ insert StartupSchedule

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

  first <- scheduleEntity @First
  pre <- scheduleEntity @PreUpdate
  update <- scheduleEntity @Update
  post <- scheduleEntity @PostUpdate
  last <- scheduleEntity @Last

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

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

register :: forall c. (Component c) => System ()
register :: forall c. Component c => System ()
register = Proxy c -> System ()
forall c. Component c => Proxy c -> System ()
registerComponent (Proxy c -> System ()) -> Proxy c -> System ()
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c

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, Component c) =>
Proxy c -> Entity -> m (Maybe c)
get = Proxy c -> Entity -> m (Maybe c)
forall c (m :: * -> *) w.
(MonadSystem w m, Component c) =>
Proxy c -> Entity -> m (Maybe c)
toolsGet,
      getRAny :: forall c (m :: * -> *) w.
(Component c, MonadSystem w m, IsExclusiveRel c ~ 'False) =>
Proxy c -> Entity -> m (Maybe [Rel c])
getRAny = Proxy c -> Entity -> m (Maybe [Rel c])
forall c (m :: * -> *) w.
(Component c, MonadSystem w m, IsExclusiveRel c ~ 'False) =>
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, Component c) => Proxy c -> Entity -> m (Maybe c)
toolsGet :: forall c (m :: * -> *) w.
(MonadSystem w m, Component c) =>
Proxy c -> Entity -> m (Maybe c)
toolsGet Proxy c
_ Entity
e = Query m c -> m (Maybe c)
forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m (Maybe out)
single (Query m c -> m (Maybe c)) -> Query m c -> m (Maybe c)
forall a b. (a -> b) -> a -> b
$ Entity -> C c -> Query m c
forall qd out (m :: * -> *).
Queryable qd out =>
Entity -> qd -> Query m out
mkGet Entity
e (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, IsExclusiveRel c ~ False) => Proxy c -> Entity -> m (Maybe [Rel c])
toolsGetRAny :: forall c (m :: * -> *) w.
(Component c, MonadSystem w m, IsExclusiveRel c ~ 'False) =>
Proxy c -> Entity -> m (Maybe [Rel c])
toolsGetRAny Proxy c
_ Entity
e = Query m [Rel c] -> m (Maybe [Rel c])
forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m (Maybe out)
single (Query m [Rel c] -> m (Maybe [Rel c]))
-> Query m [Rel c] -> m (Maybe [Rel c])
forall a b. (a -> b) -> a -> b
$ Entity -> R c Any -> Query m [Rel c]
forall qd out (m :: * -> *).
Queryable qd out =>
Entity -> qd -> Query m out
mkGet Entity
e (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