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

{-| Handles timing of animation.
     The main point is that we want to restrict the framerate to something
     sensible, instead of just displaying at the machines maximum possible
     rate and soaking up 100% cpu.

     We also keep track of the elapsed time since the start of the program,
     so we can pass this to the user's animation function.
-}
module Brillo.Internals.Interface.Animate.Timing (
  animateBegin,
  animateEnd,
)
where

import Brillo.Internals.Interface.Animate.State
import Brillo.Internals.Interface.Backend
import Control.Monad
import Data.IORef


{-| Handles animation timing details.
     Call this function at the start of each frame.
-}
animateBegin :: IORef State -> DisplayCallback
animateBegin :: IORef State -> DisplayCallback
animateBegin IORef State
stateRef IORef a
backendRef =
  do
    -- write the current time into the display state
    Double
displayTime <- IORef a -> IO Double
forall a. Backend a => IORef a -> IO Double
elapsedTime IORef a
backendRef
    Double
displayTimeLast <- IORef State
stateRef IORef State -> (State -> Double) -> IO Double
forall a r. IORef a -> (a -> r) -> IO r
`getsIORef` State -> Double
stateDisplayTime
    let displayTimeElapsed :: Double
displayTimeElapsed = Double
displayTime Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
displayTimeLast

    IORef State -> (State -> State) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef State
stateRef ((State -> State) -> IO ()) -> (State -> State) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State
s ->
      State
s
        { stateDisplayTime = displayTime
        , stateDisplayTimeLast = displayTimeLast
        }

    -- increment the animation time
    Bool
animate <- IORef State
stateRef IORef State -> (State -> Bool) -> IO Bool
forall a r. IORef a -> (a -> r) -> IO r
`getsIORef` State -> Bool
stateAnimate
    Integer
animateCount <- IORef State
stateRef IORef State -> (State -> Integer) -> IO Integer
forall a r. IORef a -> (a -> r) -> IO r
`getsIORef` State -> Integer
stateAnimateCount
    Double
animateTime <- IORef State
stateRef IORef State -> (State -> Double) -> IO Double
forall a r. IORef a -> (a -> r) -> IO r
`getsIORef` State -> Double
stateAnimateTime
    Bool
animateStart <- IORef State
stateRef IORef State -> (State -> Bool) -> IO Bool
forall a r. IORef a -> (a -> r) -> IO r
`getsIORef` State -> Bool
stateAnimateStart

    {-      when (animateCount `mod` 5 == 0)
             $  putStr  $  "  displayTime        = " ++ show displayTime                ++ "\n"
                        ++ "  displayTimeLast    = " ++ show displayTimeLast            ++ "\n"
                        ++ "  displayTimeElapsed = " ++ show displayTimeElapsed         ++ "\n"
                        ++ "  fps                = " ++ show (truncate $ 1 / displayTimeElapsed)   ++ "\n"
    -}
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
animate Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
animateStart) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      IORef State -> (State -> State) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef State
stateRef ((State -> State) -> IO ()) -> (State -> State) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State
s ->
        State
s
          { stateAnimateTime = animateTime + displayTimeElapsed
          }

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
animate (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      IORef State -> (State -> State) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef State
stateRef ((State -> State) -> IO ()) -> (State -> State) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State
s ->
        State
s
          { stateAnimateCount = animateCount + 1
          , stateAnimateStart = False
          }


{-| Handles animation timing details.
     Call this function at the end of each frame.
-}
animateEnd :: IORef State -> DisplayCallback
animateEnd :: IORef State -> DisplayCallback
animateEnd IORef State
stateRef IORef a
backendRef =
  do
    -- timing gate, limits the maximum frame frequency (FPS)
    Double
timeClamp <- IORef State
stateRef IORef State -> (State -> Double) -> IO Double
forall a r. IORef a -> (a -> r) -> IO r
`getsIORef` State -> Double
stateDisplayTimeClamp

    -- the start of this gate
    Double
gateTimeStart <- IORef a -> IO Double
forall a. Backend a => IORef a -> IO Double
elapsedTime IORef a
backendRef

    -- end of the previous gate
    Double
gateTimeEnd <- IORef State
stateRef IORef State -> (State -> Double) -> IO Double
forall a r. IORef a -> (a -> r) -> IO r
`getsIORef` State -> Double
stateGateTimeEnd
    let gateTimeElapsed :: Double
gateTimeElapsed = Double
gateTimeStart Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
gateTimeEnd

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
gateTimeElapsed Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
timeClamp) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      do IORef a -> Double -> IO ()
forall a. Backend a => IORef a -> Double -> IO ()
sleep IORef a
backendRef (Double
timeClamp Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
gateTimeElapsed)

    Double
gateTimeFinal <- IORef a -> IO Double
forall a. Backend a => IORef a -> IO Double
elapsedTime IORef a
backendRef

    IORef State -> (State -> State) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef State
stateRef ((State -> State) -> IO ()) -> (State -> State) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State
s ->
      State
s
        { stateGateTimeEnd = gateTimeFinal
        , stateGateTimeElapsed = gateTimeElapsed
        }


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