module Mischief.ECS.Fixed where

import Control.Monad
import Data.Data
import Data.Default
import Data.Foldable
import Data.Function
import Data.Maybe
import Mischief.ECS.App
import Mischief.ECS.App.Plugins
import Mischief.ECS.App.Schedules
import Mischief.ECS.Components
import Mischief.ECS.Relationships.Order (Before (..), orderEntities)
import Mischief.ECS.Resources
import Mischief.ECS.Systems
import Mischief.ECS.Time (Time (Time), TimePlugin, TimeTag (..), TimeTypePref, ToTime)
import Mischief.ECS.Time qualified as Time
import Mischief.ECS.World
import Mischief.ECS.World.Insert
import Mischief.ECS.World.Query
import Mischief.ECS.World.Query.Markers
import Mischief.ECS.World.Query.QueryFilter
import System.Clock (TimeSpec)

-- | Resource determining the frequency at which Fixed schedules are ran. Defaults to @0.03@ (30fps).
newtype FixedFrequency = FixedFrequency Float deriving anyclass (Typeable FixedFrequency
[HookRel FixedFrequency]
[Hook FixedFrequency]
Set DefaultComponentType
IsExclusive (IsExclusiveRel FixedFrequency)
(Typeable FixedFrequency,
 IsExclusive (IsExclusiveRel FixedFrequency)) =>
Set DefaultComponentType
-> [Hook FixedFrequency]
-> [Hook FixedFrequency]
-> [Hook FixedFrequency]
-> [HookRel FixedFrequency]
-> [HookRel FixedFrequency]
-> [HookRel FixedFrequency]
-> Component FixedFrequency
forall c.
(Typeable c, IsExclusive (IsExclusiveRel c)) =>
Set DefaultComponentType
-> [Hook c]
-> [Hook c]
-> [Hook c]
-> [HookRel c]
-> [HookRel c]
-> [HookRel c]
-> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$conAdd :: [Hook FixedFrequency]
onAdd :: [Hook FixedFrequency]
$conSet :: [Hook FixedFrequency]
onSet :: [Hook FixedFrequency]
$conRemove :: [Hook FixedFrequency]
onRemove :: [Hook FixedFrequency]
$conAddRel :: [HookRel FixedFrequency]
onAddRel :: [HookRel FixedFrequency]
$conSetRel :: [HookRel FixedFrequency]
onSetRel :: [HookRel FixedFrequency]
$conRemoveRel :: [HookRel FixedFrequency]
onRemoveRel :: [HookRel FixedFrequency]
Component)

instance Default FixedFrequency where
  def :: FixedFrequency
def = Float -> FixedFrequency
FixedFrequency Float
0.033333333

data FixedFirst deriving (Typeable FixedFirst
Typeable FixedFirst => Schedule FixedFirst
forall {k} (s :: k). Typeable s => Schedule s
Schedule, Int -> FixedFirst -> ShowS
[FixedFirst] -> ShowS
FixedFirst -> String
(Int -> FixedFirst -> ShowS)
-> (FixedFirst -> String)
-> ([FixedFirst] -> ShowS)
-> Show FixedFirst
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FixedFirst -> ShowS
showsPrec :: Int -> FixedFirst -> ShowS
$cshow :: FixedFirst -> String
show :: FixedFirst -> String
$cshowList :: [FixedFirst] -> ShowS
showList :: [FixedFirst] -> ShowS
Show)

data FixedPreUpdate deriving (Typeable FixedPreUpdate
Typeable FixedPreUpdate => Schedule FixedPreUpdate
forall {k} (s :: k). Typeable s => Schedule s
Schedule, Int -> FixedPreUpdate -> ShowS
[FixedPreUpdate] -> ShowS
FixedPreUpdate -> String
(Int -> FixedPreUpdate -> ShowS)
-> (FixedPreUpdate -> String)
-> ([FixedPreUpdate] -> ShowS)
-> Show FixedPreUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FixedPreUpdate -> ShowS
showsPrec :: Int -> FixedPreUpdate -> ShowS
$cshow :: FixedPreUpdate -> String
show :: FixedPreUpdate -> String
$cshowList :: [FixedPreUpdate] -> ShowS
showList :: [FixedPreUpdate] -> ShowS
Show)

