module Mischief.ECS.Time where

import Control.Monad.IO.Class
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 System.Clock

class ToTime t where
  toTime :: t -> Time

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

data VirtualTime = VirtualTime
  { VirtualTime -> TimeSpec
virtualDelta :: TimeSpec,
    VirtualTime -> TimeSpec
virtualElapsed :: TimeSpec
  }
  deriving (Int -> VirtualTime -> ShowS
[VirtualTime] -> ShowS
VirtualTime -> String
(Int -> VirtualTime -> ShowS)
-> (VirtualTime -> String)
-> ([VirtualTime] -> ShowS)
-> Show VirtualTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VirtualTime -> ShowS
showsPrec :: Int -> VirtualTime -> ShowS
$cshow :: VirtualTime -> String
show :: VirtualTime -> String
$cshowList :: [VirtualTime] -> ShowS
showList :: [VirtualTime] -> ShowS
Show, Typeable VirtualTime
[HookRel VirtualTime]
[Hook VirtualTime]
Set DefaultComponentType
IsExclusive (IsExclusiveRel VirtualTime)
(Typeable VirtualTime, IsExclusive (IsExclusiveRel VirtualTime)) =>
Set DefaultComponentType
-> [Hook VirtualTime]
-> [Hook VirtualTime]
-> [Hook VirtualTime]
-> [HookRel VirtualTime]
-> [HookRel VirtualTime]
-> [HookRel VirtualTime]
-> Component VirtualTime
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 VirtualTime]
onAdd :: [Hook VirtualTime]
$conSet :: [Hook VirtualTime]
onSet :: [Hook VirtualTime]
$conRemove :: [Hook VirtualTime]
onRemove :: [Hook VirtualTime]
$conAddRel :: [HookRel VirtualTime]
onAddRel :: [HookRel VirtualTime]
$conSetRel :: [HookRel VirtualTime]
onSetRel :: [HookRel VirtualTime]
$conRemoveRel :: [HookRel VirtualTime]
onRemoveRel :: [HookRel VirtualTime]
Component)

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

time :: System Time
time :: System Time
time = VirtualTime -> Time
forall t. ToTime t => t -> Time
toTime (VirtualTime -> Time)
-> (Maybe VirtualTime -> VirtualTime) -> Maybe VirtualTime -> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe VirtualTime -> VirtualTime
forall a. HasCallStack => Maybe a -> a
unwrap (Maybe VirtualTime -> Time)
-> System (Maybe VirtualTime) -> System Time
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c. Component c => System (Maybe c)
res @VirtualTime

delta :: System Float
delta :: System Float
delta = do
  time <- System Time
time
  pure $ specToSecs time.delta

elapsed :: System Float
elapsed :: System Float
elapsed = do
  time <- System Time
time
  pure $ specToSecs time.elapsed

specToSecs :: TimeSpec -> Float
specToSecs :: TimeSpec -> Float
specToSecs TimeSpec
a = Int64 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral TimeSpec
a.sec Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Int64 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral TimeSpec
a.nsec Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
1000000000

data TimePlugin

instance Plugin TimePlugin where
  init :: System ()
init = do
    currentTime <- IO TimeSpec -> System TimeSpec
forall a. IO a -> System a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TimeSpec -> System TimeSpec) -> IO TimeSpec -> System TimeSpec
forall a b. (a -> b) -> a -> b
$ Clock -> IO TimeSpec
getTime Clock
Monotonic
    insertRes $ VirtualTime {virtualDelta = TimeSpec {sec = 0, nsec = 0}, virtualElapsed = currentTime}
    schedule @First (systems updateTime)

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