Time.hs

module Mischief.ECS.Time where

import Control.Monad.IO.Class
import Data.Data
import Data.Function ((&))
import Data.Vector.Internal.Check (HasCallStack)
import Mischief.ECS.App.Plugins
import Mischief.ECS.App.Schedules
import Mischief.ECS.Components
import Mischief.ECS.Resources
import Mischief.ECS.Systems
import Mischief.ECS.Utils
import Mischief.ECS.World
import Mischief.ECS.World.Query
import Mischief.ECS.World.Query.Pipe
import System.Clock

class ToTime t where
  toTime :: t -> Time

data Time = Time
  { delta :: TimeSpec,
    elapsed :: TimeSpec
  }

data VirtualTime = VirtualTime
  { virtualDelta :: TimeSpec,
    virtualElapsed :: TimeSpec
  }
  deriving (Show, Component)

data TimeTypePref

instance PrefType TimeTypePref TimeTag

instance ToTime VirtualTime where
  toTime v = Time {delta = v.virtualDelta, elapsed = v.virtualElapsed}

data TimeTag where
  TimeTag :: (Component t, ToTime t) => Proxy t -> TimeTag

time :: (HasCallStack) => (MonadSystem w m) => m Time
time = do
  pref <- getPref @TimeTypePref
  case pref of
    Nothing -> toTime . unwrap <$> res @VirtualTime
    Just (TimeTag (_ :: Proxy t)) -> toTime . unwrap <$> res @t

timeMaybe :: (MonadSystem w m) => m (Maybe Time)
timeMaybe = do
  pref <- getPref @TimeTypePref
  case pref of
    Nothing -> fmap toTime <$> res @VirtualTime
    Just (TimeTag (_ :: Proxy t)) -> fmap toTime <$> res @t

qtime :: (MonadSystem w m) => Query m Time
qtime = pure () & qtraverse (\_ _ -> time)

delta :: (HasCallStack) => (MonadSystem w m) => m Float
delta = do
  time <- time
  pure $ specToSecs time.delta

qdelta :: (MonadSystem w m) => Query m Float
qdelta = pure () & qtraverse (\_ _ -> delta)

elapsed :: (HasCallStack) => (MonadSystem w m) => m Float
elapsed = do
  time <- time
  pure $ specToSecs time.elapsed

qelapsed :: (MonadSystem w m) => Query m Float
qelapsed = pure () & qtraverse (\_ _ -> elapsed)

specToSecs :: TimeSpec -> Float
specToSecs a = fromIntegral a.sec + fromIntegral a.nsec / 1000000000

secsToSpec :: Float -> TimeSpec
secsToSpec s =
  let secs = floor s
   in TimeSpec secs $ floor ((s - fromIntegral secs) * 1000000000)

-- | Plugin that keeps track of time. Enables calling 'delta', 'elapsed', and so on.
--
-- Note that these methods are context-dependent. For instance, if used in a Fixed schedule, 'delta' will always return the time as inferred from the fixed frequency.
data TimePlugin

instance Plugin TimePlugin where
  init = do
    currentTime <- liftIO $ getTime Monotonic
    insertRes $ VirtualTime {virtualDelta = TimeSpec {sec = 0, nsec = 0}, virtualElapsed = currentTime}
    schedule @First (systems updateTime)

updateTime :: System ()
updateTime = do
  Just time <- res @VirtualTime
  currentTime <- liftIO $ getTime Monotonic
  insertRes VirtualTime {virtualDelta = currentTime - time.virtualElapsed, virtualElapsed = currentTime}