module Graphics.Gloss.Internals.Interface.Simulate.Idle
( callback_simulate_idle )
where
import Graphics.Gloss.Internals.Interface.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)
callback_simulate_idle
:: IORef SM.State
-> IORef AN.State
-> IORef ViewPort
-> IORef world
-> world
-> (ViewPort -> Float -> world -> IO world)
-> Float
-> IdleCallback
callback_simulate_idle simSR animateSR viewSR worldSR worldStart worldAdvance singleStepTime backendRef
=
do simS <- readIORef simSR
let result
| SM.stateReset simS
= simulate_reset simSR worldSR worldStart
| SM.stateRun simS
= simulate_run simSR animateSR viewSR worldSR worldAdvance
| SM.stateStep simS
= simulate_step simSR viewSR worldSR worldAdvance singleStepTime
| otherwise
= \_ -> return ()
result backendRef
simulate_reset :: IORef SM.State -> IORef a -> a -> IdleCallback
simulate_reset simSR worldSR worldStart backendRef
= do writeIORef worldSR worldStart
simSR `modifyIORef` \c -> c
{ SM.stateReset = False
, SM.stateIteration = 0
, SM.stateSimTime = 0 }
Backend.postRedisplay backendRef
simulate_run
:: IORef SM.State
-> IORef AN.State
-> IORef ViewPort
-> IORef world
-> (ViewPort -> Float -> world -> IO world)
-> IdleCallback
simulate_run simSR _ viewSR worldSR worldAdvance backendRef
= do
simS <- readIORef simSR
viewS <- readIORef viewSR
worldS <- readIORef worldSR
elapsedTime <- fmap double2Float $ Backend.elapsedTime backendRef
simTime <- simSR `getsIORef` SM.stateSimTime
let thisTime = elapsedTime simTime
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
let nStart = SM.stateIteration simS
let nFinal = nStart + thisSteps
(_,world') <- untilM (\(n, _) -> n >= nFinal)
(\(n, w) -> liftM (\w' -> (n+1,w')) ( worldAdvance viewS timePerStep w))
(nStart, worldS)
world' `seq` writeIORef worldSR world'
simSR `modifyIORef` \c -> c
{ SM.stateIteration = nFinal
, SM.stateSimTime = newSimTime
, SM.stateStepsPerFrame = fromIntegral thisSteps }
Backend.postRedisplay backendRef
simulate_step
:: IORef SM.State
-> IORef ViewPort
-> IORef world
-> (ViewPort -> Float -> world -> IO world)
-> Float
-> IdleCallback
simulate_step simSR viewSR worldSR worldAdvance singleStepTime backendRef
= do
viewS <- readIORef viewSR
world <- readIORef worldSR
world' <- worldAdvance viewS singleStepTime world
writeIORef worldSR world'
simSR `modifyIORef` \c -> c
{ SM.stateIteration = SM.stateIteration c + 1
, SM.stateStep = False }
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