{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE RankNTypes #-}
-- | This module provides some infrastructure for adding animations to
-- Brick applications. See @programs/AnimationDemo.hs@ for a complete
-- working example of this API.
--
-- At a high level, this works as follows:
--
-- This module provides a threaded animation manager that manages a set
-- of running animations. The application creates the manager and starts
-- animations, which automatically loop or run once, depending on their
-- configuration. Each animation has some state in the application's
-- state that is automatically managed by the animation manager using a
-- lens-based API. Whenever animations need to be redrawn, the animation
-- manager sends a custom event with a state update to the application,
-- which must be evaluated by the main event loop to update animation
-- states. Each animation is associated with a 'Clip' -- sequence of
-- frames -- which may be static or may be built from the application
-- state at rendering time.
--
-- To use this module:
--
-- * Use a custom event type @e@ in your 'Brick.Main.App' and give the
--   event type a constructor @EventM n s () -> e@ (where @s@ and
--   @n@ are those in @App s e n@). This will require the use of
--   'Brick.Main.customMain' and will also require the creation of a
--   'Brick.BChan.BChan' for custom events.
--
-- * Add an 'AnimationManager' field to the application state @s@.
--
-- * Create an 'AnimationManager' at startup with
--   'startAnimationManager', providing the custom event constructor and
--   'BChan' created above. Store the manager in the application state.
--
-- * For each animation you want to run at any given time, add a field
--   to the application state of type @Maybe (Animation s n)@,
--   initialized to 'Nothing'. A value of 'Nothing' indicates that the
--   animation is not running.
--
-- * Ensure that each animation state field in @s@ has a lens, usually
--   by using 'Lens.Micro.TH.makeLenses'.
--
-- * Start new animations in 'EventM' with 'startAnimation'; stop them
--   with 'stopAnimation'. Supply clips for new animations with
--   'newClip', 'newClip_', and the clip transformation functions.
--
-- * Call 'renderAnimation' in 'Brick.Main.appDraw' for each animation in the
--   application state.
--
-- * If needed, stop the animation manager with 'stopAnimationManager'.
--
-- See 'AnimationManager' and the docs for the rest of this module for
-- details.
module Brick.Animation
  ( -- * Animation managers
    AnimationManager
  , startAnimationManager
  , stopAnimationManager
  , minTickTime

  -- * Animations
  , Animation
  , animationFrameIndex

  -- * Starting and stopping animations
  , RunMode(..)
  , startAnimation
  , stopAnimation

  -- * Rendering animations
  , renderAnimation

  -- * Creating clips
  , Clip
  , newClip
  , newClip_
  , clipLength

  -- * Transforming clips
  , pingPongClip
  , reverseClip
  )
where

import Control.Concurrent (threadDelay, forkIO, ThreadId, killThread, myThreadId)
import qualified Control.Concurrent.STM as STM
import Control.Monad (forever, when)
import Control.Monad.State.Strict
import Data.Foldable (foldrM)
import Data.Hashable (Hashable)
import qualified Data.HashMap.Strict as HM
import Data.Maybe (fromMaybe)
import qualified Data.Vector as V
import Lens.Micro ((^.), (%~), (.~), (&), Traversal', _Just)
import Lens.Micro.TH (makeLenses)
import Lens.Micro.Mtl

import Brick.BChan
import Brick.Types (EventM, Widget)
import qualified Brick.Animation.Clock as C

-- | A sequence of a animation frames.
newtype Clip s n = Clip (V.Vector (s -> Widget n))
                     deriving (NonEmpty (Clip s n) -> Clip s n
Clip s n -> Clip s n -> Clip s n
(Clip s n -> Clip s n -> Clip s n)
-> (NonEmpty (Clip s n) -> Clip s n)
-> (forall b. Integral b => b -> Clip s n -> Clip s n)
-> Semigroup (Clip s n)
forall b. Integral b => b -> Clip s n -> Clip s n
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall s n. NonEmpty (Clip s n) -> Clip s n
forall s n. Clip s n -> Clip s n -> Clip s n
forall s n b. Integral b => b -> Clip s n -> Clip s n
$c<> :: forall s n. Clip s n -> Clip s n -> Clip s n
<> :: Clip s n -> Clip s n -> Clip s n
$csconcat :: forall s n. NonEmpty (Clip s n) -> Clip s n
sconcat :: NonEmpty (Clip s n) -> Clip s n
$cstimes :: forall s n b. Integral b => b -> Clip s n -> Clip s n
stimes :: forall b. Integral b => b -> Clip s n -> Clip s n
Semigroup)

-- | Get the number of frames in a clip.
clipLength :: Clip s n -> Int
clipLength :: forall s n. Clip s n -> Int
clipLength (Clip Vector (s -> Widget n)
fs) = Vector (s -> Widget n) -> Int
forall a. Vector a -> Int
V.length Vector (s -> Widget n)
fs

-- | Build a clip.
--
-- Each frame in a clip is represented by a function from a state to a
-- 'Widget'. This allows applications to determine on a per-frame basis
-- what should be drawn in an animation based on application state, if
-- desired, in the same style as 'Brick.Main.appDraw'.
--
-- If the provided list is empty, this calls 'error'.
newClip :: [s -> Widget n] -> Clip s n
newClip :: forall s n. [s -> Widget n] -> Clip s n
newClip [] = [Char] -> Clip s n
forall a. HasCallStack => [Char] -> a
error [Char]
"clip: got an empty list"
newClip [s -> Widget n]
fs = Vector (s -> Widget n) -> Clip s n
forall s n. Vector (s -> Widget n) -> Clip s n
Clip (Vector (s -> Widget n) -> Clip s n)
-> Vector (s -> Widget n) -> Clip s n
forall a b. (a -> b) -> a -> b
$ [s -> Widget n] -> Vector (s -> Widget n)
forall a. [a] -> Vector a
V.fromList [s -> Widget n]
fs

-- | Like 'newClip' but for static frames.
newClip_ :: [Widget n] -> Clip s n
newClip_ :: forall n s. [Widget n] -> Clip s n
newClip_ [Widget n]
ws = [s -> Widget n] -> Clip s n
forall s n. [s -> Widget n] -> Clip s n
newClip ([s -> Widget n] -> Clip s n) -> [s -> Widget n] -> Clip s n
forall a b. (a -> b) -> a -> b
$ Widget n -> s -> Widget n
forall a b. a -> b -> a
const (Widget n -> s -> Widget n) -> [Widget n] -> [s -> Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Widget n]
ws

-- | Extend a clip so that when the end of the original clip is reached,
-- it continues in reverse order to create a loop.
--
-- For example, if this is given a clip with frames A, B, C, and D, then
-- this returns a clip with frames A, B, C, D, C, and B.
--
-- If the given clip contains less than two frames, this is equivalent
-- to 'id'.
pingPongClip :: Clip s n -> Clip s n
pingPongClip :: forall s n. Clip s n -> Clip s n
pingPongClip (Clip Vector (s -> Widget n)
fs) | Vector (s -> Widget n) -> Int
forall a. Vector a -> Int
V.length Vector (s -> Widget n)
fs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 =
    Vector (s -> Widget n) -> Clip s n
forall s n. Vector (s -> Widget n) -> Clip s n
Clip (Vector (s -> Widget n) -> Clip s n)
-> Vector (s -> Widget n) -> Clip s n
forall a b. (a -> b) -> a -> b
$ Vector (s -> Widget n)
fs Vector (s -> Widget n)
-> Vector (s -> Widget n) -> Vector (s -> Widget n)
forall a. Semigroup a => a -> a -> a
<> Vector (s -> Widget n) -> Vector (s -> Widget n)
forall a. Vector a -> Vector a
V.reverse (Vector (s -> Widget n) -> Vector (s -> Widget n)
forall a. Vector a -> Vector a
V.init (Vector (s -> Widget n) -> Vector (s -> Widget n))
-> Vector (s -> Widget n) -> Vector (s -> Widget n)
forall a b. (a -> b) -> a -> b
$ Vector (s -> Widget n) -> Vector (s -> Widget n)
forall a. Vector a -> Vector a
V.tail Vector (s -> Widget n)
fs)
pingPongClip Clip s n
c = Clip s n
c

-- | Reverse a clip.
reverseClip :: Clip s n -> Clip s n
reverseClip :: forall s n. Clip s n -> Clip s n
reverseClip (Clip Vector (s -> Widget n)
fs) = Vector (s -> Widget n) -> Clip s n
forall s n. Vector (s -> Widget n) -> Clip s n
Clip (Vector (s -> Widget n) -> Clip s n)
-> Vector (s -> Widget n) -> Clip s n
forall a b. (a -> b) -> a -> b
$ Vector (s -> Widget n) -> Vector (s -> Widget n)
forall a. Vector a -> Vector a
V.reverse Vector (s -> Widget n)
fs

data AnimationManagerRequest s n =
    Tick C.Time
    | StartAnimation (Clip s n) Integer RunMode (Traversal' s (Maybe (Animation s n)))
    -- ^ Clip, frame duration in milliseconds, run mode, updater
    | StopAnimation (Animation s n)
    | Shutdown

-- | The running mode for an animation.
data RunMode =
    Once
    -- ^ Run the animation once and then end
    | Loop
    -- ^ Run the animation in a loop forever
    deriving (RunMode -> RunMode -> Bool
(RunMode -> RunMode -> Bool)
-> (RunMode -> RunMode -> Bool) -> Eq RunMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunMode -> RunMode -> Bool
== :: RunMode -> RunMode -> Bool
$c/= :: RunMode -> RunMode -> Bool
/= :: RunMode -> RunMode -> Bool
Eq, Int -> RunMode -> ShowS
[RunMode] -> ShowS
RunMode -> [Char]
(Int -> RunMode -> ShowS)
-> (RunMode -> [Char]) -> ([RunMode] -> ShowS) -> Show RunMode
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunMode -> ShowS
showsPrec :: Int -> RunMode -> ShowS
$cshow :: RunMode -> [Char]
show :: RunMode -> [Char]
$cshowList :: [RunMode] -> ShowS
showList :: [RunMode] -> ShowS
Show, Eq RunMode
Eq RunMode =>
(RunMode -> RunMode -> Ordering)
-> (RunMode -> RunMode -> Bool)
-> (RunMode -> RunMode -> Bool)
-> (RunMode -> RunMode -> Bool)
-> (RunMode -> RunMode -> Bool)
-> (RunMode -> RunMode -> RunMode)
-> (RunMode -> RunMode -> RunMode)
-> Ord RunMode
RunMode -> RunMode -> Bool
RunMode -> RunMode -> Ordering
RunMode -> RunMode -> RunMode
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RunMode -> RunMode -> Ordering
compare :: RunMode -> RunMode -> Ordering
$c< :: RunMode -> RunMode -> Bool
< :: RunMode -> RunMode -> Bool
$c<= :: RunMode -> RunMode -> Bool
<= :: RunMode -> RunMode -> Bool
$c> :: RunMode -> RunMode -> Bool
> :: RunMode -> RunMode -> Bool
$c>= :: RunMode -> RunMode -> Bool
>= :: RunMode -> RunMode -> Bool
$cmax :: RunMode -> RunMode -> RunMode
max :: RunMode -> RunMode -> RunMode
$cmin :: RunMode -> RunMode -> RunMode
min :: RunMode -> RunMode -> RunMode
Ord)

newtype AnimationID = AnimationID Int
                    deriving (AnimationID -> AnimationID -> Bool
(AnimationID -> AnimationID -> Bool)
-> (AnimationID -> AnimationID -> Bool) -> Eq AnimationID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AnimationID -> AnimationID -> Bool
== :: AnimationID -> AnimationID -> Bool
$c/= :: AnimationID -> AnimationID -> Bool
/= :: AnimationID -> AnimationID -> Bool
Eq, Eq AnimationID
Eq AnimationID =>
(AnimationID -> AnimationID -> Ordering)
-> (AnimationID -> AnimationID -> Bool)
-> (AnimationID -> AnimationID -> Bool)
-> (AnimationID -> AnimationID -> Bool)
-> (AnimationID -> AnimationID -> Bool)
-> (AnimationID -> AnimationID -> AnimationID)
-> (AnimationID -> AnimationID -> AnimationID)
-> Ord AnimationID
AnimationID -> AnimationID -> Bool
AnimationID -> AnimationID -> Ordering
AnimationID -> AnimationID -> AnimationID
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AnimationID -> AnimationID -> Ordering
compare :: AnimationID -> AnimationID -> Ordering
$c< :: AnimationID -> AnimationID -> Bool
< :: AnimationID -> AnimationID -> Bool
$c<= :: AnimationID -> AnimationID -> Bool
<= :: AnimationID -> AnimationID -> Bool
$c> :: AnimationID -> AnimationID -> Bool
> :: AnimationID -> AnimationID -> Bool
$c>= :: AnimationID -> AnimationID -> Bool
>= :: AnimationID -> AnimationID -> Bool
$cmax :: AnimationID -> AnimationID -> AnimationID
max :: AnimationID -> AnimationID -> AnimationID
$cmin :: AnimationID -> AnimationID -> AnimationID
min :: AnimationID -> AnimationID -> AnimationID
Ord, Int -> AnimationID -> ShowS
[AnimationID] -> ShowS
AnimationID -> [Char]
(Int -> AnimationID -> ShowS)
-> (AnimationID -> [Char])
-> ([AnimationID] -> ShowS)
-> Show AnimationID
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AnimationID -> ShowS
showsPrec :: Int -> AnimationID -> ShowS
$cshow :: AnimationID -> [Char]
show :: AnimationID -> [Char]
$cshowList :: [AnimationID] -> ShowS
showList :: [AnimationID] -> ShowS
Show, Eq AnimationID
Eq AnimationID =>
(Int -> AnimationID -> Int)
-> (AnimationID -> Int) -> Hashable AnimationID
Int -> AnimationID -> Int
AnimationID -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> AnimationID -> Int
hashWithSalt :: Int -> AnimationID -> Int
$chash :: AnimationID -> Int
hash :: AnimationID -> Int
Hashable)

-- | The state of a running animation.
--
-- Put one of these (wrapped in 'Maybe') in your application state for
-- each animation that you'd like to run concurrently.
data Animation s n =
    Animation { forall s n. Animation s n -> Int
animationFrameIndex :: Int
              -- ^ The animation's current frame index, provided for
              -- convenience. Applications won't need to access this in
              -- most situations; use 'renderAnimation' instead.
              , forall s n. Animation s n -> AnimationID
animationID :: AnimationID
              -- ^ The animation's internally-managed ID
              , forall s n. Animation s n -> Clip s n
animationClip :: Clip s n
              -- ^ The animation's clip
              }

-- | Render an animation.
renderAnimation :: (s -> Widget n)
                -- ^ The fallback function to use for drawing if the
                -- animation is not running
                -> s
                -- ^ The state to provide when rendering the animation's
                -- current frame
                -> Maybe (Animation s n)
                -- ^ The animation state itself
                -> Widget n
renderAnimation :: forall s n.
(s -> Widget n) -> s -> Maybe (Animation s n) -> Widget n
renderAnimation s -> Widget n
fallback s
input Maybe (Animation s n)
mAnim =
    s -> Widget n
draw s
input
    where
        draw :: s -> Widget n
draw = (s -> Widget n) -> Maybe (s -> Widget n) -> s -> Widget n
forall a. a -> Maybe a -> a
fromMaybe s -> Widget n
fallback (Maybe (s -> Widget n) -> s -> Widget n)
-> Maybe (s -> Widget n) -> s -> Widget n
forall a b. (a -> b) -> a -> b
$ do
            Animation s n
a <- Maybe (Animation s n)
mAnim
            let idx :: Int
idx = Animation s n -> Int
forall s n. Animation s n -> Int
animationFrameIndex Animation s n
a
                Clip Vector (s -> Widget n)
fs = Animation s n -> Clip s n
forall s n. Animation s n -> Clip s n
animationClip Animation s n
a
            Vector (s -> Widget n)
fs Vector (s -> Widget n) -> Int -> Maybe (s -> Widget n)
forall a. Vector a -> Int -> Maybe a
V.!? Int
idx

data AnimationState s n =
    AnimationState { forall s n. AnimationState s n -> AnimationID
_animationStateID :: AnimationID
                   , forall s n. AnimationState s n -> Int
_animationNumFrames :: Int
                   , forall s n. AnimationState s n -> Int
_animationCurrentFrame :: Int
                   , forall s n. AnimationState s n -> Integer
_animationFrameMilliseconds :: Integer
                   , forall s n. AnimationState s n -> RunMode
_animationRunMode :: RunMode
                   , forall s n.
AnimationState s n -> Traversal' s (Maybe (Animation s n))
animationFrameUpdater :: Traversal' s (Maybe (Animation s n))
                   , forall s n. AnimationState s n -> Time
_animationNextFrameTime :: C.Time
                   }

makeLenses ''AnimationState

-- | A manager for animations. The type variables for this type are the
-- same as those for 'Brick.Main.App'.
--
-- This asynchronously manages a set of running animations, advancing
-- each one over time. When a running animation's current frame needs
-- to be changed, the manager sends an 'EventM' update for that
-- animation to the application's event loop to perform the update to
-- the animation in the application state. The manager will batch such
-- updates if more than one animation needs to be changed at a time.
--
-- The manager has a /tick duration/ in milliseconds which is the
-- resolution at which animations are checked to see if they should
-- be updated. Animations also have their own frame duration in
-- milliseconds. For example, if a manager has a tick duration of 50
-- milliseconds and is running an animation with a frame duration of 100
-- milliseconds, then the manager will advance that animation by one
-- frame every two ticks. On the other hand, if a manager has a tick
-- duration of 100 milliseconds and is running an animation with a frame
-- duration of 50 milliseconds, the manager will advance that animation
-- by two frames on each tick.
--
-- Animation managers are started with 'startAnimationManager' and
-- stopped with 'stopAnimationManager'.
--
-- Animations are started with 'startAnimation' and stopped with
-- 'stopAnimation'. Each animation must be associated with an
-- application state field accessible with a traversal given to
-- 'startAnimation'.
--
-- When an animation is started, every time it advances a frame, and
-- when it is ended, the manager communicates these changes to the
-- application by using the custom event constructor provided to
-- 'startAnimationManager'. The manager uses that to schedule a state
-- update which the application is responsible for evaluating. The state
-- updates are built from the traversals provided to 'startAnimation'.
--
-- The manager-updated 'Animation' values in the application state are
-- then drawn with 'renderAnimation'.
--
-- Animations in 'Loop' mode are run forever until stopped with
-- 'stopAnimation'; animations in 'Once' mode run once and are removed
-- from the application state (set to 'Nothing') when they finish. All
-- state updates to the application state are performed by the manager's
-- custom event mechanism; the application never needs to directly
-- modify the 'Animation' application state fields except to initialize
-- them to 'Nothing'.
--
-- There is nothing here to prevent an application from running multiple
-- managers, each at a different tick rate. That may have performance
-- consequences, though, due to the loss of batch efficiency in state
-- updates, so we recommend using only one manager per application at a
-- sufficiently short tick duration.
data AnimationManager s e n =
    AnimationManager { forall s e n. AnimationManager s e n -> ThreadId
animationMgrRequestThreadId :: ThreadId
                     , forall s e n. AnimationManager s e n -> ThreadId
animationMgrTickThreadId :: ThreadId
                     , forall s e n. AnimationManager s e n -> BChan e
animationMgrOutputChan :: BChan e
                     , forall s e n.
AnimationManager s e n -> TChan (AnimationManagerRequest s n)
animationMgrInputChan :: STM.TChan (AnimationManagerRequest s n)
                     , forall s e n. AnimationManager s e n -> EventM n s () -> e
animationMgrEventConstructor :: EventM n s () -> e
                     , forall s e n. AnimationManager s e n -> TVar Bool
animationMgrRunning :: STM.TVar Bool
                     }

tickThreadBody :: Int
               -> STM.TChan (AnimationManagerRequest s n)
               -> IO ()
tickThreadBody :: forall s n. Int -> TChan (AnimationManagerRequest s n) -> IO ()
tickThreadBody Int
tickMilliseconds TChan (AnimationManagerRequest s n)
outChan = do
    let nextTick :: Time -> Time
nextTick = Offset -> Time -> Time
C.addOffset Offset
tickOffset
        tickOffset :: Offset
tickOffset = Integer -> Offset
C.offsetFromMs (Integer -> Offset) -> Integer -> Offset
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
tickMilliseconds
        go :: Time -> IO b
go Time
targetTime = do
            Time
now <- IO Time
forall (m :: * -> *). MonadIO m => m Time
C.getTime
            STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TChan (AnimationManagerRequest s n)
-> AnimationManagerRequest s n -> STM ()
forall a. TChan a -> a -> STM ()
STM.writeTChan TChan (AnimationManagerRequest s n)
outChan (AnimationManagerRequest s n -> STM ())
-> AnimationManagerRequest s n -> STM ()
forall a b. (a -> b) -> a -> b
$ Time -> AnimationManagerRequest s n
forall s n. Time -> AnimationManagerRequest s n
Tick Time
now

            -- threadDelay does not guarantee that we will wake up on
            -- time; it only ensures that we won't wake up earlier than
            -- requested. Since we can therefore oversleep, instead of
            -- always sleeping for tickMilliseconds (which would cause
            -- us to drift off of schedule as delays accumulate) we
            -- determine sleep time by measuring the distance between
            -- now and the next scheduled tick. This is still unreliable
            -- as we can still oversleep, but it keeps the oversleeping
            -- under control over time. It means most ticks may be
            -- slightly late (about 1-2 milliseconds is common) but this
            -- will prevent that per-tick error from accumulating.
            let nextTickTime :: Time
nextTickTime = Time -> Time
nextTick Time
targetTime
                sleepMs :: Int
sleepMs = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$
                          Offset -> Integer
C.offsetToMs (Offset -> Integer) -> Offset -> Integer
forall a b. (a -> b) -> a -> b
$
                          Time -> Time -> Offset
C.subtractTime Time
nextTickTime Time
now

            -- threadDelay works microseconds.
            Int -> IO ()
threadDelay (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
sleepMs Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000
            Time -> IO b
go Time
nextTickTime

    Time -> IO ()
forall {b}. Time -> IO b
go (Time -> IO ()) -> IO Time -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Time
forall (m :: * -> *). MonadIO m => m Time
C.getTime

setNextFrameTime :: C.Time -> AnimationState s n -> AnimationState s n
setNextFrameTime :: forall s n. Time -> AnimationState s n -> AnimationState s n
setNextFrameTime Time
t AnimationState s n
a = AnimationState s n
a AnimationState s n
-> (AnimationState s n -> AnimationState s n) -> AnimationState s n
forall a b. a -> (a -> b) -> b
& (Time -> Identity Time)
-> AnimationState s n -> Identity (AnimationState s n)
forall s n (f :: * -> *).
Functor f =>
(Time -> f Time) -> AnimationState s n -> f (AnimationState s n)
animationNextFrameTime ((Time -> Identity Time)
 -> AnimationState s n -> Identity (AnimationState s n))
-> Time -> AnimationState s n -> AnimationState s n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Time
t

data ManagerState s e n =
    ManagerState { forall s e n.
ManagerState s e n -> TChan (AnimationManagerRequest s n)
_managerStateInChan :: STM.TChan (AnimationManagerRequest s n)
                 , forall s e n. ManagerState s e n -> BChan e
_managerStateOutChan :: BChan e
                 , forall s e n. ManagerState s e n -> EventM n s () -> e
_managerStateEventBuilder :: EventM n s () -> e
                 , forall s e n.
ManagerState s e n -> HashMap AnimationID (AnimationState s n)
_managerStateAnimations :: HM.HashMap AnimationID (AnimationState s n)
                 , forall s e n. ManagerState s e n -> TVar AnimationID
_managerStateIDVar :: STM.TVar AnimationID
                 }

makeLenses ''ManagerState

animationManagerThreadBody :: STM.TChan (AnimationManagerRequest s n)
                           -> BChan e
                           -> (EventM n s () -> e)
                           -> IO ()
animationManagerThreadBody :: forall s n e.
TChan (AnimationManagerRequest s n)
-> BChan e -> (EventM n s () -> e) -> IO ()
animationManagerThreadBody TChan (AnimationManagerRequest s n)
inChan BChan e
outChan EventM n s () -> e
mkEvent = do
    TVar AnimationID
idVar <- AnimationID -> IO (TVar AnimationID)
forall a. a -> IO (TVar a)
STM.newTVarIO (AnimationID -> IO (TVar AnimationID))
-> AnimationID -> IO (TVar AnimationID)
forall a b. (a -> b) -> a -> b
$ Int -> AnimationID
AnimationID Int
1
    let initial :: ManagerState s e n
initial = ManagerState { _managerStateInChan :: TChan (AnimationManagerRequest s n)
_managerStateInChan = TChan (AnimationManagerRequest s n)
inChan
                               , _managerStateOutChan :: BChan e
_managerStateOutChan = BChan e
outChan
                               , _managerStateEventBuilder :: EventM n s () -> e
_managerStateEventBuilder = EventM n s () -> e
mkEvent
                               , _managerStateAnimations :: HashMap AnimationID (AnimationState s n)
_managerStateAnimations = HashMap AnimationID (AnimationState s n)
forall a. Monoid a => a
mempty
                               , _managerStateIDVar :: TVar AnimationID
_managerStateIDVar = TVar AnimationID
idVar
                               }
    StateT (ManagerState s e n) IO () -> ManagerState s e n -> IO ()
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT (ManagerState s e n) IO ()
forall s e n. ManagerM s e n ()
runManager ManagerState s e n
initial

type ManagerM s e n a = StateT (ManagerState s e n) IO a

getNextManagerRequest :: ManagerM s e n (AnimationManagerRequest s n)
getNextManagerRequest :: forall s e n. ManagerM s e n (AnimationManagerRequest s n)
getNextManagerRequest = do
    TChan (AnimationManagerRequest s n)
inChan <- Getting
  (TChan (AnimationManagerRequest s n))
  (ManagerState s e n)
  (TChan (AnimationManagerRequest s n))
-> StateT
     (ManagerState s e n) IO (TChan (AnimationManagerRequest s n))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (TChan (AnimationManagerRequest s n))
  (ManagerState s e n)
  (TChan (AnimationManagerRequest s n))
forall s e n (f :: * -> *).
Functor f =>
(TChan (AnimationManagerRequest s n)
 -> f (TChan (AnimationManagerRequest s n)))
-> ManagerState s e n -> f (ManagerState s e n)
managerStateInChan
    IO (AnimationManagerRequest s n)
-> ManagerM s e n (AnimationManagerRequest s n)
forall a. IO a -> StateT (ManagerState s e n) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (AnimationManagerRequest s n)
 -> ManagerM s e n (AnimationManagerRequest s n))
-> IO (AnimationManagerRequest s n)
-> ManagerM s e n (AnimationManagerRequest s n)
forall a b. (a -> b) -> a -> b
$ STM (AnimationManagerRequest s n)
-> IO (AnimationManagerRequest s n)
forall a. STM a -> IO a
STM.atomically (STM (AnimationManagerRequest s n)
 -> IO (AnimationManagerRequest s n))
-> STM (AnimationManagerRequest s n)
-> IO (AnimationManagerRequest s n)
forall a b. (a -> b) -> a -> b
$ TChan (AnimationManagerRequest s n)
-> STM (AnimationManagerRequest s n)
forall a. TChan a -> STM a
STM.readTChan TChan (AnimationManagerRequest s n)
inChan

sendApplicationStateUpdate :: EventM n s () -> ManagerM s e n ()
sendApplicationStateUpdate :: forall n s e. EventM n s () -> ManagerM s e n ()
sendApplicationStateUpdate EventM n s ()
act = do
    BChan e
outChan <- Getting (BChan e) (ManagerState s e n) (BChan e)
-> StateT (ManagerState s e n) IO (BChan e)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (BChan e) (ManagerState s e n) (BChan e)
forall s e n (f :: * -> *).
Functor f =>
(BChan e -> f (BChan e))
-> ManagerState s e n -> f (ManagerState s e n)
managerStateOutChan
    EventM n s () -> e
mkEvent <- Getting
  (EventM n s () -> e) (ManagerState s e n) (EventM n s () -> e)
-> StateT (ManagerState s e n) IO (EventM n s () -> e)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (EventM n s () -> e) (ManagerState s e n) (EventM n s () -> e)
forall s e n (f :: * -> *).
Functor f =>
((EventM n s () -> e) -> f (EventM n s () -> e))
-> ManagerState s e n -> f (ManagerState s e n)
managerStateEventBuilder
    IO () -> ManagerM s e n ()
forall a. IO a -> StateT (ManagerState s e n) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ManagerM s e n ()) -> IO () -> ManagerM s e n ()
forall a b. (a -> b) -> a -> b
$ BChan e -> e -> IO ()
forall a. BChan a -> a -> IO ()
writeBChan BChan e
outChan (e -> IO ()) -> e -> IO ()
forall a b. (a -> b) -> a -> b
$ EventM n s () -> e
mkEvent EventM n s ()
act

removeAnimation :: AnimationID -> ManagerM s e n ()
removeAnimation :: forall s e n. AnimationID -> ManagerM s e n ()
removeAnimation AnimationID
aId =
    (HashMap AnimationID (AnimationState s n)
 -> Identity (HashMap AnimationID (AnimationState s n)))
-> ManagerState s e n -> Identity (ManagerState s e n)
forall s e n (f :: * -> *).
Functor f =>
(HashMap AnimationID (AnimationState s n)
 -> f (HashMap AnimationID (AnimationState s n)))
-> ManagerState s e n -> f (ManagerState s e n)
managerStateAnimations ((HashMap AnimationID (AnimationState s n)
  -> Identity (HashMap AnimationID (AnimationState s n)))
 -> ManagerState s e n -> Identity (ManagerState s e n))
-> (HashMap AnimationID (AnimationState s n)
    -> HashMap AnimationID (AnimationState s n))
-> StateT (ManagerState s e n) IO ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= AnimationID
-> HashMap AnimationID (AnimationState s n)
-> HashMap AnimationID (AnimationState s n)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete AnimationID
aId

lookupAnimation :: AnimationID -> ManagerM s e n (Maybe (AnimationState s n))
lookupAnimation :: forall s e n.
AnimationID -> ManagerM s e n (Maybe (AnimationState s n))
lookupAnimation AnimationID
aId =
    AnimationID
-> HashMap AnimationID (AnimationState s n)
-> Maybe (AnimationState s n)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup AnimationID
aId (HashMap AnimationID (AnimationState s n)
 -> Maybe (AnimationState s n))
-> StateT
     (ManagerState s e n) IO (HashMap AnimationID (AnimationState s n))
-> StateT (ManagerState s e n) IO (Maybe (AnimationState s n))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
  (HashMap AnimationID (AnimationState s n))
  (ManagerState s e n)
  (HashMap AnimationID (AnimationState s n))
-> StateT
     (ManagerState s e n) IO (HashMap AnimationID (AnimationState s n))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (HashMap AnimationID (AnimationState s n))
  (ManagerState s e n)
  (HashMap AnimationID (AnimationState s n))
forall s e n (f :: * -> *).
Functor f =>
(HashMap AnimationID (AnimationState s n)
 -> f (HashMap AnimationID (AnimationState s n)))
-> ManagerState s e n -> f (ManagerState s e n)
managerStateAnimations

insertAnimation :: AnimationState s n -> ManagerM s e n ()
insertAnimation :: forall s n e. AnimationState s n -> ManagerM s e n ()
insertAnimation AnimationState s n
a =
    (HashMap AnimationID (AnimationState s n)
 -> Identity (HashMap AnimationID (AnimationState s n)))
-> ManagerState s e n -> Identity (ManagerState s e n)
forall s e n (f :: * -> *).
Functor f =>
(HashMap AnimationID (AnimationState s n)
 -> f (HashMap AnimationID (AnimationState s n)))
-> ManagerState s e n -> f (ManagerState s e n)
managerStateAnimations ((HashMap AnimationID (AnimationState s n)
  -> Identity (HashMap AnimationID (AnimationState s n)))
 -> ManagerState s e n -> Identity (ManagerState s e n))
-> (HashMap AnimationID (AnimationState s n)
    -> HashMap AnimationID (AnimationState s n))
-> StateT (ManagerState s e n) IO ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= AnimationID
-> AnimationState s n
-> HashMap AnimationID (AnimationState s n)
-> HashMap AnimationID (AnimationState s n)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert (AnimationState s n
aAnimationState s n
-> Getting AnimationID (AnimationState s n) AnimationID
-> AnimationID
forall s a. s -> Getting a s a -> a
^.Getting AnimationID (AnimationState s n) AnimationID
forall s n (f :: * -> *).
Functor f =>
(AnimationID -> f AnimationID)
-> AnimationState s n -> f (AnimationState s n)
animationStateID) AnimationState s n
a

getNextAnimationID :: ManagerM s e n AnimationID
getNextAnimationID :: forall s e n. ManagerM s e n AnimationID
getNextAnimationID = do
    TVar AnimationID
var <- Getting (TVar AnimationID) (ManagerState s e n) (TVar AnimationID)
-> StateT (ManagerState s e n) IO (TVar AnimationID)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (TVar AnimationID) (ManagerState s e n) (TVar AnimationID)
forall s e n (f :: * -> *).
Functor f =>
(TVar AnimationID -> f (TVar AnimationID))
-> ManagerState s e n -> f (ManagerState s e n)
managerStateIDVar
    IO AnimationID -> ManagerM s e n AnimationID
forall a. IO a -> StateT (ManagerState s e n) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AnimationID -> ManagerM s e n AnimationID)
-> IO AnimationID -> ManagerM s e n AnimationID
forall a b. (a -> b) -> a -> b
$ STM AnimationID -> IO AnimationID
forall a. STM a -> IO a
STM.atomically (STM AnimationID -> IO AnimationID)
-> STM AnimationID -> IO AnimationID
forall a b. (a -> b) -> a -> b
$ do
        AnimationID Int
i <- TVar AnimationID -> STM AnimationID
forall a. TVar a -> STM a
STM.readTVar TVar AnimationID
var
        let next :: AnimationID
next = Int -> AnimationID
AnimationID (Int -> AnimationID) -> Int -> AnimationID
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        TVar AnimationID -> AnimationID -> STM ()
forall a. TVar a -> a -> STM ()
STM.writeTVar TVar AnimationID
var AnimationID
next
        AnimationID -> STM AnimationID
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnimationID -> STM AnimationID) -> AnimationID -> STM AnimationID
forall a b. (a -> b) -> a -> b
$ Int -> AnimationID
AnimationID Int
i