data FixedUpdate deriving (Typeable FixedUpdate
Typeable FixedUpdate => Schedule FixedUpdate
forall {k} (s :: k). Typeable s => Schedule s
Schedule, Int -> FixedUpdate -> ShowS
[FixedUpdate] -> ShowS
FixedUpdate -> String
(Int -> FixedUpdate -> ShowS)
-> (FixedUpdate -> String)
-> ([FixedUpdate] -> ShowS)
-> Show FixedUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FixedUpdate -> ShowS
showsPrec :: Int -> FixedUpdate -> ShowS
$cshow :: FixedUpdate -> String
show :: FixedUpdate -> String
$cshowList :: [FixedUpdate] -> ShowS
showList :: [FixedUpdate] -> ShowS
Show)

data FixedPostUpdate deriving (Typeable FixedPostUpdate
Typeable FixedPostUpdate => Schedule FixedPostUpdate
forall {k} (s :: k). Typeable s => Schedule s
Schedule, Int -> FixedPostUpdate -> ShowS
[FixedPostUpdate] -> ShowS
FixedPostUpdate -> String
(Int -> FixedPostUpdate -> ShowS)
-> (FixedPostUpdate -> String)
-> ([FixedPostUpdate] -> ShowS)
-> Show FixedPostUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FixedPostUpdate -> ShowS
showsPrec :: Int -> FixedPostUpdate -> ShowS
$cshow :: FixedPostUpdate -> String
show :: FixedPostUpdate -> String
$cshowList :: [FixedPostUpdate] -> ShowS
showList :: [FixedPostUpdate] -> ShowS
Show)

data FixedLast deriving (Typeable FixedLast
Typeable FixedLast => Schedule FixedLast
forall {k} (s :: k). Typeable s => Schedule s
Schedule, Int -> FixedLast -> ShowS
[FixedLast] -> ShowS
FixedLast -> String
(Int -> FixedLast -> ShowS)
-> (FixedLast -> String)
-> ([FixedLast] -> ShowS)
-> Show FixedLast
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FixedLast -> ShowS
showsPrec :: Int -> FixedLast -> ShowS
$cshow :: FixedLast -> String
show :: FixedLast -> String
$cshowList :: [FixedLast] -> ShowS
showList :: [FixedLast] -> ShowS
Show)

-- | Plugin that enables running systems in Fixed schedules such as 'FixedUpdate' and 'FixedPostUpdate'.
--
-- Overwrite the 'FixedFrequency' resource to change the frequency at which Fixed schedules are ran.
data FixedPlugin

instance Plugin FixedPlugin where
  init :: System ()
init = do
    first <- forall sch. Schedule sch => System Entity
