{-# 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
  :: IORef SM.State
  -- ^ the simulation state
  -> IORef AN.State
  -- ^ the animation statea
  -> IO ViewPort
  -- ^ 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'.
  -> IORef world
  -- ^ the current world
  -> (ViewPort -> Float -> world -> IO world)
  -- ^ fn to advance the world
  -> Float
  -- ^ how much time to advance world by
  --      in single step mode
  -> IdleCallback
callback_simulate_idle :: forall world.
IORef State
-> IORef State
-> IO ViewPort
-> IORef world
-> (ViewPort -> Float -> world -> IO world)
-> Float
-> IdleCallback
callback_simulate_idle IORef State
simSR IORef State
animateSR IO ViewPort
viewSA IORef world
worldSR ViewPort -> Float -> world -> IO world
worldAdvance Float
_singleStepTime IORef a
backendRef =
  {-# SCC "callbackIdle" #-}
  do IORef State
-> IORef State
-> IO ViewPort
-> IORef world
-> (ViewPort -> Float -> world -> IO world)
-> IdleCallback
forall world.
IORef State
-> IORef State
-> IO ViewPort
-> IORef world
-> (ViewPort -> Float -> world -> IO world)
-> IdleCallback
simulate_run IORef State
simSR IORef State
animateSR IO ViewPort
viewSA IORef world
worldSR ViewPort -> Float -> world -> IO world
worldAdvance IORef a
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 :: forall world.
IORef State
-> IORef State
-> IO ViewPort
-> IORef world
-> (ViewPort -> Float -> world -> IO world)
-> IdleCallback
simulate_run IORef State
simSR IORef State
_ IO ViewPort
viewSA IORef world
worldSR ViewPort -> Float -> world -> IO world
worldAdvance IORef a
backendRef =
  do
    ViewPort
viewS <- IO ViewPort
viewSA
    State
simS <- IORef State -> IO State
forall a. IORef a -> IO a
readIORef IORef State
simSR
    world
worldS <- IORef world -> IO world
forall a. IORef a -> IO a
readIORef IORef world
worldSR

    -- get the elapsed time since the start simulation (wall clock)
    Float
elapsedTime <- (Double -> Float) -> IO Double -> IO Float
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> Float
double2Float (IO Double -> IO Float) -> IO Double -> IO Float
forall a b. (a -> b) -> a -> b
$ IORef a -> IO Double
forall a. Backend a => IORef a -> IO Double
Backend.elapsedTime IORef a
backendRef

    -- get how far along the simulation is
    Float
simTime <- IORef State
simSR IORef State -> (State -> Float) -> IO Float
forall a r. IORef a -> (a -> r) -> IO r
`getsIORef` State -> Float
SM.stateSimTime

    -- we want to simulate this much extra time to bring the simulation
    --      up to the wall clock.
    let thisTime :: Float
thisTime = Float
elapsedTime Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
simTime

    -- work out how many steps of simulation this equals
    Int
resolution <- IORef State
simSR IORef State -> (State -> Int) -> IO Int
forall a r. IORef a -> (a -> r) -> IO r
`getsIORef` State -> Int
SM.stateResolution
    let timePerStep :: Float
timePerStep = Float
1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
resolution
    let thisSteps_ :: Integer
thisSteps_ = Float -> Integer
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Float -> Integer) -> Float -> Integer
forall a b. (a -> b) -> a -> b
$ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
resolution Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
thisTime
    let thisSteps :: Integer
thisSteps = if Integer
thisSteps_ Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 then Integer
0 else Integer
thisSteps_

    let newSimTime :: Float
newSimTime = Float
simTime Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
thisSteps Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
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 :: Integer
nStart = State -> Integer
SM.stateIteration State
simS
    let nFinal :: Integer
nFinal = Integer
nStart Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
thisSteps

    -- keep advancing the world until we get to the final iteration number
    (Integer
_, world
world') <-
      ((Integer, world) -> Bool)
-> ((Integer, world) -> IO (Integer, world))
-> (Integer, world)
-> IO (Integer, world)
forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> (a -> m a) -> a -> m a
untilM
        (\(Integer
n, world
_) -> Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
nFinal)
        (\(Integer
n, world
w) -> (world -> (Integer, world)) -> IO world -> IO (Integer, world)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\world
w' -> (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1, world
w')) (ViewPort -> Float -> world -> IO world
worldAdvance ViewPort
viewS Float
timePerStep world
w))
        (Integer
nStart, world
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
world' world -> IO () -> IO ()
forall a b. a -> b -> b
`seq` IORef world -> world -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef world
worldSR world
world'

    -- update the control state
    IORef State -> (State -> State) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef State
simSR ((State -> State) -> IO ()) -> (State -> State) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State
c ->
      State
c
        { SM.stateIteration = nFinal
        , SM.stateSimTime = newSimTime
        }

    -- tell backend we want to draw the window after returning
    IORef a -> IO ()
IdleCallback
Backend.postRedisplay IORef a
backendRef


getsIORef :: IORef a -> (a -> r) -> IO r
getsIORef :: forall a r. IORef a -> (a -> r) -> IO r
getsIORef IORef a
ref a -> r
fun =
  (a -> r) -> IO a -> IO r
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> r
fun (IO a -> IO r) -> IO a -> IO r
forall a b. (a -> b) -> a -> b
$ IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
ref


untilM :: (Monad m) => (a -> Bool) -> (a -> m a) -> a -> m a
untilM :: forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> (a -> m a) -> a -> m a
untilM a -> Bool
test a -> m a
op a
i = a -> m a
go a
i
  where
    go :: a -> m a
go a
x
      | a -> Bool
test a
x = a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
      | Bool
otherwise = a -> m a
op a
x m a -> (a -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m a
go