brick 2.6 → 2.7

raw patch · 7 files changed

+922/−6 lines, 7 filesdep +hashabledep +microlens-platformdep +timedep ~basedep ~containersdep ~stmnew-component:exe:brick-animation-demoPVP ok

version bump matches the API change (PVP)

Dependencies added: hashable, microlens-platform, time, unordered-containers

Dependency ranges changed: base, containers, stm, vty

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• README.md +2/−1
• brick.cabal +29/−5
• docs/guide.rst +8/−0
• programs/AnimationDemo.hs +223/−0
• src/Brick/Animation.hs +588/−0
• src/Brick/Animation/Clock.hs +64/−0

@@ -2,6 +2,14 @@ Brick changelog --------------- +2.7+---++This release adds `Brick.Animation`, a module providing infrastructure+for adding animations to Brick interfaces. See the Haddock documentation+in `Brick.Animation` for full details; see `programs/AnimationDemo.hs`+for a working example.+ 2.6 --- 

@@ -56,7 +56,7 @@ | [`brewsage`](https://github.com/gerdreiss/brewsage#readme) | A TUI for Homebrew | | [`brick-trading-journal`](https://codeberg.org/amano.kenji/brick-trading-journal) | A TUI program that calculates basic statistics from trades | | [`Brickudoku`](https://github.com/Thecentury/brickudoku) | A hybrid of Tetris and Sudoku |-| [`cbookview`](https://github.com/mlang/chessIO) | A TUI for exploring polyglot chess opening book files |+| [`cbookview`](https://github.com/mlang/cbookview) | A TUI for exploring polyglot chess opening book files | | [`clifm`](https://github.com/pasqu4le/clifm) | A file manager | | [`codenames-haskell`](https://github.com/VigneshN1997/codenames-haskell) | An implementation of the Codenames game | | [`fifteen`](https://github.com/benjaminselfridge/fifteen) | An implementation of the [15 puzzle](https://en.wikipedia.org/wiki/15_puzzle) |@@ -143,6 +143,7 @@  * Progress bar widget  * Simple dialog box widget  * Border-drawing widgets (put borders around or in between things)+ * Animation support  * Generic scrollable viewports and viewport scroll bars  * General-purpose layout control combinators  * Extensible widget-building API

@@ -1,5 +1,5 @@ name:                brick-version:             2.6+version:             2.7 synopsis:            A declarative terminal user interface library description:   Write terminal user interfaces (TUIs) painlessly with 'brick'! You@@ -46,8 +46,10 @@                       || == 9.0.2                       || == 9.2.8                       || == 9.4.8-                      || == 9.6.3-                      || == 9.8.1+                      || == 9.6.6+                      || == 9.8.4+                      || == 9.10.1+                      || == 9.12.1  extra-doc-files:     README.md,                      docs/guide.rst,@@ -70,6 +72,7 @@   hs-source-dirs:      src   exposed-modules:     Brick+    Brick.Animation     Brick.AttrMap     Brick.BChan     Brick.BorderMap@@ -98,13 +101,14 @@     Brick.Widgets.Table     Data.IMap   other-modules:+    Brick.Animation.Clock     Brick.Types.Common     Brick.Types.TH     Brick.Types.EventM     Brick.Types.Internal     Brick.Widgets.Internal -  build-depends:       base >= 4.9.0.0 && < 4.21.0.0,+  build-depends:       base >= 4.9.0.0 && < 4.22.0.0,                        vty >= 6.0,                        vty-crossplatform,                        bimap >= 0.5 && < 0.6,@@ -126,7 +130,10 @@                        deepseq >= 1.3 && < 1.6,                        unix-compat,                        bytestring,-                       word-wrap >= 0.2+                       word-wrap >= 0.2,+                       unordered-containers,+                       hashable,+                       time  executable brick-custom-keybinding-demo   if !flag(demos)@@ -452,6 +459,23 @@                        microlens-mtl,                        mtl,                        vector++executable brick-animation-demo+  if !flag(demos)+    Buildable: False+  hs-source-dirs:      programs+  ghc-options:         -threaded -Wall -Wcompat -O2+  default-language:    Haskell2010+  main-is:             AnimationDemo.hs+  build-depends:       base,+                       brick,+                       vty,+                       vty-crossplatform,+                       containers,+                       text,+                       microlens-platform,+                       stm,+                       mtl  executable brick-custom-event-demo   if !flag(demos)

@@ -1966,6 +1966,14 @@ so by consulting the ``ctxDynBorders`` field of the rendering context before writing to your ``Result``'s ``borders`` field. +Animations+==========++Brick provides animation support in ``Brick.Animation``. See the Haddock+documentation in that module for a complete explanation of the API; see+``programs/AnimationDemo.hs`` (``brick-animation-demo``) for a working+example.+ The Rendering Cache =================== 

@@ -0,0 +1,223 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RankNTypes #-}+module Main where++import Control.Monad (void)+import Lens.Micro.Platform+import Data.List (intersperse)+#if !(MIN_VERSION_base(4,11,0))+import Data.Monoid+#endif+import qualified Data.Map as M+import qualified Graphics.Vty as V+import Graphics.Vty.CrossPlatform (mkVty)++import Brick.BChan+import Brick.Util (fg)+import Brick.Main (App(..), neverShowCursor, customMain, halt)+import Brick.AttrMap (AttrName, AttrMap, attrMap, attrName)+import Brick.Types (Widget, EventM, BrickEvent(..), Location(..))+import Brick.Widgets.Border (border)+import Brick.Widgets.Center (center)+import Brick.Widgets.Core ((<+>), str, vBox, hBox, hLimit, vLimit, translateBy, withDefAttr)+import qualified Brick.Animation as A++data CustomEvent =+    AnimationUpdate (EventM () St ())+    -- ^ The state update constructor required by the animation API++data St =+    St { _stAnimationManager :: A.AnimationManager St CustomEvent ()+       -- ^ The animation manager that will run all of our animations+       , _animation1 :: Maybe (A.Animation St ())+       , _animation2 :: Maybe (A.Animation St ())+       , _animation3 :: Maybe (A.Animation St ())+       , _clickAnimations :: M.Map Location (A.Animation St ())+       -- ^ The various fields for storing animation states. For mouse+       -- animations, we store animations for each screen location that+       -- was clicked.+       }++makeLenses ''St++drawUI :: St -> [Widget ()]+drawUI st = drawClickAnimations st <> [drawAnimations st]++drawClickAnimations :: St -> [Widget ()]+drawClickAnimations st =+    drawClickAnimation st <$> M.toList (st^.clickAnimations)++drawClickAnimation :: St -> (Location, A.Animation St ()) -> Widget ()+drawClickAnimation st (l, a) =+    translateBy l $+    A.renderAnimation (const $ str " ") st (Just a)++drawAnimations :: St -> Widget ()+drawAnimations st =+    let animStatus label key a =+            str (label <> ": ") <+>+            maybe (str "Not running") (const $ str "Running") a <+>+            str (" (Press " <> key <> " to toggle)")+        statusMessages = statusMessage <$> zip [(0::Int)..] animations+        statusMessage (i, (c, config)) =+            animStatus ("Animation #" <> (show $ i + 1)) [c]+                       (st^.(animationTarget config))+        animationDrawings = hBox $ intersperse (str " ") $+                            drawSingleAnimation <$> animations+        drawSingleAnimation (_, config) =+            A.renderAnimation (const $ str " ") st (st^.(animationTarget config))+    in vBox [ str "Click and drag the mouse or press keys to start animations."+            , str " "+            , vBox statusMessages+            , animationDrawings+            ]++clip1 :: A.Clip a ()+clip1 = A.newClip_ $ str <$> [".", "o", "O", "^", " "]++clip2 :: A.Clip a ()+clip2 = A.newClip_ $ str <$> ["|", "/", "-", "\\"]++clip3 :: A.Clip a ()+clip3 =+    A.newClip_ $+    (hLimit 9 . vLimit 9 . border . center) <$>+    [ border $ str " "+    , border $ vBox $ replicate 3 $ str $ replicate 3 ' '+    , border $ vBox $ replicate 5 $ str $ replicate 5 ' '+    ]++mouseClickClip :: A.Clip a ()+mouseClickClip =+    A.newClip_+    [ withDefAttr attr6 $ str "0"+    , withDefAttr attr5 $ str "O"+    , withDefAttr attr4 $ str "o"+    , withDefAttr attr3 $ str "*"+    , withDefAttr attr2 $ str "~"+    , withDefAttr attr1 $ str "."+    ]++attr6 :: AttrName+attr6 = attrName "attr6"++attr5 :: AttrName+attr5 = attrName "attr5"++attr4 :: AttrName+attr4 = attrName "attr4"++attr3 :: AttrName+attr3 = attrName "attr3"++attr2 :: AttrName+attr2 = attrName "attr2"++attr1 :: AttrName+attr1 = attrName "attr1"++attrs :: AttrMap+attrs =+    attrMap V.defAttr+        [ (attr6, fg V.white)+        , (attr5, fg V.brightYellow)+        , (attr4, fg V.brightGreen)+        , (attr3, fg V.cyan)+        , (attr2, fg V.blue)+        , (attr1, fg V.black)+        ]++-- | Animation settings grouped together for lookup by keystroke.+data AnimationConfig =+    AnimationConfig { animationTarget :: Lens' St (Maybe (A.Animation St ()))+                    , animationClip :: A.Clip St ()+                    , animationFrameTime :: Integer+                    , animationMode :: A.RunMode+                    }++animations :: [(Char, AnimationConfig)]+animations =+    [ ('1', AnimationConfig animation1 clip1 1000 A.Loop)+    , ('2', AnimationConfig animation2 clip2 100 A.Loop)+    , ('3', AnimationConfig animation3 clip3 100 A.Once)+    ]++-- | Start the animation specified by this config.+startAnimationFromConfig :: AnimationConfig -> EventM () St ()+startAnimationFromConfig config = do+    mgr <- use stAnimationManager+    A.startAnimation mgr (animationClip config)+                         (animationFrameTime config)+                         (animationMode config)+                         (animationTarget config)++-- | If the animation specified in this config is not running, start it.+-- Otherwise stop it.+toggleAnimationFromConfig :: AnimationConfig -> EventM () St ()+toggleAnimationFromConfig config = do+    mgr <- use stAnimationManager+    mOld <- use (animationTarget config)+    case mOld of+        Just a -> A.stopAnimation mgr a+        Nothing -> startAnimationFromConfig config++-- | Start a new mouse click animation at the specified location if one+-- is not already running there.+startMouseClickAnimation :: Location -> EventM () St ()+startMouseClickAnimation l = do+    mgr <- use stAnimationManager+    a <- use (clickAnimations.at l)+    case a of+        Just {} -> return ()+        Nothing -> A.startAnimation mgr mouseClickClip 100 A.Once (clickAnimations.at l)++appEvent :: BrickEvent () CustomEvent -> EventM () St ()+appEvent e = do+    case e of+        -- A mouse click starts an animation at the click location.+        VtyEvent (V.EvMouseDown col row _ _) ->+            startMouseClickAnimation (Location (col, row))++        -- If we got a character keystroke, see if there is a specific+        -- animation mapped to that character and toggle the resulting+        -- animation.+        VtyEvent (V.EvKey (V.KChar c) [])+            | Just aConfig <- lookup c animations ->+                toggleAnimationFromConfig aConfig++        -- Apply a state update from the animation manager.+        AppEvent (AnimationUpdate act) -> act++        VtyEvent (V.EvKey V.KEsc []) -> halt++        _ -> return ()++theApp :: App St CustomEvent ()+theApp =+    App { appDraw = drawUI+        , appChooseCursor = neverShowCursor+        , appHandleEvent = appEvent+        , appStartEvent = return ()+        , appAttrMap = const attrs+        }++main :: IO ()+main = do+    chan <- newBChan 10+    mgr <- A.startAnimationManager 50 chan AnimationUpdate++    let initialState =+            St { _stAnimationManager = mgr+               , _animation1 = Nothing+               , _animation2 = Nothing+               , _animation3 = Nothing+               , _clickAnimations = mempty+               }+        buildVty = do+            v <- mkVty V.defaultConfig+            V.setMode (V.outputIface v) V.Mouse True+            return v++    initialVty <- buildVty+    void $ customMain initialVty buildVty (Just chan) theApp initialState

@@ -0,0 +1,588 @@+{-# 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 (Semigroup)++-- | Get the number of frames in a clip.+clipLength :: Clip s n -> Int+clipLength (Clip fs) = V.length 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 [] = error "clip: got an empty list"+newClip fs = Clip $ V.fromList fs++-- | Like 'newClip' but for static frames.+newClip_ :: [Widget n] -> Clip s n+newClip_ ws = newClip $ const <$> 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 (Clip fs) | V.length fs >= 2 =+    Clip $ fs <> V.reverse (V.init $ V.tail fs)+pingPongClip c = c++-- | Reverse a clip.+reverseClip :: Clip s n -> Clip s n+reverseClip (Clip fs) = Clip $ V.reverse 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 (Eq, Show, Ord)++newtype AnimationID = AnimationID Int+                    deriving (Eq, Ord, Show, 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 { animationFrameIndex :: Int+              -- ^ The animation's current frame index, provided for+              -- convenience. Applications won't need to access this in+              -- most situations; use 'renderAnimation' instead.+              , animationID :: AnimationID+              -- ^ The animation's internally-managed ID+              , 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 fallback input mAnim =+    draw input+    where+        draw = fromMaybe fallback $ do+            a <- mAnim+            let idx = animationFrameIndex a+                Clip fs = animationClip a+            fs V.!? idx++data AnimationState s n =+    AnimationState { _animationStateID :: AnimationID+                   , _animationNumFrames :: Int+                   , _animationCurrentFrame :: Int+                   , _animationFrameMilliseconds :: Integer+                   , _animationRunMode :: RunMode+                   , animationFrameUpdater :: Traversal' s (Maybe (Animation s n))+                   , _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 { animationMgrRequestThreadId :: ThreadId+                     , animationMgrTickThreadId :: ThreadId+                     , animationMgrOutputChan :: BChan e+                     , animationMgrInputChan :: STM.TChan (AnimationManagerRequest s n)+                     , animationMgrEventConstructor :: EventM n s () -> e+                     , animationMgrRunning :: STM.TVar Bool+                     }++tickThreadBody :: Int+               -> STM.TChan (AnimationManagerRequest s n)+               -> IO ()+tickThreadBody tickMilliseconds outChan = do+    let nextTick = C.addOffset tickOffset+        tickOffset = C.offsetFromMs $ toInteger tickMilliseconds+        go targetTime = do+            now <- C.getTime+            STM.atomically $ STM.writeTChan outChan $ Tick 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 = nextTick targetTime+                sleepMs = fromInteger $+                          C.offsetToMs $+                          C.subtractTime nextTickTime now++            -- threadDelay works microseconds.+            threadDelay $ sleepMs * 1000+            go nextTickTime++    go =<< C.getTime++setNextFrameTime :: C.Time -> AnimationState s n -> AnimationState s n+setNextFrameTime t a = a & animationNextFrameTime .~ t++data ManagerState s e n =+    ManagerState { _managerStateInChan :: STM.TChan (AnimationManagerRequest s n)+                 , _managerStateOutChan :: BChan e+                 , _managerStateEventBuilder :: EventM n s () -> e+                 , _managerStateAnimations :: HM.HashMap AnimationID (AnimationState s n)+                 , _managerStateIDVar :: STM.TVar AnimationID+                 }++makeLenses ''ManagerState++animationManagerThreadBody :: STM.TChan (AnimationManagerRequest s n)+                           -> BChan e+                           -> (EventM n s () -> e)+                           -> IO ()+animationManagerThreadBody inChan outChan mkEvent = do+    idVar <- STM.newTVarIO $ AnimationID 1+    let initial = ManagerState { _managerStateInChan = inChan+                               , _managerStateOutChan = outChan+                               , _managerStateEventBuilder = mkEvent+                               , _managerStateAnimations = mempty+                               , _managerStateIDVar = idVar+                               }+    evalStateT runManager initial++type ManagerM s e n a = StateT (ManagerState s e n) IO a++getNextManagerRequest :: ManagerM s e n (AnimationManagerRequest s n)+getNextManagerRequest = do+    inChan <- use managerStateInChan+    liftIO $ STM.atomically $ STM.readTChan inChan++sendApplicationStateUpdate :: EventM n s () -> ManagerM s e n ()+sendApplicationStateUpdate act = do+    outChan <- use managerStateOutChan+    mkEvent <- use managerStateEventBuilder+    liftIO $ writeBChan outChan $ mkEvent act++removeAnimation :: AnimationID -> ManagerM s e n ()+removeAnimation aId =+    managerStateAnimations %= HM.delete aId++lookupAnimation :: AnimationID -> ManagerM s e n (Maybe (AnimationState s n))+lookupAnimation aId =+    HM.lookup aId <$> use managerStateAnimations++insertAnimation :: AnimationState s n -> ManagerM s e n ()+insertAnimation a =+    managerStateAnimations %= HM.insert (a^.animationStateID) a++getNextAnimationID :: ManagerM s e n AnimationID+getNextAnimationID = do+    var <- use managerStateIDVar+    liftIO $ STM.atomically $ do+        AnimationID i <- STM.readTVar var+        let next = AnimationID $ i + 1+        STM.writeTVar var next+        return $ AnimationID i++runManager :: ManagerM s e n ()+runManager = forever $ do+    getNextManagerRequest >>= handleManagerRequest++handleManagerRequest :: AnimationManagerRequest s n -> ManagerM s e n ()+handleManagerRequest (StartAnimation clip frameMs runMode updater) = do+    aId <- getNextAnimationID+    now <- liftIO C.getTime+    let next = C.addOffset frameOffset now+        frameOffset = C.offsetFromMs frameMs+        a = AnimationState { _animationStateID = aId+                           , _animationNumFrames = clipLength clip+                           , _animationCurrentFrame = 0+                           , _animationFrameMilliseconds = frameMs+                           , _animationRunMode = runMode+                           , animationFrameUpdater = updater+                           , _animationNextFrameTime = next+                           }++    insertAnimation a+    sendApplicationStateUpdate $ updater .= Just (Animation { animationID = aId+                                                            , animationFrameIndex = 0+                                                            , animationClip = clip+                                                            })+handleManagerRequest (StopAnimation a) = do+    let aId = animationID a+    mA <- lookupAnimation aId+    case mA of+        Nothing -> return ()+        Just aState -> do+            -- Remove the animation from the manager+            removeAnimation aId++            -- Set the current animation state in the application state+            -- to none+            sendApplicationStateUpdate $ clearStateAction aState+handleManagerRequest Shutdown = do+    as <- HM.elems <$> use managerStateAnimations++    let updater = sequence_ $ clearStateAction <$> as+    when (not $ null as) $ do+        sendApplicationStateUpdate updater++    liftIO $ myThreadId >>= killThread+handleManagerRequest (Tick tickTime) = do+    -- Check all animation states for frame advances+    -- based on the relationship between the tick time+    -- and each animation's next frame time+    mUpdateAct <- checkAnimations tickTime+    case mUpdateAct of+        Nothing -> return ()+        Just act -> sendApplicationStateUpdate act++clearStateAction :: AnimationState s n -> EventM n s ()+clearStateAction a = animationFrameUpdater a .= Nothing++frameUpdateAction :: AnimationState s n -> EventM n s ()+frameUpdateAction a =+    animationFrameUpdater a._Just %=+        (\an -> an { animationFrameIndex = a^.animationCurrentFrame })++updateAnimationState :: C.Time -> AnimationState s n -> AnimationState s n+updateAnimationState now a =+    let differenceMs = C.offsetToMs $+                       C.subtractTime now (a^.animationNextFrameTime)+        numFrames = 1 + (differenceMs `div` (a^.animationFrameMilliseconds))+        newNextTime = C.addOffset (C.offsetFromMs $ numFrames * (a^.animationFrameMilliseconds))+                                  (a^.animationNextFrameTime)++    -- The new frame is obtained by advancing from the current frame by+    -- numFrames.+    in setNextFrameTime newNextTime $ advanceBy numFrames a++checkAnimations :: C.Time -> ManagerM s e n (Maybe (EventM n s ()))+checkAnimations now = do+    let go a updaters = do+          result <- checkAnimation now a+          return $ case result of+              Nothing -> updaters+              Just u  -> u : updaters++    anims <- use managerStateAnimations+    updaters <- foldrM go [] anims++    case updaters of+        [] -> return Nothing+        _ -> return $ Just $ sequence_ 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 now a+    | isFinished a = do+        -- This animation completed in a previous check, so clear it+        -- from the manager and the application state.+        removeAnimation (a^.animationStateID)+        return $ Just $ clearStateAction a+    | (now < a^.animationNextFrameTime) =+        -- This animation is not due for an update, so don't do+        -- anything.+        return Nothing+    | 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' = updateAnimationState now a+        managerStateAnimations %= HM.insert (a'^.animationStateID) a'+        return $ Just $ frameUpdateAction a'++isFinished :: AnimationState s n -> Bool+isFinished a =+    case a^.animationRunMode of+        Once -> a^.animationCurrentFrame == a^.animationNumFrames - 1+        Loop -> False++advanceBy :: Integer -> AnimationState s n -> AnimationState s n+advanceBy n a+    | n <= 0 = a+    | otherwise =+        advanceBy (n - 1) $+        advanceByOne a++advanceByOne :: AnimationState s n -> AnimationState s n+advanceByOne a =+    if a^.animationCurrentFrame == a^.animationNumFrames - 1+    then case a^.animationRunMode of+        Loop -> a & animationCurrentFrame .~ 0+        Once -> a+    else a & animationCurrentFrame %~ (+ 1)++-- | The minimum tick duration in milliseconds allowed by+-- 'startAnimationManager'.+minTickTime :: Int+minTickTime = 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 tickMilliseconds _ _ | tickMilliseconds < minTickTime =+    error $ "startAnimationManager: tick duration too small (minimum is " <> show minTickTime <> ")"+startAnimationManager tickMilliseconds outChan mkEvent = liftIO $ do+    inChan <- STM.newTChanIO+    reqTid <- forkIO $ animationManagerThreadBody inChan outChan mkEvent+    tickTid <- forkIO $ tickThreadBody tickMilliseconds inChan+    runningVar <- STM.newTVarIO True+    return $ AnimationManager { animationMgrRequestThreadId = reqTid+                              , animationMgrTickThreadId = tickTid+                              , animationMgrEventConstructor = mkEvent+                              , animationMgrOutputChan = outChan+                              , animationMgrInputChan = inChan+                              , animationMgrRunning = runningVar+                              }++-- | Execute the specified action only when this manager is running.+whenRunning :: (MonadIO m) => AnimationManager s e n -> IO () -> m ()+whenRunning mgr act = do+    running <- liftIO $ STM.atomically $ STM.readTVar (animationMgrRunning mgr)+    when running $ liftIO act++-- | Stop the animation manager, ending all running animations.+stopAnimationManager :: (MonadIO m) => AnimationManager s e n -> m ()+stopAnimationManager mgr =+    whenRunning mgr $ do+        tellAnimationManager mgr Shutdown+        killThread $ animationMgrTickThreadId mgr+        STM.atomically $ STM.writeTVar (animationMgrRunning mgr) 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 mgr req =+    liftIO $+    STM.atomically $+    STM.writeTChan (animationMgrInputChan mgr) 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 mgr frames frameMs runMode updater =+    tellAnimationManager mgr $ StartAnimation frames frameMs runMode 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 mgr a =+    tellAnimationManager mgr $ StopAnimation a

@@ -0,0 +1,64 @@+-- | This module provides an API for working with+-- 'Data.Time.Clock.System.SystemTime' values similar to that of+-- 'Data.Time.Clock.UTCTime'. @SystemTime@s are more efficient to+-- obtain than @UTCTime@s, which is important to avoid animation+-- tick thread delays associated with expensive clock reads. In+-- addition, the @UTCTime@-based API provides unpleasant @Float@-based+-- conversions. Since the @SystemTime@-based API doesn't provide some+-- of the operations we need, and since it is easier to work with at+-- millisecond granularity, it is extended here for internal use.+module Brick.Animation.Clock+  ( Time+  , getTime+  , addOffset+  , subtractTime++  , Offset+  , offsetFromMs+  , offsetToMs+  )+where++import Control.Monad.IO.Class (MonadIO, liftIO)+import qualified Data.Time.Clock.System as C++newtype Time = Time C.SystemTime+             deriving (Ord, Eq)++-- | Signed difference in milliseconds+newtype Offset = Offset Integer+               deriving (Ord, Eq)++offsetFromMs :: Integer -> Offset+offsetFromMs = Offset++offsetToMs :: Offset -> Integer+offsetToMs (Offset ms) = ms++getTime :: (MonadIO m) => m Time+getTime = Time <$> liftIO C.getSystemTime++addOffset :: Offset -> Time -> Time+addOffset (Offset ms) (Time (C.MkSystemTime s ns)) =+    Time $ C.MkSystemTime (fromInteger s') (fromInteger ns')+    where+        -- Note that due to the behavior of divMod, this works even when+        -- the offset is negative: the number of seconds is decremented+        -- and the remainder of nanoseconds is correct.+        s' = newSec + toInteger s+        (newSec, ns') = (nsPerMs * ms + toInteger ns)+                          `divMod` (msPerS * nsPerMs)++subtractTime :: Time -> Time -> Offset+subtractTime t1 t2 = Offset $ timeToMs t1 - timeToMs t2++timeToMs :: Time -> Integer+timeToMs (Time (C.MkSystemTime s ns)) =+    (toInteger s) * msPerS ++    (toInteger ns) `div` nsPerMs++nsPerMs :: Integer+nsPerMs = 1000000++msPerS :: Integer+msPerS = 1000