content: {-# LANGUAGE RankNTypes #-}
  {-# OPTIONS_HADDOCK hide #-}
  
  module Brillo.Internals.Interface.Simulate.Idle (callback_simulate_idle)
  where
  
  import Brillo.Data.ViewPort
  import Brillo.Internals.Interface.Animate.State qualified as AN
  import Brillo.Internals.Interface.Backend qualified as Backend
  import Brillo.Internals.Interface.Callback
  import Brillo.Internals.Interface.Simulate.State qualified as SM
  import Control.Monad
  import Data.IORef
  import GHC.Float (double2Float)
  
  
  {-| The graphics library calls back on this function when it's finished drawing
       and it's time to do some computation.
  -}
  callback_simulate_idle ::
    -- | the simulation state
    IORef SM.State ->
    -- | the animation statea
    IORef AN.State ->
    -- | action to get the 'ViewPort'.  We don't use an 'IORef'
    -- directly because sometimes we hold a ref to a 'ViewPort' (in
    -- Game) and sometimes a ref to a 'ViewState'.
    IO ViewPort ->
    -- | the current world
    IORef world ->
    -- | fn to advance the world
    (ViewPort -> Float -> world -> IO world) ->
    -- | how much time to advance world by
    --      in single step mode
    Float ->
    IdleCallback
  callback_simulate_idle simSR animateSR viewSA worldSR worldAdvance _singleStepTime backendRef =
    {-# SCC "callbackIdle" #-}
    do simulate_run simSR animateSR viewSA worldSR worldAdvance backendRef
  
  
  -- take the number of steps specified by controlWarp
  simulate_run ::
    IORef SM.State ->
    IORef AN.State ->
    IO ViewPort ->
    IORef world ->
    (ViewPort -> Float -> world -> IO world) ->
    IdleCallback
  simulate_run simSR _ viewSA worldSR worldAdvance backendRef =
    do
      viewS <- viewSA
      simS <- readIORef simSR
      worldS <- readIORef worldSR
  
      -- get the elapsed time since the start simulation (wall clock)
      elapsedTime <- fmap double2Float $ Backend.elapsedTime backendRef
  
      -- get how far along the simulation is
      simTime <- simSR `getsIORef` SM.stateSimTime
  
      -- we want to simulate this much extra time to bring the simulation
      --      up to the wall clock.
      let thisTime = elapsedTime - simTime
  
      -- work out how many steps of simulation this equals
      resolution <- simSR `getsIORef` SM.stateResolution
      let timePerStep = 1 / fromIntegral resolution
      let thisSteps_ = truncate $ fromIntegral resolution * thisTime
      let thisSteps = if thisSteps_ < 0 then 0 else thisSteps_
  
      let newSimTime = simTime + fromIntegral thisSteps * timePerStep
  
      {-      putStr  $  "elapsed time    = " ++ show elapsedTime     ++ "\n"
                      ++ "sim time        = " ++ show simTime         ++ "\n"
                      ++ "this time       = " ++ show thisTime        ++ "\n"
                      ++ "this steps      = " ++ show thisSteps       ++ "\n"
                      ++ "new sim time    = " ++ show newSimTime      ++ "\n"
                      ++ "taking          = " ++ show thisSteps       ++ "\n\n"
      -}
      -- work out the final step number for this display cycle
      let nStart = SM.stateIteration simS
      let nFinal = nStart + thisSteps
  
      -- keep advancing the world until we get to the final iteration number
      (_, world') <-
        untilM
          (\(n, _) -> n >= nFinal)
          (\(n, w) -> liftM (\w' -> (n + 1, w')) (worldAdvance viewS timePerStep w))
          (nStart, worldS)
  
      -- write the world back into its IORef
      -- We need to seq on the world to avoid space leaks when the window is not showing.
      world' `seq` writeIORef worldSR world'
  
      -- update the control state
      modifyIORef' simSR $ \c ->
        c
          { SM.stateIteration = nFinal
          , SM.stateSimTime = newSimTime
          }
  
      -- tell backend we want to draw the window after returning
      Backend.postRedisplay backendRef
  
  
  getsIORef :: IORef a -> (a -> r) -> IO r
  getsIORef ref fun =
    liftM fun $ readIORef ref
  
  
  untilM :: (Monad m) => (a -> Bool) -> (a -> m a) -> a -> m a
  untilM test op i = go i
    where
      go x
        | test x = return x
        | otherwise = op x >>= go
  