packages feed

mischief-ecs-0.2.0.0: src/Mischief/ECS/Fixed.hs

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 (Component)

instance Default FixedFrequency where
  def = FixedFrequency 0.033333333

data FixedFirst deriving (Schedule, Show)

data FixedPreUpdate deriving (Schedule, Show)

data FixedUpdate deriving (Schedule, Show)

data FixedPostUpdate deriving (Schedule, Show)

data FixedLast deriving (Schedule, 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 = do
    first <- 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 = [dep @TimePlugin]

data Fixed deriving (Schedule)

data FixedTime = FixedTime
  { fixedElapsed :: TimeSpec,
    fixedDelta :: TimeSpec
  }
  deriving (Component)

instance ToTime FixedTime where
  toTime FixedTime {fixedElapsed, fixedDelta} = Time {elapsed = fixedElapsed, delta = fixedDelta}

newtype FixedExtra = FixedExtra Float deriving anyclass (Component)

runFixedLoop :: System ()
runFixedLoop = do
  FixedExtra extra <- fromMaybe (FixedExtra 0) <$> (res @FixedExtra)
  delta <- Time.delta
  Just (FixedFrequency freq) <- res @FixedFrequency

  let extra' = extra + delta
  let runs :: Int = floor $ extra' / freq

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

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

    replicateM_ runs $ do
      for_ schedules runSchedule'
      modifyRes' (\FixedTime {fixedElapsed, fixedDelta} -> FixedTime {fixedElapsed = fixedElapsed + fixedDelta, fixedDelta})

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