forall {k} (sch :: k). Schedule sch => System Entity
scheduleEntity @FixedFirst
    pre <- scheduleEntity @FixedPreUpdate
    update <- scheduleEntity @FixedUpdate
    post <- scheduleEntity @FixedPostUpdate
    last <- scheduleEntity @FixedLast

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

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

    insertRes $ def @FixedFrequency
    insertRes $ FixedTime 0 0

    fixed <- scheduleEntity @Fixed
    last' <- scheduleEntity @Last
    post' <- scheduleEntity @PostUpdate

    insert UpdateSchedule fixed
    insert (Rel Before last') fixed
    insert (Rel Before fixed) post'

    systems runFixedLoop
      & schedule @Fixed

  deps :: [Dependency]
deps = [forall p. Plugin p => Dependency
dep @TimePlugin]

data Fixed deriving (Typeable Fixed
Typeable Fixed => Schedule Fixed
forall {k} (s :: k). Typeable s => Schedule s
Schedule)

data FixedTime = FixedTime
  { FixedTime -> TimeSpec
fixedElapsed :: TimeSpec,
    FixedTime -> TimeSpec
fixedDelta :: TimeSpec
  }
  deriving (Typeable FixedTime
[HookRel FixedTime]
[Hook FixedTime]
Set DefaultComponentType
IsExclusive (IsExclusiveRel FixedTime)
(Typeable FixedTime, IsExclusive (IsExclusiveRel FixedTime)) =>
Set DefaultComponentType
-> [Hook FixedTime]
-> [Hook FixedTime]
-> [Hook FixedTime]
-> [HookRel FixedTime]
-> [HookRel FixedTime]
-> [HookRel FixedTime]
-> Component FixedTime
forall c.
(Typeable c, IsExclusive (IsExclusiveRel c)) =>
Set DefaultComponentType
-> [Hook c]
-> [Hook c]
-> [Hook c]
-> [HookRel c]
-> [HookRel c]
-> [HookRel c]
-> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$conAdd :: [Hook FixedTime]
onAdd :: [Hook FixedTime]
$conSet :: [Hook FixedTime]
onSet :: [Hook FixedTime]
$conRemove :: [Hook FixedTime]
onRemove :: [Hook FixedTime]
$conAddRel :: [HookRel FixedTime]
onAddRel :: [HookRel FixedTime]
$conSetRel :: [HookRel FixedTime]
onSetRel :: [HookRel FixedTime]
$conRemoveRel :: [HookRel FixedTime]
onRemoveRel :: [HookRel FixedTime]
Component)

instance ToTime FixedTime where
  toTime :: FixedTime -> Time
toTime FixedTime {TimeSpec
fixedElapsed :: FixedTime -> TimeSpec
fixedElapsed :: TimeSpec
fixedElapsed, TimeSpec
fixedDelta :: FixedTime -> TimeSpec
fixedDelta :: TimeSpec
fixedDelta} = Time {elapsed :: TimeSpec
elapsed = TimeSpec
fixedElapsed, delta :: TimeSpec
delta = TimeSpec
fixedDelta}

newtype FixedExtra = FixedExtra Float deriving anyclass (Typeable FixedExtra
[HookRel FixedExtra]
[Hook FixedExtra]
Set DefaultComponentType
IsExclusive (IsExclusiveRel FixedExtra)
(Typeable FixedExtra, IsExclusive (IsExclusiveRel FixedExtra)) =>
Set DefaultComponentType
-> [Hook FixedExtra]
-> [Hook FixedExtra]
-> [Hook FixedExtra]
-> [HookRel FixedExtra]
-> [HookRel FixedExtra]
-> [HookRel FixedExtra]
-> Component FixedExtra
forall c.
(Typeable c, IsExclusive (IsExclusiveRel c)) =>
Set DefaultComponentType
-> [Hook c]
-> [Hook c]
-> [Hook c]
-> [HookRel c]
-> [HookRel c]
-> [HookRel c]
-> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$conAdd :: [Hook FixedExtra]
onAdd :: [Hook FixedExtra]
$conSet :: [Hook FixedExtra]
onSet :: [Hook FixedExtra]
$conRemove :: [Hook FixedExtra]
onRemove :: [Hook FixedExtra]
$conAddRel :: [HookRel FixedExtra]
onAddRel :: [HookRel FixedExtra]
$conSetRel :: [HookRel FixedExtra]
onSetRel :: [HookRel FixedExtra]
$conRemoveRel :: [HookRel FixedExtra]
onRemoveRel :: [HookRel FixedExtra]
Component)

runFixedLoop :: System ()
runFixedLoop :: System ()
runFixedLoop = do
  FixedExtra extra <- FixedExtra -> Maybe FixedExtra -> FixedExtra
forall a. a -> Maybe a -> a
fromMaybe (Float -> FixedExtra
FixedExtra Float
0) (Maybe FixedExtra -> FixedExtra)
-> System (Maybe FixedExtra) -> System FixedExtra
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall c (m :: * -> *) w.
(MonadSystem w m, Component c) =>
m (Maybe c)
res @FixedExtra)
  delta <- Time.delta
  Just (FixedFrequency freq) <- res @FixedFrequency

  let extra' = Float
extra Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
delta
  let runs :: Int = floor $ extra' / freq

  schedules <- orderEntities =<< query (mkQuery' E (With (C @FixedSchedule)))

  setPref @TimeTypePref (TimeTag $ Proxy @FixedTime) $ do
    modifyRes' (\FixedTime {TimeSpec
fixedElapsed :: FixedTime -> TimeSpec
fixedElapsed :: TimeSpec
fixedElapsed} -> FixedTime {TimeSpec
fixedElapsed :: TimeSpec
fixedElapsed :: TimeSpec
fixedElapsed, fixedDelta :: TimeSpec
fixedDelta = Float -> TimeSpec
Time.secsToSpec Float
freq})

    replicateM_ runs $ do
      for_ schedules runSchedule'
      modifyRes' (\FixedTime {TimeSpec
fixedElapsed :: FixedTime -> TimeSpec
fixedElapsed :: TimeSpec
fixedElapsed, TimeSpec
fixedDelta :: FixedTime -> TimeSpec
fixedDelta :: TimeSpec
fixedDelta} -> FixedTime {fixedElapsed :: TimeSpec
fixedElapsed = TimeSpec
fixedElapsed TimeSpec -> TimeSpec -> TimeSpec
forall a. Num a => a -> a -> a
+ TimeSpec
fixedDelta, TimeSpec
fixedDelta :: TimeSpec
fixedDelta :: TimeSpec
fixedDelta})

  insertRes $ FixedExtra $ extra' - (fromIntegral runs * freq)