    {-# 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