{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE RankNTypes #-}

module Graphics.Gloss.Internals.Interface.Simulate.Idle
        ( callback_simulate_idle )
where
import Graphics.Gloss.Data.ViewPort
import Graphics.Gloss.Internals.Interface.Callback
import qualified Graphics.Gloss.Internals.Interface.Backend             as Backend
import qualified Graphics.Gloss.Internals.Interface.Animate.State       as AN
import qualified Graphics.Gloss.Internals.Interface.Simulate.State      as SM
import Data.IORef
import Control.Monad
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   viewS           <- IO ViewPort
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    = Float
elapsedTime Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
simTime

        -- work out how many steps of simulation this equals
        resolution      <- simSR `getsIORef` SM.stateResolution
        let 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_  = 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   = if Integer
thisSteps_ Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 then Integer
0 else Integer
thisSteps_

        let 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      = State -> Integer
SM.stateIteration State
simS
        let 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
        (_,world')
         <- 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
nInteger -> 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))
                   (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 $ \State
c -> State
c
                { SM.stateIteration     = nFinal
                , SM.stateSimTime       = newSimTime }

        -- tell glut we want to draw the window after returning
        Backend.postRedisplay 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