module Mischief.ECS.Interval (start, stop, Interval) where

import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (async)
import Control.Concurrent.STM
import Control.Monad
import Control.Monad.IO.Class
import Data.IORef
import Mischief.ECS.World

newtype Interval = Interval (IORef Bool)

start :: (MonadSystem w m) => Int -> System () -> m Interval
start :: forall w (m :: * -> *).
MonadSystem w m =>
Int -> System () -> m Interval
start Int
t System ()
s = do
  world <- m World
forall w (m :: * -> *). MonadSystem w m => m World
unsafeGetWorld
  i <- Interval <$> liftIO (newIORef False)
  _ <- liftIO $ async $ run world i t s
  return i

run :: World -> Interval -> Int -> System () -> IO ()
run :: World -> Interval -> Int -> System () -> IO ()
run World
world (Interval IORef Bool
break) Int
t System ()
s = do
  b <- IO Bool -> IO Bool
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
break
  unless b $ do
    liftIO $ threadDelay t

    liftIO $ atomically $ modifyTVar' world.deferredAsync (++ [s])
    run world (Interval break) t s

stop :: (MonadSystem w m) => Interval -> m ()
stop :: forall w (m :: * -> *). MonadSystem w m => Interval -> m ()
stop (Interval IORef Bool
break) = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
break Bool
True