runManager :: ManagerM s e n ()
runManager :: forall s e n. ManagerM s e n ()
runManager = StateT (ManagerState s e n) IO ()
-> StateT (ManagerState s e n) IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (StateT (ManagerState s e n) IO ()
 -> StateT (ManagerState s e n) IO ())
-> StateT (ManagerState s e n) IO ()
-> StateT (ManagerState s e n) IO ()
forall a b. (a -> b) -> a -> b
$ do
    ManagerM s e n (AnimationManagerRequest s n)
forall s e n. ManagerM s e n (AnimationManagerRequest s n)
getNextManagerRequest ManagerM s e n (AnimationManagerRequest s n)
-> (AnimationManagerRequest s n
    -> StateT (ManagerState s e n) IO ())
-> StateT (ManagerState s e n) IO ()
forall a b.
StateT (ManagerState s e n) IO a
-> (a -> StateT (ManagerState s e n) IO b)
-> StateT (ManagerState s e n) IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= AnimationManagerRequest s n -> StateT (ManagerState s e n) IO ()
forall s n e. AnimationManagerRequest s n -> ManagerM s e n ()
handleManagerRequest

handleManagerRequest :: AnimationManagerRequest s n -> ManagerM s e n ()
handleManagerRequest :: forall s n e. AnimationManagerRequest s n -> ManagerM s e n ()
handleManagerRequest (StartAnimation Clip s n
clip Integer
frameMs RunMode
runMode Traversal' s (Maybe (Animation s n))
updater) = do
    AnimationID
