module Graphics.Gloss.Internals.Interface.Simulate.Idle
( callback_simulate_idle )
where
import Graphics.Gloss.ViewPort
import qualified Graphics.Gloss.Internals.Interface.Animate.State as AN
import qualified Graphics.Gloss.Internals.Interface.Simulate.State as SM
import qualified Graphics.UI.GLUT as GLUT
import Graphics.UI.GLUT (($=), get)
import Data.IORef
import Control.Monad
callback_simulate_idle
:: IORef SM.State
-> IORef AN.State
-> IORef ViewPort
-> IORef world
-> world
-> (ViewPort -> Float -> world -> world)
-> Float
-> IO ()
callback_simulate_idle simSR animateSR viewSR worldSR worldStart worldAdvance singleStepTime
=
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
simulate_reset simSR worldSR worldStart
= do writeIORef worldSR worldStart
simSR `modifyIORef` \c -> c
{ SM.stateReset = False
, SM.stateIteration = 0
, SM.stateSimTime = 0 }
GLUT.postRedisplay Nothing
simulate_run
:: IORef SM.State
-> IORef AN.State
-> IORef ViewPort
-> IORef world
-> (ViewPort -> Float -> world -> world)
-> IO ()
simulate_run simSR animateSR viewSR worldSR worldAdvance
= do
simS <- readIORef simSR
viewS <- readIORef viewSR
worldS <- readIORef worldSR
elapsedTime_msec <- get GLUT.elapsedTime
let elapsedTime = fromIntegral elapsedTime_msec / 1000
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
let (_, world') =
until (\(n, w) -> n >= nFinal)
(\(n, w) -> (n+1, worldAdvance viewS timePerStep w))
(nStart, worldS)
writeIORef worldSR world'
simSR `modifyIORef` \c -> c
{ SM.stateIteration = nFinal
, SM.stateSimTime = newSimTime
, SM.stateStepsPerFrame = fromIntegral thisSteps }
GLUT.postRedisplay Nothing
simulate_step
:: IORef SM.State
-> IORef ViewPort
-> IORef world
-> (ViewPort -> Float -> world -> world)
-> Float
-> IO ()
simulate_step simSR viewSR worldSR worldAdvance singleStepTime
= do
simS <- readIORef simSR
viewS <- readIORef viewSR
world <- readIORef worldSR
let world' = worldAdvance viewS singleStepTime world
writeIORef worldSR world'
simSR `modifyIORef` \c -> c
{ SM.stateIteration = SM.stateIteration c + 1
, SM.stateStep = False }
GLUT.postRedisplay Nothing
getsIORef ref fun
= liftM fun $ readIORef ref