module Mischief.ECS.Repeater (Repeater (..)) 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 GHC.Float (float2Int)
import Mischief.ECS.Components
import Mischief.ECS.Components.HooksDef
import Mischief.ECS.Hooks
import Mischief.ECS.World
import Mischief.ECS.World.Insert
import Mischief.ECS.World.Query
import Mischief.ECS.World.Query.Markers

data Repeater = Repeater Float (System ())

newtype RepeaterRef = RepeaterRef (IORef Bool) deriving anyclass (Typeable RepeaterRef
[HookRel RepeaterRef]
[Hook RepeaterRef]
Set DefaultComponentType
IsExclusive (IsExclusiveRel RepeaterRef)
(Typeable RepeaterRef, IsExclusive (IsExclusiveRel RepeaterRef)) =>
Set DefaultComponentType
-> [Hook RepeaterRef]
-> [Hook RepeaterRef]
-> [Hook RepeaterRef]
-> [HookRel RepeaterRef]
-> [HookRel RepeaterRef]
-> [HookRel RepeaterRef]
-> Component RepeaterRef
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 RepeaterRef]
onAdd :: [Hook RepeaterRef]
$conSet :: [Hook RepeaterRef]
onSet :: [Hook RepeaterRef]
$conRemove :: [Hook RepeaterRef]
onRemove :: [Hook RepeaterRef]
$conAddRel :: [HookRel RepeaterRef]
onAddRel :: [HookRel RepeaterRef]
$conSetRel :: [HookRel RepeaterRef]
onSetRel :: [HookRel RepeaterRef]
$conRemoveRel :: [HookRel RepeaterRef]
onRemoveRel :: [HookRel RepeaterRef]
Component)

instance Component Repeater where
  onAdd :: [Hook Repeater]
onAdd =
    [ (HookContext -> System ()) -> Hook Repeater
forall {k} (a :: k). (HookContext -> System ()) -> Hook a
hook ((HookContext -> System ()) -> Hook Repeater)
-> (HookContext -> System ()) -> Hook Repeater
forall a b. (a -> b) -> a -> b
$ \(HookContext Entity
e) -> do
        i <- IO (IORef Bool) -> System (IORef Bool)
forall a. IO a -> System a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False)
        Just (Repeater t s) <- single $ mkGet e (C @Repeater)
        insert (RepeaterRef i) e
        world <- unsafeGetWorld
        void $ liftIO $ async $ run world i (float2Int $ 1000000 * t) s
    ]

  onRemove :: [Hook Repeater]
onRemove =
    [ (HookContext -> System ()) -> Hook Repeater
forall {k} (a :: k). (HookContext -> System ()) -> Hook a
hook ((HookContext -> System ()) -> Hook Repeater)
-> (HookContext -> System ()) -> Hook Repeater
forall a b. (a -> b) -> a -> b
$ \(HookContext Entity
e) -> do
        break <- Query System RepeaterRef -> System (Maybe RepeaterRef)
forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m (Maybe out)
single (Query System RepeaterRef -> System (Maybe RepeaterRef))
-> Query System RepeaterRef -> System (Maybe RepeaterRef)
forall a b. (a -> b) -> a -> b
$ Entity -> C RepeaterRef -> Query System RepeaterRef
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 @RepeaterRef)
        case break of
          Maybe RepeaterRef
Nothing -> () -> System ()
forall a. a -> System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Just (RepeaterRef IORef Bool
break) -> 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 Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
break Bool
False
    ]

run :: World -> IORef Bool -> Int -> System () -> IO ()
run :: World -> IORef Bool -> Int -> System () -> IO ()
run World
world 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 break t s