aId <- ManagerM s e n AnimationID
forall s e n. ManagerM s e n AnimationID
getNextAnimationID
    Time
now <- IO Time -> StateT (ManagerState s e n) IO Time
forall a. IO a -> StateT (ManagerState s e n) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Time
forall (m :: * -> *). MonadIO m => m Time
C.getTime
    let next :: Time
next = Offset -> Time -> Time
C.addOffset Offset
frameOffset Time
now
        frameOffset :: Offset
frameOffset = Integer -> Offset
C.offsetFromMs Integer
frameMs
        a :: AnimationState s n
a = AnimationState { _animationStateID :: AnimationID
_animationStateID = AnimationID
aId
                           , _animationNumFrames :: Int
_animationNumFrames = Clip s n -> Int
forall s n. Clip s n -> Int
clipLength Clip s n
clip
                           , _animationCurrentFrame :: Int
_animationCurrentFrame = Int
0
                           , _animationFrameMilliseconds :: Integer
_animationFrameMilliseconds = Integer
frameMs
                           , _animationRunMode :: RunMode
_animationRunMode = RunMode
runMode
                           , animationFrameUpdater :: Traversal' s (Maybe (Animation s n))
animationFrameUpdater = (Maybe (Animation s n) -> f (Maybe (Animation s n))) -> s -> f s
Traversal' s (Maybe (Animation s n))
updater
                           , _animationNextFrameTime :: Time
_animationNextFrameTime = Time
next
                           }

    AnimationState s n -> ManagerM s e n ()
