{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_HADDOCK hide #-}
module Graphics.Gloss.Internals.Interface.Animate.Timing
( animateBegin
, animateEnd )
where
import Graphics.Gloss.Internals.Interface.Backend
import Graphics.Gloss.Internals.Interface.Animate.State
import Control.Monad
import Data.IORef
animateBegin :: IORef State -> DisplayCallback
animateBegin stateRef backendRef
= do
displayTime <- elapsedTime backendRef
displayTimeLast <- stateRef `getsIORef` stateDisplayTime
let displayTimeElapsed = displayTime - displayTimeLast
modifyIORef' stateRef $ \s -> s
{ stateDisplayTime = displayTime
, stateDisplayTimeLast = displayTimeLast }
animate <- stateRef `getsIORef` stateAnimate
animateCount <- stateRef `getsIORef` stateAnimateCount
animateTime <- stateRef `getsIORef` stateAnimateTime
animateStart <- stateRef `getsIORef` stateAnimateStart
when (animate && not animateStart)
$ modifyIORef' stateRef $ \s -> s
{ stateAnimateTime = animateTime + displayTimeElapsed }
when animate
$ modifyIORef' stateRef $ \s -> s
{ stateAnimateCount = animateCount + 1
, stateAnimateStart = False }
animateEnd :: IORef State -> DisplayCallback
animateEnd stateRef backendRef
= do
timeClamp <- stateRef `getsIORef` stateDisplayTimeClamp
gateTimeStart <- elapsedTime backendRef
gateTimeEnd <- stateRef `getsIORef` stateGateTimeEnd
let gateTimeElapsed = gateTimeStart - gateTimeEnd
when (gateTimeElapsed < timeClamp)
$ do sleep backendRef (timeClamp - gateTimeElapsed)
gateTimeFinal <- elapsedTime backendRef
modifyIORef' stateRef $ \s -> s
{ stateGateTimeEnd = gateTimeFinal
, stateGateTimeElapsed = gateTimeElapsed }
getsIORef :: IORef a -> (a -> r) -> IO r
getsIORef ref fun
= liftM fun $ readIORef ref