forall s n e. AnimationState s n -> ManagerM s e n ()
insertAnimation AnimationState s n
a
    EventM n s () -> ManagerM s e n ()
forall n s e. EventM n s () -> ManagerM s e n ()
sendApplicationStateUpdate (EventM n s () -> ManagerM s e n ())
-> EventM n s () -> ManagerM s e n ()
forall a b. (a -> b) -> a -> b
$ (Maybe (Animation s n) -> Identity (Maybe (Animation s n)))
-> s -> Identity s
Traversal' s (Maybe (Animation s n))
updater ((Maybe (Animation s n) -> Identity (Maybe (Animation s n)))
 -> s -> Identity s)
-> Maybe (Animation s n) -> EventM n s ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Animation s n -> Maybe (Animation s n)
forall a. a -> Maybe a
Just (Animation { animationID :: AnimationID
animationID = AnimationID
aId
                                                            , animationFrameIndex :: Int
animationFrameIndex = Int
0
                                                            , animationClip :: Clip s n
animationClip = Clip s n
clip
                                                            })
handleManagerRequest (StopAnimation Animation s n
a) = do
    let aId :: AnimationID
aId = Animation s n -> AnimationID
forall s n. Animation s n -> AnimationID
animationID Animation s n
a
    Maybe (AnimationState s n)
mA <- AnimationID -> ManagerM s e n (Maybe (AnimationState s n))
forall s e n.
AnimationID -> ManagerM s e n (Maybe (AnimationState s n))
lookupAnimation AnimationID
aId
    case Maybe (AnimationState s n)
mA of
        Maybe (AnimationState s n)
Nothing -> () -> ManagerM s e n ()
forall a. a -> StateT (ManagerState s e n) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just AnimationState s n
aState -> do
            -- Remove the animation from the manager
            AnimationID -> ManagerM s e n ()
forall s e n. AnimationID -> ManagerM s e n ()
removeAnimation AnimationID
aId

            -- Set the current animation state in the application state
            -- to none
            EventM n s () -> ManagerM s e n ()
forall n s e. EventM n s () -> ManagerM s e n ()
sendApplicationStateUpdate (EventM n s () -> ManagerM s e n ())
-> EventM n s () -> ManagerM s e n ()
forall a b. (a -> b) -> a -> b
$ AnimationState s n -> EventM n s ()
forall s n. AnimationState s n -> EventM n s ()
clearStateAction AnimationState s n
aState
handleManagerRequest AnimationManagerRequest s n
Shutdown = do
    [AnimationState s n]
as <- HashMap AnimationID (AnimationState s n) -> [AnimationState s n]
forall k v. HashMap k v -> [v]
HM.elems (HashMap AnimationID (AnimationState s n) -> [AnimationState s n])
-> StateT
     (ManagerState s e n) IO (HashMap AnimationID (AnimationState s n))
-> StateT (ManagerState s e n) IO [AnimationState s n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
  (HashMap AnimationID (AnimationState s n))
  (ManagerState s e n)
  (HashMap AnimationID (AnimationState s n))
-> StateT
     (ManagerState s e n) IO (HashMap AnimationID (AnimationState s n))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (HashMap AnimationID (AnimationState s n))
  (ManagerState s e n)
  (HashMap AnimationID (AnimationState s n))
forall s e n (f :: * -> *).
Functor f =>
(HashMap AnimationID (AnimationState s n)
 -> f (HashMap AnimationID (AnimationState s n)))
-> ManagerState s e n -> f (ManagerState s e n)
managerStateAnimations

    let updater :: EventM n s ()
updater = [EventM n s ()] -> EventM n s ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([EventM n s ()] -> EventM n s ())
-> [EventM n s ()] -> EventM n s ()
forall a b. (a -> b) -> a -> b
$ AnimationState s n -> EventM n s ()
forall s n. AnimationState s n -> EventM n s ()
clearStateAction (AnimationState s n -> EventM n s ())
-> [AnimationState s n] -> [EventM n s ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AnimationState s n]
as
    Bool -> ManagerM s e n () -> ManagerM s e n ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [AnimationState s n] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AnimationState s n]
as) (ManagerM s e n () -> ManagerM s e n ())
-> ManagerM s e n () -> ManagerM s e n ()
forall a b. (a -> b) -> a -> b
$ do
        EventM n s () -> ManagerM s e n ()
forall n s e. EventM n s () -> ManagerM s e n ()
sendApplicationStateUpdate EventM n s ()
updater

    IO () -> ManagerM s e n ()
forall a. IO a -> StateT (ManagerState s e n) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ManagerM s e n ()) -> IO () -> ManagerM s e n ()
forall a b. (a -> b) -> a -> b
$ IO ThreadId
myThreadId IO ThreadId -> (ThreadId -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ThreadId -> IO ()
killThread
handleManagerRequest (Tick Time
tickTime) = do
    -- Check all animation states for frame advances
    -- based on the relationship between the tick time
    -- and each animation's next frame time
    Maybe (EventM n s ())
mUpdateAct <- Time -> ManagerM s e n (Maybe (EventM n s ()))
forall s e n. Time -> ManagerM s e n (Maybe (EventM n s ()))
checkAnimations Time
tickTime
    case Maybe (EventM n s ())
mUpdateAct of
        Maybe (EventM n s ())
Nothing -> () -> ManagerM s e n ()
forall a. a -> StateT (ManagerState s e n) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just EventM n s ()
act -> EventM n s () -> ManagerM s e n ()
forall n s e. EventM n s () -> ManagerM s e n ()
sendApplicationStateUpdate EventM n s ()
act

clearStateAction :: AnimationState s n -> EventM n s ()
clearStateAction :: forall s n. AnimationState s n -> EventM n s ()
clearStateAction AnimationState s n
a = AnimationState s n -> Traversal' s (Maybe (Animation s n))
forall s n.
AnimationState s n -> Traversal' s (Maybe (Animation s n))
animationFrameUpdater AnimationState s n
a ((Maybe (Animation s n) -> Identity (Maybe (Animation s n)))
 -> s -> Identity s)
-> Maybe (Animation s n) -> EventM n s ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (Animation s n)
forall a. Maybe a
Nothing

frameUpdateAction :: AnimationState s n -> EventM n s ()
frameUpdateAction :: forall s n. AnimationState s n -> EventM n s ()
frameUpdateAction AnimationState s n
a =
    AnimationState s n -> Traversal' s (Maybe (Animation s n))
forall s n.
AnimationState s n -> Traversal' s (Maybe (Animation s n))
animationFrameUpdater AnimationState s n
a((Maybe (Animation s n) -> Identity (Maybe (Animation s n)))
 -> s -> Identity s)
-> ((Animation s n -> Identity (Animation s n))
    -> Maybe (Animation s n) -> Identity (Maybe (Animation s n)))
-> (Animation s n -> Identity (Animation s n))
-> s
-> Identity s
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Animation s n -> Identity (Animation s n))
-> Maybe (Animation s n) -> Identity (Maybe (Animation s n))
forall a a' (f :: * -> *).
Applicative f =>
(a -> f a') -> Maybe a -> f (Maybe a')
_Just ((Animation s n -> Identity (Animation s n)) -> s -> Identity s)
-> (Animation s n -> Animation s n) -> EventM n s ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%=
        (\Animation s n
an -> Animation s n
an { animationFrameIndex = a^.animationCurrentFrame })

updateAnimationState :: C.Time -> AnimationState s n -> AnimationState s n
updateAnimationState :: forall s n. Time -> AnimationState s n -> AnimationState s n
updateAnimationState Time
now AnimationState s n
a =
    let differenceMs :: Integer
differenceMs = Offset -> Integer
C.offsetToMs (Offset -> Integer) -> Offset -> Integer
forall a b. (a -> b) -> a -> b
$
                       Time -> Time -> Offset
C.subtractTime Time
now (AnimationState s n
aAnimationState s n
-> Getting Time (AnimationState s n) Time -> Time
forall s a. s -> Getting a s a -> a
^.Getting Time (AnimationState s n) Time
forall s n (f :: * -> *).
Functor f =>
(Time -> f Time) -> AnimationState s n -> f (AnimationState s n)
animationNextFrameTime)
        numFrames :: Integer
numFrames = Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Integer
differenceMs Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` (AnimationState s n
aAnimationState s n
-> Getting Integer (AnimationState s n) Integer -> Integer
forall s a. s -> Getting a s a -> a
^.Getting Integer (AnimationState s n) Integer
forall s n (f :: * -> *).
Functor f =>
(Integer -> f Integer)
-> AnimationState s n -> f (AnimationState s n)
animationFrameMilliseconds))
        newNextTime :: Time
newNextTime = Offset -> Time -> Time
C.addOffset (Integer -> Offset
C.offsetFromMs (Integer -> Offset) -> Integer -> Offset
forall a b. (a -> b) -> a -> b
$ Integer
numFrames Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (AnimationState s n
aAnimationState s n
-> Getting Integer (AnimationState s n) Integer -> Integer
forall s a. s -> Getting a s a -> a
^.Getting Integer (AnimationState s n) Integer
forall s n (f :: * -> *).
Functor f =>
(Integer -> f Integer)
-> AnimationState s n -> f (AnimationState s n)
animationFrameMilliseconds))
                                  (AnimationState s n
aAnimationState s n
-> Getting Time (AnimationState s n) Time -> Time
forall s a. s -> Getting a s a -> a
^.Getting Time (AnimationState s n) Time
forall s n (f :: * -> *).
Functor f =>
(Time -> f Time) -> AnimationState s n -> f (AnimationState s n)
animationNextFrameTime)

    -- The new frame is obtained by advancing from the current frame by
    -- numFrames.
    in Time -> AnimationState s n -> AnimationState s n
forall s n. Time -> AnimationState s n -> AnimationState s n
setNextFrameTime Time
newNextTime (AnimationState s n -> AnimationState s n)
-> AnimationState s n -> AnimationState s n
forall a b. (a -> b) -> a -> b
$ Integer -> AnimationState s n -> AnimationState s n
forall s n. Integer -> AnimationState s n -> AnimationState s n
advanceBy Integer
numFrames AnimationState s n
a

checkAnimations :: C.Time -> ManagerM s e n (Maybe (EventM n s ()))
checkAnimations :: forall s e n. Time -> ManagerM s e n (Maybe (EventM n s ()))
checkAnimations Time
now = do
    let go :: AnimationState s n
-> [EventM n s ()]
-> StateT (ManagerState s e n) IO [EventM n s ()]
go AnimationState s n
a [EventM n s ()]
updaters = do
          Maybe (EventM n s ())
result <- Time
-> AnimationState s n -> ManagerM s e n (Maybe (EventM n s ()))
forall s n e.
Time
-> AnimationState s n -> ManagerM s e n (Maybe (EventM n s ()))
checkAnimation Time
now AnimationState s n
a
          [EventM n s ()] -> StateT (ManagerState s e n) IO [EventM n s ()]
forall a. a -> StateT (ManagerState s e n) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([EventM n s ()] -> StateT (ManagerState s e n) IO [EventM n s ()])
-> [EventM n s ()]
-> StateT (ManagerState s e n) IO [EventM n s ()]
forall a b. (a -> b) -> a -> b
$ case Maybe (EventM n s ())
result of
              Maybe (EventM n s ())
Nothing -> [EventM n s ()]
updaters
              Just EventM n s ()
u  -> EventM n s ()
u EventM n s () -> [EventM n s ()] -> [EventM n s ()]
forall a. a -> [a] -> [a]
: [EventM n s ()]
updaters

    HashMap AnimationID (AnimationState s n)
anims <- Getting
  (HashMap AnimationID (AnimationState s n))
  (ManagerState s e n)
  (HashMap AnimationID (AnimationState s n))
-> StateT
     (ManagerState s e n) IO (HashMap AnimationID (AnimationState s n))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (HashMap AnimationID (AnimationState s n))
  (ManagerState s e n)
  (HashMap AnimationID (AnimationState s n))
forall s e n (f :: * -> *).
Functor f =>
(HashMap AnimationID (AnimationState s n)
 -> f (HashMap AnimationID (AnimationState s n)))
-> ManagerState s e n -> f (ManagerState s e n)
managerStateAnimations
    [EventM n s ()]
updaters <- (AnimationState s n
 -> [EventM n s ()]
 -> StateT (ManagerState s e n) IO [EventM n s ()])
-> [EventM n s ()]
-> HashMap AnimationID (AnimationState s n)
-> StateT (ManagerState s e n) IO [EventM n s ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM AnimationState s n
-> [EventM n s ()]
-> StateT (ManagerState s e n) IO [EventM n s ()]
forall {s} {n} {e}.
AnimationState s n
-> [EventM n s ()]
-> StateT (ManagerState s e n) IO [EventM n s ()]
go [] HashMap AnimationID (AnimationState s n)
anims

    case [EventM n s ()]
updaters of
        [] -> Maybe (EventM n s ()) -> ManagerM s e n (Maybe (EventM n s ()))
forall a. a -> StateT (ManagerState s e n) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (EventM n s ())
forall a. Maybe a
Nothing
        [EventM n s ()]
_ -> Maybe (EventM n s ()) -> ManagerM s e n (Maybe (EventM n s ()))
forall a. a -> StateT (ManagerState s e n) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (EventM n s ()) -> ManagerM s e n (Maybe (EventM n s ())))
-> Maybe (EventM n s ()) -> ManagerM s e n (Maybe (EventM n s ()))
forall a b. (a -> b) -> a -> b
$ EventM n s () -> Maybe (EventM n s ())
forall a. a -> Maybe a
Just (EventM n s () -> Maybe (EventM n s ()))
-> EventM n s () -> Maybe (EventM n s ())
forall a b. (a -> b) -> a -> b
$ [EventM n s ()] -> EventM n s ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [EventM n s ()]
updaters

-- For each active animation, check to see if the animation's next frame
-- time has passed. If it has, advance its frame counter as appropriate
-- and schedule its frame index to be updated in the application state.
checkAnimation :: C.Time -> AnimationState s n -> ManagerM s e n (Maybe (EventM n s ()))
checkAnimation :: forall s n e.
Time
-> AnimationState s n -> ManagerM s e n (Maybe (EventM n s ()))
checkAnimation Time
now AnimationState s n
a
    | AnimationState s n -> Bool
forall s n. AnimationState s n -> Bool
isFinished AnimationState s n
a = do
        -- This animation completed in a previous check, so clear it
        -- from the manager and the application state.
        AnimationID -> ManagerM s e n ()
forall s e n. AnimationID -> ManagerM s e n ()
removeAnimation (AnimationState s n
aAnimationState s n
-> Getting AnimationID (AnimationState s n) AnimationID
-> AnimationID
forall s a. s -> Getting a s a -> a
^.Getting AnimationID (AnimationState s n) AnimationID
forall s n (f :: * -> *).
Functor f =>
(AnimationID -> f AnimationID)
-> AnimationState s n -> f (AnimationState s n)
animationStateID)
        Maybe (EventM n s ()) -> ManagerM s e n (Maybe (EventM n s ()))
forall a. a -> StateT (ManagerState s e n) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (EventM n s ()) -> ManagerM s e n (Maybe (EventM n s ())))
-> Maybe (EventM n s ()) -> ManagerM s e n (Maybe (EventM n s ()))
forall a b. (a -> b) -> a -> b
$ EventM n s () -> Maybe (EventM n s ())
forall a. a -> Maybe a
Just (EventM n s () -> Maybe (EventM n s ()))
-> EventM n s () -> Maybe (EventM n s ())
forall a b. (a -> b) -> a -> b
$ AnimationState s n -> EventM n s ()
forall s n. AnimationState s n -> EventM n s ()
clearStateAction AnimationState s n
a
    | (Time
now Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< AnimationState s n
aAnimationState s n
-> Getting Time (AnimationState s n) Time -> Time
forall s a. s -> Getting a s a -> a
^.Getting Time (AnimationState s n) Time
forall s n (f :: * -> *).
Functor f =>
(Time -> f Time) -> AnimationState s n -> f (AnimationState s n)
animationNextFrameTime) =
        -- This animation is not due for an update, so don't do
        -- anything.
        Maybe (EventM n s ()) -> ManagerM s e n (Maybe (EventM n s ()))
forall a. a -> StateT (ManagerState s e n) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (EventM n s ())
forall a. Maybe a
Nothing
    | Bool
otherwise = do
        -- This animation is still running, so determine how many frames
        -- have elapsed for it and then advance the frame index based
        -- the elapsed time. Also set its next frame time.
        let a' :: AnimationState s n
a' = Time -> AnimationState s n -> AnimationState s n
forall s n. Time -> AnimationState s n -> AnimationState s n
updateAnimationState Time
now AnimationState s n
a
        (HashMap AnimationID (AnimationState s n)
 -> Identity (HashMap AnimationID (AnimationState s n)))
-> ManagerState s e n -> Identity (ManagerState s e n)
forall s e n (f :: * -> *).
Functor f =>
(HashMap AnimationID (AnimationState s n)
 -> f (HashMap AnimationID (AnimationState s n)))
-> ManagerState s e n -> f (ManagerState s e n)
managerStateAnimations ((HashMap AnimationID (AnimationState s n)
  -> Identity (HashMap AnimationID (AnimationState s n)))
 -> ManagerState s e n -> Identity (ManagerState s e n))
-> (HashMap AnimationID (AnimationState s n)
    -> HashMap AnimationID (AnimationState s n))
-> ManagerM s e n ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= AnimationID
-> AnimationState s n
-> HashMap AnimationID (AnimationState s n)
-> HashMap AnimationID (AnimationState s n)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert (AnimationState s n
a'AnimationState s n
-> Getting AnimationID (AnimationState s n) AnimationID
-> AnimationID
forall s a. s -> Getting a s a -> a
^.Getting AnimationID (AnimationState s n) AnimationID
forall s n (f :: * -> *).
Functor f =>
(AnimationID -> f AnimationID)
-> AnimationState s n -> f (AnimationState s n)
animationStateID) AnimationState s n
a'
        Maybe (EventM n s ()) -> ManagerM s e n (Maybe (EventM n s ()))
forall a. a -> StateT (ManagerState s e n) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (EventM n s ()) -> ManagerM s e n (Maybe (EventM n s ())))
-> Maybe (EventM n s ()) -> ManagerM s e n (Maybe (EventM n s ()))
forall a b. (a -> b) -> a -> b
$ EventM n s () -> Maybe (EventM n s ())
forall a. a -> Maybe a
Just (EventM n s () -> Maybe (EventM n s ()))
-> EventM n s () -> Maybe (EventM n s ())
forall a b. (a -> b) -> a -> b
$ AnimationState s n -> EventM n s ()
forall s n. AnimationState s n -> EventM n s ()
frameUpdateAction AnimationState s n
a'

isFinished :: AnimationState s n -> Bool
isFinished :: forall s n. AnimationState s n -> Bool
isFinished AnimationState s n
a =
    case AnimationState s n
aAnimationState s n
-> Getting RunMode (AnimationState s n) RunMode -> RunMode
forall s a. s -> Getting a s a -> a
^.Getting RunMode (AnimationState s n) RunMode
forall s n (f :: * -> *).
Functor f =>
(RunMode -> f RunMode)
-> AnimationState s n -> f (AnimationState s n)
animationRunMode of
        RunMode
Once -> AnimationState s n
aAnimationState s n -> Getting Int (AnimationState s n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (AnimationState s n) Int
forall s n (f :: * -> *).
Functor f =>
(Int -> f Int) -> AnimationState s n -> f (AnimationState s n)
animationCurrentFrame Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== AnimationState s n
aAnimationState s n -> Getting Int (AnimationState s n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (AnimationState s n) Int
forall s n (f :: * -> *).
Functor f =>
(Int -> f Int) -> AnimationState s n -> f (AnimationState s n)
animationNumFrames Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        RunMode
Loop -> Bool
False

advanceBy :: Integer -> AnimationState s n -> AnimationState s n
advanceBy :: forall s n. Integer -> AnimationState s n -> AnimationState s n
advanceBy Integer
n AnimationState s n
a
    | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 = AnimationState s n
a
    | Bool
otherwise =
        Integer -> AnimationState s n -> AnimationState s n
forall s n. Integer -> AnimationState s n -> AnimationState s n
advanceBy (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) (AnimationState s n -> AnimationState s n)
-> AnimationState s n -> AnimationState s n
forall a b. (a -> b) -> a -> b
$
        AnimationState s n -> AnimationState s n
forall s n. AnimationState s n -> AnimationState s n
advanceByOne AnimationState s n
a

advanceByOne :: AnimationState s n -> AnimationState s n
advanceByOne :: forall s n. AnimationState s n -> AnimationState s n
advanceByOne AnimationState s n
a =
    if AnimationState s n
aAnimationState s n -> Getting Int (AnimationState s n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (AnimationState s n) Int
forall s n (f :: * -> *).
Functor f =>
(Int -> f Int) -> AnimationState s n -> f (AnimationState s n)
animationCurrentFrame Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== AnimationState s n
aAnimationState s n -> Getting Int (AnimationState s n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (AnimationState s n) Int
forall s n (f :: * -> *).
Functor f =>
(Int -> f Int) -> AnimationState s n -> f (AnimationState s n)
animationNumFrames Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    then case AnimationState s n
aAnimationState s n
-> Getting RunMode (AnimationState s n) RunMode -> RunMode
forall s a. s -> Getting a s a -> a
^.Getting RunMode (AnimationState s n) RunMode
forall s n (f :: * -> *).
Functor f =>
(RunMode -> f RunMode)
-> AnimationState s n -> f (AnimationState s n)
animationRunMode of
        RunMode
Loop -> AnimationState s n
a AnimationState s n
-> (AnimationState s n -> AnimationState s n) -> AnimationState s n
forall a b. a -> (a -> b) -> b
& (Int -> Identity Int)
-> AnimationState s n -> Identity (AnimationState s n)
forall s n (f :: * -> *).
Functor f =>
(Int -> f Int) -> AnimationState s n -> f (AnimationState s n)
animationCurrentFrame ((Int -> Identity Int)
 -> AnimationState s n -> Identity (AnimationState s n))
-> Int -> AnimationState s n -> AnimationState s n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
0
        RunMode
Once -> AnimationState s n
a
    else AnimationState s n
a AnimationState s n
-> (AnimationState s n -> AnimationState s n) -> AnimationState s n
forall a b. a -> (a -> b) -> b
& (Int -> Identity Int)
-> AnimationState s n -> Identity (AnimationState s n)
forall s n (f :: * -> *).
Functor f =>
(Int -> f Int) -> AnimationState s n -> f (AnimationState s n)
animationCurrentFrame ((Int -> Identity Int)
 -> AnimationState s n -> Identity (AnimationState s n))
-> (Int -> Int) -> AnimationState s n -> AnimationState s n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- | The minimum tick duration in milliseconds allowed by
-- 'startAnimationManager'.
minTickTime :: Int
minTickTime :: Int
minTickTime = Int
25

-- | Start a new animation manager. For full details about how managers
-- work, see 'AnimationManager'.
--
-- If the specified tick duration is less than 'minTickTime', this will
-- call 'error'. This bound is in place to prevent API misuse leading to
-- ticking so fast that the terminal can't keep up with redraws.
startAnimationManager :: (MonadIO m)
                      => Int
                      -- ^ The tick duration for this manager in milliseconds
                      -> BChan e
                      -- ^ The event channel to use to send updates to
                      -- the application (i.e. the same one given to
                      -- e.g. 'Brick.Main.customVty')
                      -> (EventM n s () -> e)
                      -- ^ A constructor for building custom events
                      -- that perform application state updates. The
                      -- application must evaluate these custom events'
                      -- 'EventM' actions in order to record animation
                      -- updates in the application state.
                      -> m (AnimationManager s e n)
startAnimationManager :: forall (m :: * -> *) e n s.
MonadIO m =>
Int
-> BChan e -> (EventM n s () -> e) -> m (AnimationManager s e n)
startAnimationManager Int
tickMilliseconds BChan e
_ EventM n s () -> e
_ | Int
tickMilliseconds Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
minTickTime =
    [Char] -> m (AnimationManager s e n)
forall a. HasCallStack => [Char] -> a
error ([Char] -> m (AnimationManager s e n))
-> [Char] -> m (AnimationManager s e n)
forall a b. (a -> b) -> a -> b
$ [Char]
"startAnimationManager: tick duration too small (minimum is " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
minTickTime [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
")"
startAnimationManager Int
tickMilliseconds BChan e
outChan EventM n s () -> e
mkEvent = IO (AnimationManager s e n) -> m (AnimationManager s e n)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (AnimationManager s e n) -> m (AnimationManager s e n))
-> IO (AnimationManager s e n) -> m (AnimationManager s e n)
forall a b. (a -> b) -> a -> b
$ do
    TChan (AnimationManagerRequest s n)
inChan <- IO (TChan (AnimationManagerRequest s n))
forall a. IO (TChan a)
STM.newTChanIO
    ThreadId
reqTid <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ TChan (AnimationManagerRequest s n)
-> BChan e -> (EventM n s () -> e) -> IO ()
forall s n e.
TChan (AnimationManagerRequest s n)
-> BChan e -> (EventM n s () -> e) -> IO ()
animationManagerThreadBody TChan (AnimationManagerRequest s n)
inChan BChan e
outChan EventM n s () -> e
mkEvent
    ThreadId
tickTid <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Int -> TChan (AnimationManagerRequest s n) -> IO ()
forall s n. Int -> TChan (AnimationManagerRequest s n) -> IO ()
tickThreadBody Int
tickMilliseconds TChan (AnimationManagerRequest s n)
inChan
    TVar Bool
runningVar <- Bool -> IO (TVar Bool)
forall a. a -> IO (TVar a)
STM.newTVarIO Bool
True
    AnimationManager s e n -> IO (AnimationManager s e n)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnimationManager s e n -> IO (AnimationManager s e n))
-> AnimationManager s e n -> IO (AnimationManager s e n)
forall a b. (a -> b) -> a -> b
$ AnimationManager { animationMgrRequestThreadId :: ThreadId
animationMgrRequestThreadId = ThreadId
reqTid
                              , animationMgrTickThreadId :: ThreadId
animationMgrTickThreadId = ThreadId
tickTid
                              , animationMgrEventConstructor :: EventM n s () -> e
animationMgrEventConstructor = EventM n s () -> e
mkEvent
                              , animationMgrOutputChan :: BChan e
animationMgrOutputChan = BChan e
outChan
                              , animationMgrInputChan :: TChan (AnimationManagerRequest s n)
animationMgrInputChan = TChan (AnimationManagerRequest s n)
inChan
                              , animationMgrRunning :: TVar Bool
animationMgrRunning = TVar Bool
runningVar
                              }

-- | Execute the specified action only when this manager is running.
whenRunning :: (MonadIO m) => AnimationManager s e n -> IO () -> m ()
whenRunning :: forall (m :: * -> *) s e n.
MonadIO m =>
AnimationManager s e n -> IO () -> m ()
whenRunning AnimationManager s e n
mgr IO ()
act = do
    Bool
running <- IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ STM Bool -> IO Bool
forall a. STM a -> IO a
STM.atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ TVar Bool -> STM Bool
forall a. TVar a -> STM a
STM.readTVar (AnimationManager s e n -> TVar Bool
forall s e n. AnimationManager s e n -> TVar Bool
animationMgrRunning AnimationManager s e n
mgr)
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
running (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
act

-- | Stop the animation manager, ending all running animations.
stopAnimationManager :: (MonadIO m) => AnimationManager s e n -> m ()
stopAnimationManager :: forall (m :: * -> *) s e n.
MonadIO m =>
AnimationManager s e n -> m ()
stopAnimationManager AnimationManager s e n
mgr =
    AnimationManager s e n -> IO () -> m ()
forall (m :: * -> *) s e n.
MonadIO m =>
AnimationManager s e n -> IO () -> m ()
whenRunning AnimationManager s e n
mgr (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        AnimationManager s e n -> AnimationManagerRequest s n -> IO ()
forall (m :: * -> *) s e n.
MonadIO m =>
AnimationManager s e n -> AnimationManagerRequest s n -> m ()
tellAnimationManager AnimationManager s e n
mgr AnimationManagerRequest s n
forall s n. AnimationManagerRequest s n
Shutdown
        ThreadId -> IO ()
killThread (ThreadId -> IO ()) -> ThreadId -> IO ()
forall a b. (a -> b) -> a -> b
$ AnimationManager s e n -> ThreadId
forall s e n. AnimationManager s e n -> ThreadId
animationMgrTickThreadId AnimationManager s e n
mgr
        STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar Bool -> Bool -> STM ()
forall a. TVar a -> a -> STM ()
STM.writeTVar (AnimationManager s e n -> TVar Bool
forall s e n. AnimationManager s e n -> TVar Bool
animationMgrRunning AnimationManager s e n
mgr) Bool
False

-- | Send a request to an animation manager.
tellAnimationManager :: (MonadIO m)
                     => AnimationManager s e n
                     -- ^ The manager
                     -> AnimationManagerRequest s n
                     -- ^ The request to send
                     -> m ()
tellAnimationManager :: forall (m :: * -> *) s e n.
MonadIO m =>
AnimationManager s e n -> AnimationManagerRequest s n -> m ()
tellAnimationManager AnimationManager s e n
mgr AnimationManagerRequest s n
req =
    IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
    STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$
    TChan (AnimationManagerRequest s n)
-> AnimationManagerRequest s n -> STM ()
forall a. TChan a -> a -> STM ()
STM.writeTChan (AnimationManager s e n -> TChan (AnimationManagerRequest s n)
forall s e n.
AnimationManager s e n -> TChan (AnimationManagerRequest s n)
animationMgrInputChan AnimationManager s e n
mgr) AnimationManagerRequest s n
req

-- | Start a new animation at its first frame.
--
-- This will result in an application state update to initialize the
-- animation state at the provided traversal's location.
startAnimation :: (MonadIO m)
               => AnimationManager s e n
               -- ^ The manager to run the animation
               -> Clip s n
               -- ^ The frames for the animation
               -> Integer
               -- ^ The animation's frame duration in milliseconds
               -> RunMode
               -- ^ The animation's run mode
               -> Traversal' s (Maybe (Animation s n))
               -- ^ Where in the application state to manage this
               -- animation's state
               -> m ()
startAnimation :: forall (m :: * -> *) s e n.
MonadIO m =>
AnimationManager s e n
-> Clip s n
-> Integer
-> RunMode
-> Traversal' s (Maybe (Animation s n))
-> m ()
startAnimation AnimationManager s e n
mgr Clip s n
frames Integer
frameMs RunMode
runMode Traversal' s (Maybe (Animation s n))
updater =
    AnimationManager s e n -> AnimationManagerRequest s n -> m ()
forall (m :: * -> *) s e n.
MonadIO m =>
AnimationManager s e n -> AnimationManagerRequest s n -> m ()
tellAnimationManager AnimationManager s e n
mgr (AnimationManagerRequest s n -> m ())
-> AnimationManagerRequest s n -> m ()
forall a b. (a -> b) -> a -> b
$ Clip s n
-> Integer
-> RunMode
-> Traversal' s (Maybe (Animation s n))
-> AnimationManagerRequest s n
forall s n.
Clip s n
-> Integer
-> RunMode
-> Traversal' s (Maybe (Animation s n))
-> AnimationManagerRequest s n
StartAnimation Clip s n
frames Integer
frameMs RunMode
runMode (Maybe (Animation s n) -> f (Maybe (Animation s n))) -> s -> f s
Traversal' s (Maybe (Animation s n))
updater

-- | Stop an animation.
--
-- This will result in an application state update to remove the
-- animation state.
stopAnimation :: (MonadIO m)
              => AnimationManager s e n
              -> Animation s n
              -> m ()
stopAnimation :: forall (m :: * -> *) s e n.
MonadIO m =>
AnimationManager s e n -> Animation s n -> m ()
stopAnimation AnimationManager s e n
mgr Animation s n
a =
    AnimationManager s e n -> AnimationManagerRequest s n -> m ()
forall (m :: * -> *) s e n.
MonadIO m =>
AnimationManager s e n -> AnimationManagerRequest s n -> m ()
tellAnimationManager AnimationManager s e n
mgr (AnimationManagerRequest s n -> m ())
-> AnimationManagerRequest s n -> m ()
forall a b. (a -> b) -> a -> b
$ Animation s n -> AnimationManagerRequest s n
forall s n. Animation s n -> AnimationManagerRequest s n
StopAnimation Animation s n
a