From 7a285cf11004559ef4ed598531b43b2938b25540 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Tue, 26 Nov 2024 15:46:06 -0800 Subject: [PATCH 001/134] Add rough/incomplete sketch of some ideas for an animation system --- brick.cabal | 18 ++++ programs/AnimationDemo.hs | 208 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 226 insertions(+) create mode 100644 programs/AnimationDemo.hs diff --git a/brick.cabal b/brick.cabal index 7c418995..ce24ed38 100644 --- a/brick.cabal +++ b/brick.cabal @@ -453,6 +453,24 @@ executable brick-list-vi-demo 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, + text, + microlens >= 0.3.0.0, + microlens-th, + microlens-mtl, + stm, + unordered-containers, + hashable + executable brick-custom-event-demo if !flag(demos) Buildable: False diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs new file mode 100644 index 00000000..1daf9207 --- /dev/null +++ b/programs/AnimationDemo.hs @@ -0,0 +1,208 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE RankNTypes #-} +module Main where + +import Lens.Micro ((^.), Traversal') +import Lens.Micro.TH (makeLenses) +import Lens.Micro.Mtl +import Control.Monad (void, forever) +import Control.Concurrent (threadDelay, forkIO, ThreadId) +import Data.Hashable (Hashable) +import qualified Data.HashMap.Strict as HM +import qualified Control.Concurrent.STM as STM +#if !(MIN_VERSION_base(4,11,0)) +import Data.Monoid +#endif +import qualified Graphics.Vty as V + +import Brick.BChan +import Brick.Main + ( App(..) + , showFirstCursor + , customMainWithDefaultVty + , halt + ) +import Brick.AttrMap + ( attrMap + ) +import Brick.Types + ( Widget + , EventM + , BrickEvent(..) + ) +import Brick.Widgets.Core + ( (<=>) + , str + ) + +data CustomEvent = Counter deriving Show + +data St = + St { _stLastBrickEvent :: Maybe (BrickEvent () CustomEvent) + , _stCounter :: Int + } + +makeLenses ''St + +drawUI :: St -> [Widget ()] +drawUI st = [a] + where + a = (str $ "Last event: " <> (show $ st^.stLastBrickEvent)) + <=> + (str $ "Counter value is: " <> (show $ st^.stCounter)) + +appEvent :: BrickEvent () CustomEvent -> EventM () St () +appEvent e = + case e of + VtyEvent (V.EvKey V.KEsc []) -> halt + VtyEvent _ -> stLastBrickEvent .= (Just e) + AppEvent Counter -> do + stCounter %= (+1) + stLastBrickEvent .= (Just e) + _ -> return () + +initialState :: St +initialState = + St { _stLastBrickEvent = Nothing + , _stCounter = 0 + } + +theApp :: App St CustomEvent () +theApp = + App { appDraw = drawUI + , appChooseCursor = showFirstCursor + , appHandleEvent = appEvent + , appStartEvent = return () + , appAttrMap = const $ attrMap V.defAttr [] + } + +data AnimationManagerRequest s = + Tick + | StartAnimation (Animation s) + | StopAnimation AnimationID + | Shutdown + +data Duration = + Infinite + | Loop Int + deriving (Eq, Show, Ord) + +data AnimationMode = + Forward + -- | Backward + -- | PingPong + -- | Random + deriving (Eq, Show, Ord) + +data Animation s = + Animation { animationID :: AnimationID + , animationNumFrames :: Int + , animationCurrentFrame :: Int + , animationPreviousFrame :: Maybe Int + -- what about tracking that an animation is currently + -- moving backward when it sometimes moves forward? Just + -- track the previous frame always, and use that? that + -- works in general (can be ignored in the random case but + -- is used in all others) + , animationMode :: AnimationMode + , animationDuration :: Duration + , animationFrameUpdater :: Traversal' s (Maybe Int) + } + +newtype AnimationID = AnimationID Int + deriving (Eq, Ord, Show, Hashable) + +data AnimationManager s e n = + AnimationManager { animationMgrRequestThreadId :: ThreadId + , animationMgrTickThreadId :: ThreadId + , animationMgrOutputChan :: BChan e + , animationMgrInputChan :: STM.TChan (AnimationManagerRequest s) + , animationMgrEventConstructor :: EventM n s () -> e + , animationMgrMillisecondsPerTick :: Int + , animationMgrNextAnimationID :: STM.TVar AnimationID + } + +tickThreadBody :: Int + -> STM.TChan (AnimationManagerRequest s) + -> IO () +tickThreadBody msPerTick outChan = + forever $ do + threadDelay $ msPerTick * 1000 + STM.atomically $ STM.writeTChan outChan Tick + +animationManagerThreadBody :: STM.TChan (AnimationManagerRequest s) + -> BChan e + -> (EventM n s () -> e) + -> IO () +animationManagerThreadBody inChan outChan mkEvent = + let initialState :: HM.HashMap AnimationID (Animation s) + initialState = mempty + + loop st = do + req <- STM.atomically $ STM.readTChan inChan + case req of + StartAnimation a -> + loop $ HM.insert (animationID a) a st + + StopAnimation aId -> + -- TODO: update the application state here + loop $ HM.delete aId st + + Tick -> + -- Check all animation states for frame advances + return () + + Shutdown -> + return () + + in loop initialState + +-- When a tick occurs: +-- for each currently-running animation, +-- check to see if the animation should advance and if so by how much +-- if it advances at all, schedule that animation state to be updated +-- if any animations have advanced, send an event to the application to +-- update the animation states involved and redraw +-- +-- Meanwhile, we can also receive requests from the application to: +-- +-- * start a new free-running animation +-- * start a manually-controlled animation +-- * remove an animation (effectively stopping it) +-- * shut down entirely + +startAnimationManager :: Int -> BChan e -> (EventM n s () -> e) -> IO (AnimationManager s e n) +startAnimationManager msPerTick outChan mkEvent = do + inChan <- STM.newTChanIO + reqTid <- forkIO $ animationManagerThreadBody inChan outChan mkEvent + tickTid <- forkIO $ tickThreadBody msPerTick inChan + idVar <- STM.newTVarIO $ AnimationID 1 + return $ AnimationManager { animationMgrRequestThreadId = reqTid + , animationMgrTickThreadId = tickTid + , animationMgrEventConstructor = mkEvent + , animationMgrOutputChan = outChan + , animationMgrInputChan = inChan + , animationMgrMillisecondsPerTick = msPerTick + , animationMgrNextAnimationID = idVar + } + +stopAnimationManager :: AnimationManager s e n -> IO () +stopAnimationManager mgr = tellAnimationManager mgr Shutdown + +tellAnimationManager :: AnimationManager s e n -> AnimationManagerRequest s -> IO () +tellAnimationManager mgr req = + STM.atomically $ + STM.writeTChan (animationMgrInputChan mgr) req + +main :: IO () +main = do + chan <- newBChan 10 + + void $ forkIO $ forever $ do + writeBChan chan Counter + threadDelay 1000000 + + void $ customMainWithDefaultVty (Just chan) theApp initialState From d31761a7c8af54cde71dd6d5b011145c4698bf03 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Wed, 27 Nov 2024 12:46:59 -0800 Subject: [PATCH 002/134] AnimationDemo: fleshing out more --- brick.cabal | 3 +- programs/AnimationDemo.hs | 77 ++++++++++++++++++++++++++++++--------- 2 files changed, 61 insertions(+), 19 deletions(-) diff --git a/brick.cabal b/brick.cabal index ce24ed38..24dd935e 100644 --- a/brick.cabal +++ b/brick.cabal @@ -469,7 +469,8 @@ executable brick-animation-demo microlens-mtl, stm, unordered-containers, - hashable + hashable, + time executable brick-custom-event-demo if !flag(demos) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 1daf9207..cfd6a5f0 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -8,9 +8,10 @@ module Main where import Lens.Micro ((^.), Traversal') import Lens.Micro.TH (makeLenses) import Lens.Micro.Mtl -import Control.Monad (void, forever) -import Control.Concurrent (threadDelay, forkIO, ThreadId) +import Control.Monad (void, forever, when) +import Control.Concurrent (threadDelay, forkIO, ThreadId, killThread) import Data.Hashable (Hashable) +import Data.Time.Clock (UTCTime, NominalDiffTime, addUTCTime, getCurrentTime) import qualified Data.HashMap.Strict as HM import qualified Control.Concurrent.STM as STM #if !(MIN_VERSION_base(4,11,0)) @@ -80,7 +81,7 @@ theApp = } data AnimationManagerRequest s = - Tick + Tick UTCTime | StartAnimation (Animation s) | StopAnimation AnimationID | Shutdown @@ -102,6 +103,7 @@ data Animation s = , animationNumFrames :: Int , animationCurrentFrame :: Int , animationPreviousFrame :: Maybe Int + , animationFrameMilliseconds :: Integer -- what about tracking that an animation is currently -- moving backward when it sometimes moves forward? Just -- track the previous frame always, and use that? that @@ -110,6 +112,7 @@ data Animation s = , animationMode :: AnimationMode , animationDuration :: Duration , animationFrameUpdater :: Traversal' s (Maybe Int) + , animationNextFrameTime :: UTCTime } newtype AnimationID = AnimationID Int @@ -121,17 +124,28 @@ data AnimationManager s e n = , animationMgrOutputChan :: BChan e , animationMgrInputChan :: STM.TChan (AnimationManagerRequest s) , animationMgrEventConstructor :: EventM n s () -> e - , animationMgrMillisecondsPerTick :: Int , animationMgrNextAnimationID :: STM.TVar AnimationID + , animationMgrRunning :: STM.TVar Bool } -tickThreadBody :: Int - -> STM.TChan (AnimationManagerRequest s) +-- NOTE: should figure out if this should be configurable and, if so, +-- whether it should be bounded in any way to avoid pitfalls. +tickMilliseconds :: Int +tickMilliseconds = 100 + +tickThreadBody :: STM.TChan (AnimationManagerRequest s) -> IO () -tickThreadBody msPerTick outChan = +tickThreadBody outChan = forever $ do - threadDelay $ msPerTick * 1000 - STM.atomically $ STM.writeTChan outChan Tick + threadDelay $ tickMilliseconds * 1000 + now <- getCurrentTime + STM.atomically $ STM.writeTChan outChan $ Tick now + +setNextFrameTime :: UTCTime -> Animation s -> Animation s +setNextFrameTime t a = a { animationNextFrameTime = t } + +nominalDiffFromMs :: Integer -> NominalDiffTime +nominalDiffFromMs i = realToFrac (fromIntegral i / (100.0::Float)) animationManagerThreadBody :: STM.TChan (AnimationManagerRequest s) -> BChan e @@ -144,22 +158,37 @@ animationManagerThreadBody inChan outChan mkEvent = loop st = do req <- STM.atomically $ STM.readTChan inChan case req of - StartAnimation a -> - loop $ HM.insert (animationID a) a st + StartAnimation a -> do + -- Schedule the animation, setting its next frame time. + now <- getCurrentTime + let next = addUTCTime frameOffset now + frameOffset = nominalDiffFromMs (animationFrameMilliseconds a) + loop $ HM.insert (animationID a) (setNextFrameTime next a) st StopAnimation aId -> -- TODO: update the application state here loop $ HM.delete aId st - Tick -> + Tick tickTime -> do -- Check all animation states for frame advances - return () + -- based on the relationship between the tick time + -- and each animation's next frame time + let (advanced, st') = checkForFrames tickTime st + when (not $ null advanced) $ + writeBChan outChan $ mkEvent $ return () + + loop st' Shutdown -> return () in loop initialState +checkForFrames :: UTCTime + -> HM.HashMap AnimationID (Animation s) + -> ([AnimationID], HM.HashMap AnimationID (Animation s)) +checkForFrames _ m = ([], m) + -- When a tick occurs: -- for each currently-running animation, -- check to see if the animation should advance and if so by how much @@ -174,23 +203,35 @@ animationManagerThreadBody inChan outChan mkEvent = -- * remove an animation (effectively stopping it) -- * shut down entirely -startAnimationManager :: Int -> BChan e -> (EventM n s () -> e) -> IO (AnimationManager s e n) -startAnimationManager msPerTick outChan mkEvent = do +startAnimationManager :: BChan e -> (EventM n s () -> e) -> IO (AnimationManager s e n) +startAnimationManager outChan mkEvent = do inChan <- STM.newTChanIO reqTid <- forkIO $ animationManagerThreadBody inChan outChan mkEvent - tickTid <- forkIO $ tickThreadBody msPerTick inChan + tickTid <- forkIO $ tickThreadBody inChan + runningVar <- STM.newTVarIO True idVar <- STM.newTVarIO $ AnimationID 1 return $ AnimationManager { animationMgrRequestThreadId = reqTid , animationMgrTickThreadId = tickTid , animationMgrEventConstructor = mkEvent , animationMgrOutputChan = outChan , animationMgrInputChan = inChan - , animationMgrMillisecondsPerTick = msPerTick , animationMgrNextAnimationID = idVar + , animationMgrRunning = runningVar } +whenRunning :: AnimationManager s e n -> IO () -> IO () +whenRunning mgr act = do + running <- STM.atomically $ STM.readTVar (animationMgrRunning mgr) + when running act + stopAnimationManager :: AnimationManager s e n -> IO () -stopAnimationManager mgr = tellAnimationManager mgr Shutdown +stopAnimationManager mgr = + whenRunning mgr $ do + let reqTid = animationMgrRequestThreadId mgr + tickTid = animationMgrTickThreadId mgr + killThread reqTid + killThread tickTid + STM.atomically $ STM.writeTVar (animationMgrRunning mgr) False tellAnimationManager :: AnimationManager s e n -> AnimationManagerRequest s -> IO () tellAnimationManager mgr req = From 1ffb891c9fa5bd88b663a80bebaf88b605559097 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Wed, 27 Nov 2024 12:54:13 -0800 Subject: [PATCH 003/134] AnimationDemo: refactor manager thread to run in StateT --- brick.cabal | 3 ++- programs/AnimationDemo.hs | 32 ++++++++++++++++---------------- 2 files changed, 18 insertions(+), 17 deletions(-) diff --git a/brick.cabal b/brick.cabal index 24dd935e..28368f68 100644 --- a/brick.cabal +++ b/brick.cabal @@ -470,7 +470,8 @@ executable brick-animation-demo stm, unordered-containers, hashable, - time + time, + mtl executable brick-custom-event-demo if !flag(demos) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index cfd6a5f0..ba8aa1c2 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -3,6 +3,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} module Main where import Lens.Micro ((^.), Traversal') @@ -10,6 +11,7 @@ import Lens.Micro.TH (makeLenses) import Lens.Micro.Mtl import Control.Monad (void, forever, when) import Control.Concurrent (threadDelay, forkIO, ThreadId, killThread) +import Control.Monad.State.Strict import Data.Hashable (Hashable) import Data.Time.Clock (UTCTime, NominalDiffTime, addUTCTime, getCurrentTime) import qualified Data.HashMap.Strict as HM @@ -152,42 +154,40 @@ animationManagerThreadBody :: STM.TChan (AnimationManagerRequest s) -> (EventM n s () -> e) -> IO () animationManagerThreadBody inChan outChan mkEvent = - let initialState :: HM.HashMap AnimationID (Animation s) - initialState = mempty - - loop st = do - req <- STM.atomically $ STM.readTChan inChan + let run = do + req <- liftIO $ STM.atomically $ STM.readTChan inChan case req of StartAnimation a -> do -- Schedule the animation, setting its next frame time. - now <- getCurrentTime + now <- liftIO getCurrentTime let next = addUTCTime frameOffset now frameOffset = nominalDiffFromMs (animationFrameMilliseconds a) - loop $ HM.insert (animationID a) (setNextFrameTime next a) st + modify $ HM.insert (animationID a) (setNextFrameTime next a) + run - StopAnimation aId -> + StopAnimation aId -> do -- TODO: update the application state here - loop $ HM.delete aId st + modify $ HM.delete aId + run 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 - let (advanced, st') = checkForFrames tickTime st + advanced <- checkForFrames tickTime when (not $ null advanced) $ - writeBChan outChan $ mkEvent $ return () + liftIO $ writeBChan outChan $ mkEvent $ return () - loop st' + run Shutdown -> return () - in loop initialState + in evalStateT run mempty checkForFrames :: UTCTime - -> HM.HashMap AnimationID (Animation s) - -> ([AnimationID], HM.HashMap AnimationID (Animation s)) -checkForFrames _ m = ([], m) + -> StateT (HM.HashMap AnimationID (Animation s)) IO [AnimationID] +checkForFrames _ = return [] -- When a tick occurs: -- for each currently-running animation, From 362331cb9ec07c4f392481955fec4a7cbcc52636 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Wed, 27 Nov 2024 13:02:32 -0800 Subject: [PATCH 004/134] AnimationDemo: clear current frame from application state on StopAnimation --- programs/AnimationDemo.hs | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index ba8aa1c2..1645a86b 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -166,8 +166,19 @@ animationManagerThreadBody inChan outChan mkEvent = run StopAnimation aId -> do - -- TODO: update the application state here - modify $ HM.delete aId + mA <- gets (HM.lookup aId) + case mA of + Nothing -> return () + Just a -> do + -- Remove the animation from the manager + modify $ HM.delete aId + + -- Set the current frame in the application + -- state to none + liftIO $ writeBChan outChan $ + mkEvent $ do + animationFrameUpdater a .= Nothing + run Tick tickTime -> do From 35bb82d28f07163780f7a9bc778c030977addd83 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Wed, 27 Nov 2024 13:02:46 -0800 Subject: [PATCH 005/134] Whitespace --- programs/AnimationDemo.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 1645a86b..884b865b 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -188,7 +188,6 @@ animationManagerThreadBody inChan outChan mkEvent = advanced <- checkForFrames tickTime when (not $ null advanced) $ liftIO $ writeBChan outChan $ mkEvent $ return () - run Shutdown -> From 9bfc7a1dec25859b4ae27c35d5098960f2bfd980 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Wed, 27 Nov 2024 13:03:30 -0800 Subject: [PATCH 006/134] AnimationDemo: remove explicit Shutdown manager request in lieu of thread kills --- programs/AnimationDemo.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 884b865b..53001064 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -86,7 +86,6 @@ data AnimationManagerRequest s = Tick UTCTime | StartAnimation (Animation s) | StopAnimation AnimationID - | Shutdown data Duration = Infinite @@ -190,9 +189,6 @@ animationManagerThreadBody inChan outChan mkEvent = liftIO $ writeBChan outChan $ mkEvent $ return () run - Shutdown -> - return () - in evalStateT run mempty checkForFrames :: UTCTime From 89d838b1f429c40a45fd723d2f05c8441c74fe19 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Wed, 27 Nov 2024 13:15:06 -0800 Subject: [PATCH 007/134] AnimationDemo: make manager state updates abstract, remove explicit tail recursion --- programs/AnimationDemo.hs | 114 +++++++++++++++++++++++++------------- 1 file changed, 74 insertions(+), 40 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 53001064..a942b3da 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -148,51 +148,85 @@ setNextFrameTime t a = a { animationNextFrameTime = t } nominalDiffFromMs :: Integer -> NominalDiffTime nominalDiffFromMs i = realToFrac (fromIntegral i / (100.0::Float)) +data ManagerState s e n = + ManagerState { managerStateInChan :: STM.TChan (AnimationManagerRequest s) + , managerStateOutChan :: BChan e + , managerStateEventBuilder :: EventM n s () -> e + , managerStateAnimations :: HM.HashMap AnimationID (Animation s) + } + animationManagerThreadBody :: STM.TChan (AnimationManagerRequest s) -> BChan e -> (EventM n s () -> e) -> IO () animationManagerThreadBody inChan outChan mkEvent = - let run = do - req <- liftIO $ STM.atomically $ STM.readTChan inChan - case req of - StartAnimation a -> do - -- Schedule the animation, setting its next frame time. - now <- liftIO getCurrentTime - let next = addUTCTime frameOffset now - frameOffset = nominalDiffFromMs (animationFrameMilliseconds a) - modify $ HM.insert (animationID a) (setNextFrameTime next a) - run - - StopAnimation aId -> do - mA <- gets (HM.lookup aId) - case mA of - Nothing -> return () - Just a -> do - -- Remove the animation from the manager - modify $ HM.delete aId - - -- Set the current frame in the application - -- state to none - liftIO $ writeBChan outChan $ - mkEvent $ do - animationFrameUpdater a .= Nothing - - run - - 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 - advanced <- checkForFrames tickTime - when (not $ null advanced) $ - liftIO $ writeBChan outChan $ mkEvent $ return () - run - - in evalStateT run mempty - -checkForFrames :: UTCTime - -> StateT (HM.HashMap AnimationID (Animation s)) IO [AnimationID] + let initial = ManagerState { managerStateInChan = inChan + , managerStateOutChan = outChan + , managerStateEventBuilder = mkEvent + , managerStateAnimations = mempty + } + in evalStateT runManager initial + +type ManagerM s e n a = StateT (ManagerState s e n) IO a + +getNextManagerRequest :: ManagerM s e n (AnimationManagerRequest s) +getNextManagerRequest = do + inChan <- gets managerStateInChan + liftIO $ STM.atomically $ STM.readTChan inChan + +sendApplicationEvent :: EventM n s () -> ManagerM s e n () +sendApplicationEvent act = do + outChan <- gets managerStateOutChan + mkEvent <- gets managerStateEventBuilder + liftIO $ writeBChan outChan $ mkEvent act + +removeAnimation :: AnimationID -> ManagerM s e n () +removeAnimation aId = + modify $ \s -> + s { managerStateAnimations = HM.delete aId (managerStateAnimations s) } + +lookupAnimation :: AnimationID -> ManagerM s e n (Maybe (Animation s)) +lookupAnimation aId = + gets (HM.lookup aId . managerStateAnimations) + +insertAnimation :: Animation s -> ManagerM s e n () +insertAnimation a = + modify $ \s -> + s { managerStateAnimations = HM.insert (animationID a) a (managerStateAnimations s) } + +runManager :: ManagerM s e n () +runManager = forever $ do + req <- getNextManagerRequest + case req of + StartAnimation a -> do + -- Schedule the animation, setting its next frame time. + now <- liftIO getCurrentTime + let next = addUTCTime frameOffset now + frameOffset = nominalDiffFromMs (animationFrameMilliseconds a) + insertAnimation $ setNextFrameTime next a + + StopAnimation aId -> do + mA <- lookupAnimation aId + case mA of + Nothing -> return () + Just a -> do + -- Remove the animation from the manager + removeAnimation aId + + -- Set the current frame in the application + -- state to none + sendApplicationEvent $ do + animationFrameUpdater a .= Nothing + + 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 + advanced <- checkForFrames tickTime + when (not $ null advanced) $ + sendApplicationEvent $ return () + +checkForFrames :: UTCTime -> ManagerM s e n [AnimationID] checkForFrames _ = return [] -- When a tick occurs: From d684b5eabdd611813edc28aa5106bac2b8bf669e Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Wed, 27 Nov 2024 13:24:43 -0800 Subject: [PATCH 008/134] AnimationDemo: have checkForFrames construct a state update --- programs/AnimationDemo.hs | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index a942b3da..9faa74b8 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -222,12 +222,18 @@ runManager = forever $ do -- Check all animation states for frame advances -- based on the relationship between the tick time -- and each animation's next frame time - advanced <- checkForFrames tickTime - when (not $ null advanced) $ - sendApplicationEvent $ return () - -checkForFrames :: UTCTime -> ManagerM s e n [AnimationID] -checkForFrames _ = return [] + mUpdateAct <- checkForFrames tickTime + case mUpdateAct of + Nothing -> return () + Just act -> sendApplicationEvent act + +checkForFrames :: UTCTime -> ManagerM s e n (Maybe (EventM n s ())) +checkForFrames _ = do + -- 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 counter to be updated in the + -- application state. + return Nothing -- When a tick occurs: -- for each currently-running animation, From 72fa8a3270262e7fdc4fbb2bdf1fe51e93ebb632 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Wed, 27 Nov 2024 19:50:36 -0800 Subject: [PATCH 009/134] AnimationDemo: sketch out Tick update handler and frame advancement --- programs/AnimationDemo.hs | 72 +++++++++++++++++++++++++++++++++++---- 1 file changed, 66 insertions(+), 6 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 9faa74b8..d4944ade 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -13,7 +13,7 @@ import Control.Monad (void, forever, when) import Control.Concurrent (threadDelay, forkIO, ThreadId, killThread) import Control.Monad.State.Strict import Data.Hashable (Hashable) -import Data.Time.Clock (UTCTime, NominalDiffTime, addUTCTime, getCurrentTime) +import Data.Time.Clock import qualified Data.HashMap.Strict as HM import qualified Control.Concurrent.STM as STM #if !(MIN_VERSION_base(4,11,0)) @@ -87,9 +87,7 @@ data AnimationManagerRequest s = | StartAnimation (Animation s) | StopAnimation AnimationID -data Duration = - Infinite - | Loop Int +data Duration = Once | Loop deriving (Eq, Show, Ord) data AnimationMode = @@ -148,6 +146,11 @@ setNextFrameTime t a = a { animationNextFrameTime = t } nominalDiffFromMs :: Integer -> NominalDiffTime nominalDiffFromMs i = realToFrac (fromIntegral i / (100.0::Float)) +nominalDiffToMs :: NominalDiffTime -> Integer +nominalDiffToMs t = + -- NOTE: probably wrong, but we'll have to find out what this gives us + (round $ nominalDiffTimeToSeconds t) + data ManagerState s e n = ManagerState { managerStateInChan :: STM.TChan (AnimationManagerRequest s) , managerStateOutChan :: BChan e @@ -228,12 +231,69 @@ runManager = forever $ do Just act -> sendApplicationEvent act checkForFrames :: UTCTime -> ManagerM s e n (Maybe (EventM n s ())) -checkForFrames _ = do +checkForFrames now = do -- 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 counter to be updated in the -- application state. - return Nothing + let addUpdate a Nothing = Just $ updateFor a + addUpdate a (Just updater) = Just $ updater >> updateFor a + + updateFor a = animationFrameUpdater a .= Just (animationCurrentFrame a) + + go :: Maybe (EventM n s ()) -> [Animation s] -> ManagerM s e n (Maybe (EventM n s ())) + go mUpdater [] = return mUpdater + go mUpdater (a:as) = do + -- Determine whether the next animation needs to have its + -- frame index advanced. + newUpdater <- if now < animationNextFrameTime a + then return mUpdater + else do + -- Determine how many frames have elapsed + -- for this animation, then advance the + -- frame index based the elapsed time. + -- Also set its next frame time. + let differenceMs = nominalDiffToMs $ + diffUTCTime now (animationNextFrameTime a) + numFrames = 1 + (differenceMs `div` animationFrameMilliseconds a) + newNextTime = addUTCTime (nominalDiffFromMs $ numFrames * (animationFrameMilliseconds a)) + (animationNextFrameTime a) + + -- The new frame is obtained by + -- advancing from the current frame by + -- numFrames. + a' = setNextFrameTime newNextTime $ + advanceBy numFrames a + + modify $ \s -> + s { managerStateAnimations = HM.insert (animationID a') a' $ + managerStateAnimations s + } + + return $ addUpdate a' mUpdater + go newUpdater as + + as <- gets (HM.elems . managerStateAnimations) + go Nothing as + +advanceBy :: Integer -> Animation s -> Animation s +advanceBy n a + | n <= 0 = a + | otherwise = + advanceBy (n - 1) $ + advanceByOne a + +advanceByOne :: Animation s -> Animation s +advanceByOne a = + case animationMode a of + Forward -> + if animationCurrentFrame a == animationNumFrames a - 1 + then case animationDuration a of + Loop -> a { animationCurrentFrame = 0 + } + Once -> a + else a { animationCurrentFrame = animationCurrentFrame a + 1 + } -- When a tick occurs: -- for each currently-running animation, From 07d8ceb033323fdfb136ef2e7feafbc7e9edac28 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Wed, 27 Nov 2024 20:14:04 -0800 Subject: [PATCH 010/134] AnimationDemo: add functionality to start new animations --- programs/AnimationDemo.hs | 49 +++++++++++++++++++++++++++++++++------ 1 file changed, 42 insertions(+), 7 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index d4944ade..9bf590e3 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -84,7 +84,8 @@ theApp = data AnimationManagerRequest s = Tick UTCTime - | StartAnimation (Animation s) + | StartAnimation Int Integer AnimationMode Duration (Traversal' s (Maybe Int)) + -- ^ Frame count, frame duration in milliseconds, mode, duration, updater | StopAnimation AnimationID data Duration = Once | Loop @@ -156,17 +157,20 @@ data ManagerState s e n = , managerStateOutChan :: BChan e , managerStateEventBuilder :: EventM n s () -> e , managerStateAnimations :: HM.HashMap AnimationID (Animation s) + , managerStateIDVar :: STM.TVar AnimationID } animationManagerThreadBody :: STM.TChan (AnimationManagerRequest s) -> BChan e -> (EventM n s () -> e) + -> STM.TVar AnimationID -> IO () -animationManagerThreadBody inChan outChan mkEvent = +animationManagerThreadBody inChan outChan mkEvent idVar = let initial = ManagerState { managerStateInChan = inChan , managerStateOutChan = outChan , managerStateEventBuilder = mkEvent , managerStateAnimations = mempty + , managerStateIDVar = idVar } in evalStateT runManager initial @@ -197,16 +201,37 @@ insertAnimation a = modify $ \s -> s { managerStateAnimations = HM.insert (animationID a) a (managerStateAnimations s) } +getNextAnimationID :: ManagerM s e n AnimationID +getNextAnimationID = do + var <- gets managerStateIDVar + liftIO $ STM.atomically $ do + AnimationID i <- STM.readTVar var + let next = AnimationID $ i + 1 + STM.writeTVar var next + return next + runManager :: ManagerM s e n () runManager = forever $ do req <- getNextManagerRequest case req of - StartAnimation a -> do - -- Schedule the animation, setting its next frame time. + StartAnimation numFrames frameMs mode dur updater -> do + aId <- getNextAnimationID + now <- liftIO getCurrentTime let next = addUTCTime frameOffset now frameOffset = nominalDiffFromMs (animationFrameMilliseconds a) - insertAnimation $ setNextFrameTime next a + a = Animation { animationID = aId + , animationNumFrames = numFrames + , animationCurrentFrame = 0 + , animationPreviousFrame = Nothing + , animationFrameMilliseconds = frameMs + , animationMode = mode + , animationDuration = dur + , animationFrameUpdater = updater + , animationNextFrameTime = next + } + + insertAnimation a StopAnimation aId -> do mA <- lookupAnimation aId @@ -312,10 +337,10 @@ advanceByOne a = startAnimationManager :: BChan e -> (EventM n s () -> e) -> IO (AnimationManager s e n) startAnimationManager outChan mkEvent = do inChan <- STM.newTChanIO - reqTid <- forkIO $ animationManagerThreadBody inChan outChan mkEvent + idVar <- STM.newTVarIO $ AnimationID 1 + reqTid <- forkIO $ animationManagerThreadBody inChan outChan mkEvent idVar tickTid <- forkIO $ tickThreadBody inChan runningVar <- STM.newTVarIO True - idVar <- STM.newTVarIO $ AnimationID 1 return $ AnimationManager { animationMgrRequestThreadId = reqTid , animationMgrTickThreadId = tickTid , animationMgrEventConstructor = mkEvent @@ -344,6 +369,16 @@ tellAnimationManager mgr req = STM.atomically $ STM.writeTChan (animationMgrInputChan mgr) req +startAnimation :: AnimationManager s e n + -> Int + -> Integer + -> AnimationMode + -> Duration + -> Traversal' s (Maybe Int) + -> IO () +startAnimation mgr numFrames frameMs mode duration updater = + tellAnimationManager mgr $ StartAnimation numFrames frameMs mode duration updater + main :: IO () main = do chan <- newBChan 10 From 3c910cc0ab4f3fd018b938167d0e86f3c5558702 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Wed, 27 Nov 2024 20:16:45 -0800 Subject: [PATCH 011/134] AnimationDemo: add a note about mode handling --- programs/AnimationDemo.hs | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 9bf590e3..b96c72ce 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -295,6 +295,19 @@ checkForFrames now = do managerStateAnimations s } + -- NOTE! + -- + -- + -- This always advances each animation + -- without regard for the loop mode. This + -- needs to be updated to account for the + -- Once mode where an animation reaches + -- its last frame and stays there. + -- + -- A related question: if something + -- animates once, should it terminate by + -- staying in its last frame? Or should it + -- be unscheduled? return $ addUpdate a' mUpdater go newUpdater as From 1974f6fe8ae92d4dbfbcc02e1f36663919806af6 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Wed, 27 Nov 2024 20:18:46 -0800 Subject: [PATCH 012/134] AnimationDemo: add a comment --- programs/AnimationDemo.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index b96c72ce..dd5957fd 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -88,6 +88,8 @@ data AnimationManagerRequest s = -- ^ Frame count, frame duration in milliseconds, mode, duration, updater | StopAnimation AnimationID +-- Is this a good name for this type? If we added a 'manual' option +-- where the application does frame updates, would it go here? data Duration = Once | Loop deriving (Eq, Show, Ord) From 7d7c7b82d3048305fd0b97e0a056286664ca4819 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Wed, 27 Nov 2024 20:32:58 -0800 Subject: [PATCH 013/134] Whitespace --- programs/AnimationDemo.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index dd5957fd..6689c323 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -118,7 +118,7 @@ data Animation s = } newtype AnimationID = AnimationID Int - deriving (Eq, Ord, Show, Hashable) + deriving (Eq, Ord, Show, Hashable) data AnimationManager s e n = AnimationManager { animationMgrRequestThreadId :: ThreadId From 73857a0bfc255e73450ce8e1b3fc3fb61eab8362 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Wed, 27 Nov 2024 20:37:00 -0800 Subject: [PATCH 014/134] AnimationDemo: use lenses for ManagerState field updates --- programs/AnimationDemo.hs | 45 ++++++++++++++++++--------------------- 1 file changed, 21 insertions(+), 24 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 6689c323..7d52690c 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -155,24 +155,26 @@ nominalDiffToMs t = (round $ nominalDiffTimeToSeconds t) data ManagerState s e n = - ManagerState { managerStateInChan :: STM.TChan (AnimationManagerRequest s) - , managerStateOutChan :: BChan e - , managerStateEventBuilder :: EventM n s () -> e - , managerStateAnimations :: HM.HashMap AnimationID (Animation s) - , managerStateIDVar :: STM.TVar AnimationID + ManagerState { _managerStateInChan :: STM.TChan (AnimationManagerRequest s) + , _managerStateOutChan :: BChan e + , _managerStateEventBuilder :: EventM n s () -> e + , _managerStateAnimations :: HM.HashMap AnimationID (Animation s) + , _managerStateIDVar :: STM.TVar AnimationID } +makeLenses ''ManagerState + animationManagerThreadBody :: STM.TChan (AnimationManagerRequest s) -> BChan e -> (EventM n s () -> e) -> STM.TVar AnimationID -> IO () animationManagerThreadBody inChan outChan mkEvent idVar = - let initial = ManagerState { managerStateInChan = inChan - , managerStateOutChan = outChan - , managerStateEventBuilder = mkEvent - , managerStateAnimations = mempty - , managerStateIDVar = idVar + let initial = ManagerState { _managerStateInChan = inChan + , _managerStateOutChan = outChan + , _managerStateEventBuilder = mkEvent + , _managerStateAnimations = mempty + , _managerStateIDVar = idVar } in evalStateT runManager initial @@ -180,32 +182,30 @@ type ManagerM s e n a = StateT (ManagerState s e n) IO a getNextManagerRequest :: ManagerM s e n (AnimationManagerRequest s) getNextManagerRequest = do - inChan <- gets managerStateInChan + inChan <- use managerStateInChan liftIO $ STM.atomically $ STM.readTChan inChan sendApplicationEvent :: EventM n s () -> ManagerM s e n () sendApplicationEvent act = do - outChan <- gets managerStateOutChan - mkEvent <- gets managerStateEventBuilder + outChan <- use managerStateOutChan + mkEvent <- use managerStateEventBuilder liftIO $ writeBChan outChan $ mkEvent act removeAnimation :: AnimationID -> ManagerM s e n () removeAnimation aId = - modify $ \s -> - s { managerStateAnimations = HM.delete aId (managerStateAnimations s) } + managerStateAnimations %= HM.delete aId lookupAnimation :: AnimationID -> ManagerM s e n (Maybe (Animation s)) lookupAnimation aId = - gets (HM.lookup aId . managerStateAnimations) + HM.lookup aId <$> use managerStateAnimations insertAnimation :: Animation s -> ManagerM s e n () insertAnimation a = - modify $ \s -> - s { managerStateAnimations = HM.insert (animationID a) a (managerStateAnimations s) } + managerStateAnimations %= HM.insert (animationID a) a getNextAnimationID :: ManagerM s e n AnimationID getNextAnimationID = do - var <- gets managerStateIDVar + var <- use managerStateIDVar liftIO $ STM.atomically $ do AnimationID i <- STM.readTVar var let next = AnimationID $ i + 1 @@ -292,10 +292,7 @@ checkForFrames now = do a' = setNextFrameTime newNextTime $ advanceBy numFrames a - modify $ \s -> - s { managerStateAnimations = HM.insert (animationID a') a' $ - managerStateAnimations s - } + managerStateAnimations %= HM.insert (animationID a') a' -- NOTE! -- @@ -313,7 +310,7 @@ checkForFrames now = do return $ addUpdate a' mUpdater go newUpdater as - as <- gets (HM.elems . managerStateAnimations) + as <- HM.elems <$> use managerStateAnimations go Nothing as advanceBy :: Integer -> Animation s -> Animation s From efa91c5e5e5a29cd1d0176ca7d8fcc46c66910cc Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Wed, 27 Nov 2024 20:41:52 -0800 Subject: [PATCH 015/134] AnimationDemo: use lenses for Animation field updates --- programs/AnimationDemo.hs | 72 +++++++++++++++++++-------------------- 1 file changed, 36 insertions(+), 36 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 7d52690c..47c76de6 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -6,7 +6,7 @@ {-# LANGUAGE ScopedTypeVariables #-} module Main where -import Lens.Micro ((^.), Traversal') +import Lens.Micro ((^.), (%~), (.~), (&), Traversal') import Lens.Micro.TH (makeLenses) import Lens.Micro.Mtl import Control.Monad (void, forever, when) @@ -100,25 +100,27 @@ data AnimationMode = -- | Random deriving (Eq, Show, Ord) +newtype AnimationID = AnimationID Int + deriving (Eq, Ord, Show, Hashable) + data Animation s = - Animation { animationID :: AnimationID - , animationNumFrames :: Int - , animationCurrentFrame :: Int - , animationPreviousFrame :: Maybe Int - , animationFrameMilliseconds :: Integer + Animation { _animationID :: AnimationID + , _animationNumFrames :: Int + , _animationCurrentFrame :: Int + , _animationPreviousFrame :: Maybe Int + , _animationFrameMilliseconds :: Integer -- what about tracking that an animation is currently -- moving backward when it sometimes moves forward? Just -- track the previous frame always, and use that? that -- works in general (can be ignored in the random case but -- is used in all others) - , animationMode :: AnimationMode - , animationDuration :: Duration + , _animationMode :: AnimationMode + , _animationDuration :: Duration , animationFrameUpdater :: Traversal' s (Maybe Int) - , animationNextFrameTime :: UTCTime + , _animationNextFrameTime :: UTCTime } -newtype AnimationID = AnimationID Int - deriving (Eq, Ord, Show, Hashable) +makeLenses ''Animation data AnimationManager s e n = AnimationManager { animationMgrRequestThreadId :: ThreadId @@ -144,7 +146,7 @@ tickThreadBody outChan = STM.atomically $ STM.writeTChan outChan $ Tick now setNextFrameTime :: UTCTime -> Animation s -> Animation s -setNextFrameTime t a = a { animationNextFrameTime = t } +setNextFrameTime t a = a & animationNextFrameTime .~ t nominalDiffFromMs :: Integer -> NominalDiffTime nominalDiffFromMs i = realToFrac (fromIntegral i / (100.0::Float)) @@ -201,7 +203,7 @@ lookupAnimation aId = insertAnimation :: Animation s -> ManagerM s e n () insertAnimation a = - managerStateAnimations %= HM.insert (animationID a) a + managerStateAnimations %= HM.insert (a^.animationID) a getNextAnimationID :: ManagerM s e n AnimationID getNextAnimationID = do @@ -221,16 +223,16 @@ runManager = forever $ do now <- liftIO getCurrentTime let next = addUTCTime frameOffset now - frameOffset = nominalDiffFromMs (animationFrameMilliseconds a) - a = Animation { animationID = aId - , animationNumFrames = numFrames - , animationCurrentFrame = 0 - , animationPreviousFrame = Nothing - , animationFrameMilliseconds = frameMs - , animationMode = mode - , animationDuration = dur + frameOffset = nominalDiffFromMs frameMs + a = Animation { _animationID = aId + , _animationNumFrames = numFrames + , _animationCurrentFrame = 0 + , _animationPreviousFrame = Nothing + , _animationFrameMilliseconds = frameMs + , _animationMode = mode + , _animationDuration = dur , animationFrameUpdater = updater - , animationNextFrameTime = next + , _animationNextFrameTime = next } insertAnimation a @@ -266,14 +268,14 @@ checkForFrames now = do let addUpdate a Nothing = Just $ updateFor a addUpdate a (Just updater) = Just $ updater >> updateFor a - updateFor a = animationFrameUpdater a .= Just (animationCurrentFrame a) + updateFor a = animationFrameUpdater a .= Just (a^.animationCurrentFrame) go :: Maybe (EventM n s ()) -> [Animation s] -> ManagerM s e n (Maybe (EventM n s ())) go mUpdater [] = return mUpdater go mUpdater (a:as) = do -- Determine whether the next animation needs to have its -- frame index advanced. - newUpdater <- if now < animationNextFrameTime a + newUpdater <- if now < a^.animationNextFrameTime then return mUpdater else do -- Determine how many frames have elapsed @@ -281,10 +283,10 @@ checkForFrames now = do -- frame index based the elapsed time. -- Also set its next frame time. let differenceMs = nominalDiffToMs $ - diffUTCTime now (animationNextFrameTime a) - numFrames = 1 + (differenceMs `div` animationFrameMilliseconds a) - newNextTime = addUTCTime (nominalDiffFromMs $ numFrames * (animationFrameMilliseconds a)) - (animationNextFrameTime a) + diffUTCTime now (a^.animationNextFrameTime) + numFrames = 1 + (differenceMs `div` (a^.animationFrameMilliseconds)) + newNextTime = addUTCTime (nominalDiffFromMs $ numFrames * (a^.animationFrameMilliseconds)) + (a^.animationNextFrameTime) -- The new frame is obtained by -- advancing from the current frame by @@ -292,7 +294,7 @@ checkForFrames now = do a' = setNextFrameTime newNextTime $ advanceBy numFrames a - managerStateAnimations %= HM.insert (animationID a') a' + managerStateAnimations %= HM.insert (a'^.animationID) a' -- NOTE! -- @@ -322,15 +324,13 @@ advanceBy n a advanceByOne :: Animation s -> Animation s advanceByOne a = - case animationMode a of + case a^.animationMode of Forward -> - if animationCurrentFrame a == animationNumFrames a - 1 - then case animationDuration a of - Loop -> a { animationCurrentFrame = 0 - } + if a^.animationCurrentFrame == a^.animationNumFrames - 1 + then case a^.animationDuration of + Loop -> a & animationCurrentFrame .~ 0 Once -> a - else a { animationCurrentFrame = animationCurrentFrame a + 1 - } + else a & animationCurrentFrame %~ (+ 1) -- When a tick occurs: -- for each currently-running animation, From 9ba8ec9e9086167e3cc4f0529dd45e51afa2a786 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Wed, 27 Nov 2024 20:45:19 -0800 Subject: [PATCH 016/134] AnimationDemo: have startAnimation return the ID of the newly-created animation --- programs/AnimationDemo.hs | 31 ++++++++++++++----------------- 1 file changed, 14 insertions(+), 17 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 47c76de6..0b19a9b5 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -84,8 +84,8 @@ theApp = data AnimationManagerRequest s = Tick UTCTime - | StartAnimation Int Integer AnimationMode Duration (Traversal' s (Maybe Int)) - -- ^ Frame count, frame duration in milliseconds, mode, duration, updater + | StartAnimation AnimationID Int Integer AnimationMode Duration (Traversal' s (Maybe Int)) + -- ^ ID, frame count, frame duration in milliseconds, mode, duration, updater | StopAnimation AnimationID -- Is this a good name for this type? If we added a 'manual' option @@ -161,7 +161,6 @@ data ManagerState s e n = , _managerStateOutChan :: BChan e , _managerStateEventBuilder :: EventM n s () -> e , _managerStateAnimations :: HM.HashMap AnimationID (Animation s) - , _managerStateIDVar :: STM.TVar AnimationID } makeLenses ''ManagerState @@ -169,14 +168,12 @@ makeLenses ''ManagerState animationManagerThreadBody :: STM.TChan (AnimationManagerRequest s) -> BChan e -> (EventM n s () -> e) - -> STM.TVar AnimationID -> IO () -animationManagerThreadBody inChan outChan mkEvent idVar = +animationManagerThreadBody inChan outChan mkEvent = let initial = ManagerState { _managerStateInChan = inChan , _managerStateOutChan = outChan , _managerStateEventBuilder = mkEvent , _managerStateAnimations = mempty - , _managerStateIDVar = idVar } in evalStateT runManager initial @@ -205,10 +202,10 @@ insertAnimation :: Animation s -> ManagerM s e n () insertAnimation a = managerStateAnimations %= HM.insert (a^.animationID) a -getNextAnimationID :: ManagerM s e n AnimationID -getNextAnimationID = do - var <- use managerStateIDVar - liftIO $ STM.atomically $ do +getNextAnimationID :: AnimationManager s e n -> IO AnimationID +getNextAnimationID mgr = do + let var = animationMgrNextAnimationID mgr + STM.atomically $ do AnimationID i <- STM.readTVar var let next = AnimationID $ i + 1 STM.writeTVar var next @@ -218,9 +215,7 @@ runManager :: ManagerM s e n () runManager = forever $ do req <- getNextManagerRequest case req of - StartAnimation numFrames frameMs mode dur updater -> do - aId <- getNextAnimationID - + StartAnimation aId numFrames frameMs mode dur updater -> do now <- liftIO getCurrentTime let next = addUTCTime frameOffset now frameOffset = nominalDiffFromMs frameMs @@ -350,7 +345,7 @@ startAnimationManager :: BChan e -> (EventM n s () -> e) -> IO (AnimationManager startAnimationManager outChan mkEvent = do inChan <- STM.newTChanIO idVar <- STM.newTVarIO $ AnimationID 1 - reqTid <- forkIO $ animationManagerThreadBody inChan outChan mkEvent idVar + reqTid <- forkIO $ animationManagerThreadBody inChan outChan mkEvent tickTid <- forkIO $ tickThreadBody inChan runningVar <- STM.newTVarIO True return $ AnimationManager { animationMgrRequestThreadId = reqTid @@ -387,9 +382,11 @@ startAnimation :: AnimationManager s e n -> AnimationMode -> Duration -> Traversal' s (Maybe Int) - -> IO () -startAnimation mgr numFrames frameMs mode duration updater = - tellAnimationManager mgr $ StartAnimation numFrames frameMs mode duration updater + -> IO AnimationID +startAnimation mgr numFrames frameMs mode duration updater = do + aId <- getNextAnimationID mgr + tellAnimationManager mgr $ StartAnimation aId numFrames frameMs mode duration updater + return aId main :: IO () main = do From 2501935270afaddbd556bb8be6b7964a4a0c5e34 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Wed, 27 Nov 2024 20:46:00 -0800 Subject: [PATCH 017/134] AnimationDemo: implement stopAnimation --- programs/AnimationDemo.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 0b19a9b5..8cf11dd2 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -388,6 +388,12 @@ startAnimation mgr numFrames frameMs mode duration updater = do tellAnimationManager mgr $ StartAnimation aId numFrames frameMs mode duration updater return aId +stopAnimation :: AnimationManager s e n + -> AnimationID + -> IO () +stopAnimation mgr aId = + tellAnimationManager mgr $ StopAnimation aId + main :: IO () main = do chan <- newBChan 10 From 48bc490663ff3a0520c835b364d906707c818ef7 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Wed, 27 Nov 2024 20:51:03 -0800 Subject: [PATCH 018/134] AnimationDemo: add animation manager to the application state --- programs/AnimationDemo.hs | 97 ++++++++++++++++++--------------------- 1 file changed, 44 insertions(+), 53 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 8cf11dd2..75a88aa3 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -37,51 +37,9 @@ import Brick.Types , BrickEvent(..) ) import Brick.Widgets.Core - ( (<=>) - , str + ( str ) -data CustomEvent = Counter deriving Show - -data St = - St { _stLastBrickEvent :: Maybe (BrickEvent () CustomEvent) - , _stCounter :: Int - } - -makeLenses ''St - -drawUI :: St -> [Widget ()] -drawUI st = [a] - where - a = (str $ "Last event: " <> (show $ st^.stLastBrickEvent)) - <=> - (str $ "Counter value is: " <> (show $ st^.stCounter)) - -appEvent :: BrickEvent () CustomEvent -> EventM () St () -appEvent e = - case e of - VtyEvent (V.EvKey V.KEsc []) -> halt - VtyEvent _ -> stLastBrickEvent .= (Just e) - AppEvent Counter -> do - stCounter %= (+1) - stLastBrickEvent .= (Just e) - _ -> return () - -initialState :: St -initialState = - St { _stLastBrickEvent = Nothing - , _stCounter = 0 - } - -theApp :: App St CustomEvent () -theApp = - App { appDraw = drawUI - , appChooseCursor = showFirstCursor - , appHandleEvent = appEvent - , appStartEvent = return () - , appAttrMap = const $ attrMap V.defAttr [] - } - data AnimationManagerRequest s = Tick UTCTime | StartAnimation AnimationID Int Integer AnimationMode Duration (Traversal' s (Maybe Int)) @@ -202,10 +160,10 @@ insertAnimation :: Animation s -> ManagerM s e n () insertAnimation a = managerStateAnimations %= HM.insert (a^.animationID) a -getNextAnimationID :: AnimationManager s e n -> IO AnimationID +getNextAnimationID :: (MonadIO m) => AnimationManager s e n -> m AnimationID getNextAnimationID mgr = do let var = animationMgrNextAnimationID mgr - STM.atomically $ do + liftIO $ STM.atomically $ do AnimationID i <- STM.readTVar var let next = AnimationID $ i + 1 STM.writeTVar var next @@ -371,35 +329,68 @@ stopAnimationManager mgr = killThread tickTid STM.atomically $ STM.writeTVar (animationMgrRunning mgr) False -tellAnimationManager :: AnimationManager s e n -> AnimationManagerRequest s -> IO () +tellAnimationManager :: (MonadIO m) + => AnimationManager s e n -> AnimationManagerRequest s -> m () tellAnimationManager mgr req = + liftIO $ STM.atomically $ STM.writeTChan (animationMgrInputChan mgr) req -startAnimation :: AnimationManager s e n +startAnimation :: (MonadIO m) + => AnimationManager s e n -> Int -> Integer -> AnimationMode -> Duration -> Traversal' s (Maybe Int) - -> IO AnimationID + -> m AnimationID startAnimation mgr numFrames frameMs mode duration updater = do aId <- getNextAnimationID mgr tellAnimationManager mgr $ StartAnimation aId numFrames frameMs mode duration updater return aId -stopAnimation :: AnimationManager s e n +stopAnimation :: (MonadIO m) + => AnimationManager s e n -> AnimationID - -> IO () + -> m () stopAnimation mgr aId = tellAnimationManager mgr $ StopAnimation aId +data CustomEvent = + AnimationUpdate (EventM () St ()) + +data St = + St { _stAnimationManager :: AnimationManager St CustomEvent () + } + +makeLenses ''St + +drawUI :: St -> [Widget ()] +drawUI _st = [str "Hello"] + +appEvent :: BrickEvent () CustomEvent -> EventM () St () +appEvent e = + case e of + VtyEvent (V.EvKey V.KEsc []) -> halt + AppEvent (AnimationUpdate act) -> act + _ -> return () + +theApp :: App St CustomEvent () +theApp = + App { appDraw = drawUI + , appChooseCursor = showFirstCursor + , appHandleEvent = appEvent + , appStartEvent = return () + , appAttrMap = const $ attrMap V.defAttr [] + } + main :: IO () main = do chan <- newBChan 10 + mgr <- startAnimationManager chan AnimationUpdate - void $ forkIO $ forever $ do - writeBChan chan Counter - threadDelay 1000000 + let initialState = + St { _stAnimationManager = mgr + } void $ customMainWithDefaultVty (Just chan) theApp initialState From 72f0eaef40efb05a0a39c0d8330994c2789d974b Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Wed, 27 Nov 2024 20:58:18 -0800 Subject: [PATCH 019/134] AnimationDemo: start to flesh out a started animation --- programs/AnimationDemo.hs | 41 +++++++++++++++++++++++++++++++++++++-- 1 file changed, 39 insertions(+), 2 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 75a88aa3..0e9c6d24 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -38,6 +38,7 @@ import Brick.Types ) import Brick.Widgets.Core ( str + , vBox ) data AnimationManagerRequest s = @@ -361,17 +362,47 @@ data CustomEvent = data St = St { _stAnimationManager :: AnimationManager St CustomEvent () + , _animation1ID :: Maybe AnimationID + , _animation2ID :: Maybe AnimationID + , _animation3ID :: Maybe AnimationID + , _animation1Frame :: Maybe Int + , _animation2Frame :: Maybe Int + , _animation3Frame :: Maybe Int } makeLenses ''St drawUI :: St -> [Widget ()] -drawUI _st = [str "Hello"] +drawUI st = [drawAnimations st] + +drawAnimations :: St -> Widget () +drawAnimations st = + vBox [ drawAnimation $ st^.animation1Frame + , drawAnimation $ st^.animation2Frame + , drawAnimation $ st^.animation3Frame + ] + +frames :: [String] +frames = [".", "o", "O", "^", " "] + +drawAnimation :: Maybe Int -> Widget () +drawAnimation Nothing = str " " +drawAnimation (Just i) = str $ frames !! i appEvent :: BrickEvent () CustomEvent -> EventM () St () -appEvent e = +appEvent e = do + mgr <- use stAnimationManager case e of VtyEvent (V.EvKey V.KEsc []) -> halt + VtyEvent (V.EvKey (V.KChar '1') []) -> do + mOld <- use animation1ID + case mOld of + Nothing -> return () + Just i -> stopAnimation mgr i + + aId <- startAnimation mgr (length frames) 250 Forward Loop animation1Frame + animation1ID .= Just aId + AppEvent (AnimationUpdate act) -> act _ -> return () @@ -391,6 +422,12 @@ main = do let initialState = St { _stAnimationManager = mgr + , _animation1ID = Nothing + , _animation2ID = Nothing + , _animation3ID = Nothing + , _animation1Frame = Nothing + , _animation2Frame = Nothing + , _animation3Frame = Nothing } void $ customMainWithDefaultVty (Just chan) theApp initialState From 2e97c9c816876efe2f98a19fdeeea2ac3226237f Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Wed, 27 Nov 2024 21:08:07 -0800 Subject: [PATCH 020/134] AnimationDemo: fix division in nominalDiffFromMs --- programs/AnimationDemo.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 0e9c6d24..3297ae6b 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -108,7 +108,7 @@ setNextFrameTime :: UTCTime -> Animation s -> Animation s setNextFrameTime t a = a & animationNextFrameTime .~ t nominalDiffFromMs :: Integer -> NominalDiffTime -nominalDiffFromMs i = realToFrac (fromIntegral i / (100.0::Float)) +nominalDiffFromMs i = realToFrac (fromIntegral i / (1000.0::Float)) nominalDiffToMs :: NominalDiffTime -> Integer nominalDiffToMs t = From 3b88ab4b123f9d5960c9d08b007cef954d9bedcd Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Wed, 27 Nov 2024 21:08:29 -0800 Subject: [PATCH 021/134] AnimationDemo: send initial frame to application on animation start --- programs/AnimationDemo.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 3297ae6b..5250b70e 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -190,6 +190,7 @@ runManager = forever $ do } insertAnimation a + sendApplicationEvent $ updater .= Just 0 StopAnimation aId -> do mA <- lookupAnimation aId From d6ce18dd11334a0ae4c1dfdcb7f25152ab51ea56 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Wed, 27 Nov 2024 21:13:32 -0800 Subject: [PATCH 022/134] AnimationDemo: enable other animations and permit toggles --- programs/AnimationDemo.hs | 37 ++++++++++++++++++++++++++++++------- 1 file changed, 30 insertions(+), 7 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 5250b70e..3276fc24 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -39,6 +39,7 @@ import Brick.Types import Brick.Widgets.Core ( str , vBox + , hBox ) data AnimationManagerRequest s = @@ -378,9 +379,16 @@ drawUI st = [drawAnimations st] drawAnimations :: St -> Widget () drawAnimations st = - vBox [ drawAnimation $ st^.animation1Frame - , drawAnimation $ st^.animation2Frame - , drawAnimation $ st^.animation3Frame + vBox [ hBox [ drawAnimation $ st^.animation1Frame + , str " " + , drawAnimation $ st^.animation2Frame + , str " " + , drawAnimation $ st^.animation3Frame + ] + , vBox [ maybe (str " ") (const $ str "Animation #1 running") $ st^.animation1ID + , maybe (str " ") (const $ str "Animation #2 running") $ st^.animation2ID + , maybe (str " ") (const $ str "Animation #3 running") $ st^.animation3ID + ] ] frames :: [String] @@ -398,11 +406,26 @@ appEvent e = do VtyEvent (V.EvKey (V.KChar '1') []) -> do mOld <- use animation1ID case mOld of - Nothing -> return () - Just i -> stopAnimation mgr i + Just i -> stopAnimation mgr i >> animation1ID .= Nothing + Nothing -> do + aId <- startAnimation mgr (length frames) 1000 Forward Loop animation1Frame + animation1ID .= Just aId + + VtyEvent (V.EvKey (V.KChar '2') []) -> do + mOld <- use animation2ID + case mOld of + Just i -> stopAnimation mgr i >> animation2ID .= Nothing + Nothing -> do + aId <- startAnimation mgr (length frames) 500 Forward Loop animation2Frame + animation2ID .= Just aId - aId <- startAnimation mgr (length frames) 250 Forward Loop animation1Frame - animation1ID .= Just aId + VtyEvent (V.EvKey (V.KChar '3') []) -> do + mOld <- use animation3ID + case mOld of + Just i -> stopAnimation mgr i >> animation3ID .= Nothing + Nothing -> do + aId <- startAnimation mgr (length frames) 100 Forward Loop animation3Frame + animation3ID .= Just aId AppEvent (AnimationUpdate act) -> act _ -> return () From fb4405d75e9354d0039266fde7a2a38e4634381d Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Wed, 27 Nov 2024 21:17:40 -0800 Subject: [PATCH 023/134] AnimationDemo: add different frames for each animation --- programs/AnimationDemo.hs | 28 +++++++++++++++++----------- 1 file changed, 17 insertions(+), 11 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 3276fc24..623350e8 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -379,11 +379,11 @@ drawUI st = [drawAnimations st] drawAnimations :: St -> Widget () drawAnimations st = - vBox [ hBox [ drawAnimation $ st^.animation1Frame + vBox [ hBox [ drawAnimation frames1 $ st^.animation1Frame , str " " - , drawAnimation $ st^.animation2Frame + , drawAnimation frames2 $ st^.animation2Frame , str " " - , drawAnimation $ st^.animation3Frame + , drawAnimation frames3 $ st^.animation3Frame ] , vBox [ maybe (str " ") (const $ str "Animation #1 running") $ st^.animation1ID , maybe (str " ") (const $ str "Animation #2 running") $ st^.animation2ID @@ -391,12 +391,18 @@ drawAnimations st = ] ] -frames :: [String] -frames = [".", "o", "O", "^", " "] +frames1 :: [String] +frames1 = [".", "o", "O", "^", " "] -drawAnimation :: Maybe Int -> Widget () -drawAnimation Nothing = str " " -drawAnimation (Just i) = str $ frames !! i +frames2 :: [String] +frames2 = ["|", "/", "-", "\\"] + +frames3 :: [String] +frames3 = ["v", "-", "^", "-"] + +drawAnimation :: [String] -> Maybe Int -> Widget () +drawAnimation _ Nothing = str " " +drawAnimation frames (Just i) = str $ frames !! i appEvent :: BrickEvent () CustomEvent -> EventM () St () appEvent e = do @@ -408,7 +414,7 @@ appEvent e = do case mOld of Just i -> stopAnimation mgr i >> animation1ID .= Nothing Nothing -> do - aId <- startAnimation mgr (length frames) 1000 Forward Loop animation1Frame + aId <- startAnimation mgr (length frames1) 1000 Forward Loop animation1Frame animation1ID .= Just aId VtyEvent (V.EvKey (V.KChar '2') []) -> do @@ -416,7 +422,7 @@ appEvent e = do case mOld of Just i -> stopAnimation mgr i >> animation2ID .= Nothing Nothing -> do - aId <- startAnimation mgr (length frames) 500 Forward Loop animation2Frame + aId <- startAnimation mgr (length frames2) 500 Forward Loop animation2Frame animation2ID .= Just aId VtyEvent (V.EvKey (V.KChar '3') []) -> do @@ -424,7 +430,7 @@ appEvent e = do case mOld of Just i -> stopAnimation mgr i >> animation3ID .= Nothing Nothing -> do - aId <- startAnimation mgr (length frames) 100 Forward Loop animation3Frame + aId <- startAnimation mgr (length frames3) 100 Forward Loop animation3Frame animation3ID .= Just aId AppEvent (AnimationUpdate act) -> act From 558d2bc6a1fe183912524e734e8f5a0490d0c1f1 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Wed, 27 Nov 2024 21:28:13 -0800 Subject: [PATCH 024/134] AnimationDemo: shut down Vty properly --- programs/AnimationDemo.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 623350e8..18e191e4 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -460,4 +460,5 @@ main = do , _animation3Frame = Nothing } - void $ customMainWithDefaultVty (Just chan) theApp initialState + (_, vty) <- customMainWithDefaultVty (Just chan) theApp initialState + V.shutdown vty From e22b4df7c16f389ccaf34b703fbec0d27968aa67 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Wed, 27 Nov 2024 21:35:28 -0800 Subject: [PATCH 025/134] AnimationDemo: remove unused import --- programs/AnimationDemo.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 18e191e4..9aecceea 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -9,7 +9,7 @@ module Main where import Lens.Micro ((^.), (%~), (.~), (&), Traversal') import Lens.Micro.TH (makeLenses) import Lens.Micro.Mtl -import Control.Monad (void, forever, when) +import Control.Monad (forever, when) import Control.Concurrent (threadDelay, forkIO, ThreadId, killThread) import Control.Monad.State.Strict import Data.Hashable (Hashable) From aa2498221be98a8e538415096f44b980ebda8f0f Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Wed, 27 Nov 2024 21:35:59 -0800 Subject: [PATCH 026/134] AnimationDemo: factor handleManagerRequest out of runManager --- programs/AnimationDemo.hs | 80 +++++++++++++++++++-------------------- 1 file changed, 40 insertions(+), 40 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 9aecceea..070fe980 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -174,46 +174,46 @@ getNextAnimationID mgr = do runManager :: ManagerM s e n () runManager = forever $ do req <- getNextManagerRequest - case req of - StartAnimation aId numFrames frameMs mode dur updater -> do - now <- liftIO getCurrentTime - let next = addUTCTime frameOffset now - frameOffset = nominalDiffFromMs frameMs - a = Animation { _animationID = aId - , _animationNumFrames = numFrames - , _animationCurrentFrame = 0 - , _animationPreviousFrame = Nothing - , _animationFrameMilliseconds = frameMs - , _animationMode = mode - , _animationDuration = dur - , animationFrameUpdater = updater - , _animationNextFrameTime = next - } - - insertAnimation a - sendApplicationEvent $ updater .= Just 0 - - StopAnimation aId -> do - mA <- lookupAnimation aId - case mA of - Nothing -> return () - Just a -> do - -- Remove the animation from the manager - removeAnimation aId - - -- Set the current frame in the application - -- state to none - sendApplicationEvent $ do - animationFrameUpdater a .= Nothing - - 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 <- checkForFrames tickTime - case mUpdateAct of - Nothing -> return () - Just act -> sendApplicationEvent act + handleManagerRequest req + +handleManagerRequest :: AnimationManagerRequest s -> ManagerM s e n () +handleManagerRequest (StartAnimation aId numFrames frameMs mode dur updater) = do + now <- liftIO getCurrentTime + let next = addUTCTime frameOffset now + frameOffset = nominalDiffFromMs frameMs + a = Animation { _animationID = aId + , _animationNumFrames = numFrames + , _animationCurrentFrame = 0 + , _animationPreviousFrame = Nothing + , _animationFrameMilliseconds = frameMs + , _animationMode = mode + , _animationDuration = dur + , animationFrameUpdater = updater + , _animationNextFrameTime = next + } + + insertAnimation a + sendApplicationEvent $ updater .= Just 0 +handleManagerRequest (StopAnimation aId) = do + mA <- lookupAnimation aId + case mA of + Nothing -> return () + Just a -> do + -- Remove the animation from the manager + removeAnimation aId + + -- Set the current frame in the application + -- state to none + sendApplicationEvent $ do + animationFrameUpdater a .= Nothing +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 <- checkForFrames tickTime + case mUpdateAct of + Nothing -> return () + Just act -> sendApplicationEvent act checkForFrames :: UTCTime -> ManagerM s e n (Maybe (EventM n s ())) checkForFrames now = do From 4e65f8bd6e55fd3b3d71a7df5846eed748ab43ab Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Wed, 27 Nov 2024 21:36:25 -0800 Subject: [PATCH 027/134] AnimationDemo: nit --- programs/AnimationDemo.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 070fe980..989b8677 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -173,8 +173,7 @@ getNextAnimationID mgr = do runManager :: ManagerM s e n () runManager = forever $ do - req <- getNextManagerRequest - handleManagerRequest req + getNextManagerRequest >>= handleManagerRequest handleManagerRequest :: AnimationManagerRequest s -> ManagerM s e n () handleManagerRequest (StartAnimation aId numFrames frameMs mode dur updater) = do From 406c0b5d215b82e8e8d50eeca51d79286a2173f8 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Wed, 27 Nov 2024 21:38:34 -0800 Subject: [PATCH 028/134] AnimationDemo: Animation -> AnimationState --- programs/AnimationDemo.hs | 70 +++++++++++++++++++-------------------- 1 file changed, 35 insertions(+), 35 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 989b8677..9f34a166 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -63,24 +63,24 @@ data AnimationMode = newtype AnimationID = AnimationID Int deriving (Eq, Ord, Show, Hashable) -data Animation s = - Animation { _animationID :: AnimationID - , _animationNumFrames :: Int - , _animationCurrentFrame :: Int - , _animationPreviousFrame :: Maybe Int - , _animationFrameMilliseconds :: Integer - -- what about tracking that an animation is currently - -- moving backward when it sometimes moves forward? Just - -- track the previous frame always, and use that? that - -- works in general (can be ignored in the random case but - -- is used in all others) - , _animationMode :: AnimationMode - , _animationDuration :: Duration - , animationFrameUpdater :: Traversal' s (Maybe Int) - , _animationNextFrameTime :: UTCTime - } - -makeLenses ''Animation +data AnimationState s = + AnimationState { _animationID :: AnimationID + , _animationNumFrames :: Int + , _animationCurrentFrame :: Int + , _animationPreviousFrame :: Maybe Int + , _animationFrameMilliseconds :: Integer + -- what about tracking that an animation is currently + -- moving backward when it sometimes moves forward? Just + -- track the previous frame always, and use that? that + -- works in general (can be ignored in the random case but + -- is used in all others) + , _animationMode :: AnimationMode + , _animationDuration :: Duration + , animationFrameUpdater :: Traversal' s (Maybe Int) + , _animationNextFrameTime :: UTCTime + } + +makeLenses ''AnimationState data AnimationManager s e n = AnimationManager { animationMgrRequestThreadId :: ThreadId @@ -105,7 +105,7 @@ tickThreadBody outChan = now <- getCurrentTime STM.atomically $ STM.writeTChan outChan $ Tick now -setNextFrameTime :: UTCTime -> Animation s -> Animation s +setNextFrameTime :: UTCTime -> AnimationState s -> AnimationState s setNextFrameTime t a = a & animationNextFrameTime .~ t nominalDiffFromMs :: Integer -> NominalDiffTime @@ -120,7 +120,7 @@ data ManagerState s e n = ManagerState { _managerStateInChan :: STM.TChan (AnimationManagerRequest s) , _managerStateOutChan :: BChan e , _managerStateEventBuilder :: EventM n s () -> e - , _managerStateAnimations :: HM.HashMap AnimationID (Animation s) + , _managerStateAnimations :: HM.HashMap AnimationID (AnimationState s) } makeLenses ''ManagerState @@ -154,11 +154,11 @@ removeAnimation :: AnimationID -> ManagerM s e n () removeAnimation aId = managerStateAnimations %= HM.delete aId -lookupAnimation :: AnimationID -> ManagerM s e n (Maybe (Animation s)) +lookupAnimation :: AnimationID -> ManagerM s e n (Maybe (AnimationState s)) lookupAnimation aId = HM.lookup aId <$> use managerStateAnimations -insertAnimation :: Animation s -> ManagerM s e n () +insertAnimation :: AnimationState s -> ManagerM s e n () insertAnimation a = managerStateAnimations %= HM.insert (a^.animationID) a @@ -180,16 +180,16 @@ handleManagerRequest (StartAnimation aId numFrames frameMs mode dur updater) = d now <- liftIO getCurrentTime let next = addUTCTime frameOffset now frameOffset = nominalDiffFromMs frameMs - a = Animation { _animationID = aId - , _animationNumFrames = numFrames - , _animationCurrentFrame = 0 - , _animationPreviousFrame = Nothing - , _animationFrameMilliseconds = frameMs - , _animationMode = mode - , _animationDuration = dur - , animationFrameUpdater = updater - , _animationNextFrameTime = next - } + a = AnimationState { _animationID = aId + , _animationNumFrames = numFrames + , _animationCurrentFrame = 0 + , _animationPreviousFrame = Nothing + , _animationFrameMilliseconds = frameMs + , _animationMode = mode + , _animationDuration = dur + , animationFrameUpdater = updater + , _animationNextFrameTime = next + } insertAnimation a sendApplicationEvent $ updater .= Just 0 @@ -225,7 +225,7 @@ checkForFrames now = do updateFor a = animationFrameUpdater a .= Just (a^.animationCurrentFrame) - go :: Maybe (EventM n s ()) -> [Animation s] -> ManagerM s e n (Maybe (EventM n s ())) + go :: Maybe (EventM n s ()) -> [AnimationState s] -> ManagerM s e n (Maybe (EventM n s ())) go mUpdater [] = return mUpdater go mUpdater (a:as) = do -- Determine whether the next animation needs to have its @@ -270,14 +270,14 @@ checkForFrames now = do as <- HM.elems <$> use managerStateAnimations go Nothing as -advanceBy :: Integer -> Animation s -> Animation s +advanceBy :: Integer -> AnimationState s -> AnimationState s advanceBy n a | n <= 0 = a | otherwise = advanceBy (n - 1) $ advanceByOne a -advanceByOne :: Animation s -> Animation s +advanceByOne :: AnimationState s -> AnimationState s advanceByOne a = case a^.animationMode of Forward -> From a14434ca66ec3a264bedc6adc5117c6598aaec59 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Wed, 27 Nov 2024 22:23:12 -0800 Subject: [PATCH 029/134] AnimationDemo: frames are widgets --- programs/AnimationDemo.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 9f34a166..49c3931b 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -390,18 +390,18 @@ drawAnimations st = ] ] -frames1 :: [String] -frames1 = [".", "o", "O", "^", " "] +frames1 :: [Widget ()] +frames1 = str <$> [".", "o", "O", "^", " "] -frames2 :: [String] -frames2 = ["|", "/", "-", "\\"] +frames2 :: [Widget ()] +frames2 = str <$> ["|", "/", "-", "\\"] -frames3 :: [String] -frames3 = ["v", "-", "^", "-"] +frames3 :: [Widget ()] +frames3 = str <$> ["v", "-", "^", "-"] -drawAnimation :: [String] -> Maybe Int -> Widget () +drawAnimation :: [Widget n] -> Maybe Int -> Widget n drawAnimation _ Nothing = str " " -drawAnimation frames (Just i) = str $ frames !! i +drawAnimation frames (Just i) = frames !! i appEvent :: BrickEvent () CustomEvent -> EventM () St () appEvent e = do From 59bea5f9edd58be28cdff87499f22123588d5ff9 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Wed, 27 Nov 2024 22:23:21 -0800 Subject: [PATCH 030/134] AnimationDemo: increase second animation rate --- programs/AnimationDemo.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 49c3931b..c9f45856 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -421,7 +421,7 @@ appEvent e = do case mOld of Just i -> stopAnimation mgr i >> animation2ID .= Nothing Nothing -> do - aId <- startAnimation mgr (length frames2) 500 Forward Loop animation2Frame + aId <- startAnimation mgr (length frames2) 100 Forward Loop animation2Frame animation2ID .= Just aId VtyEvent (V.EvKey (V.KChar '3') []) -> do From 9030676779df20f058b3170142f1bcdb0da78be4 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Wed, 27 Nov 2024 22:36:47 -0800 Subject: [PATCH 031/134] AnimationDemo: more animation tweaks --- programs/AnimationDemo.hs | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index c9f45856..523f9ed7 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -36,10 +36,14 @@ import Brick.Types , EventM , BrickEvent(..) ) +import Brick.Widgets.Border (border) +import Brick.Widgets.Center (center) import Brick.Widgets.Core ( str , vBox , hBox + , hLimit + , vLimit ) data AnimationManagerRequest s = @@ -397,7 +401,12 @@ frames2 :: [Widget ()] frames2 = str <$> ["|", "/", "-", "\\"] frames3 :: [Widget ()] -frames3 = str <$> ["v", "-", "^", "-"] +frames3 = + (hLimit 9 . vLimit 9 . border . center) <$> + [ border $ str " " + , border $ vBox $ replicate 3 $ str $ replicate 3 ' ' + , border $ vBox $ replicate 5 $ str $ replicate 5 ' ' + ] drawAnimation :: [Widget n] -> Maybe Int -> Widget n drawAnimation _ Nothing = str " " @@ -429,7 +438,7 @@ appEvent e = do case mOld of Just i -> stopAnimation mgr i >> animation3ID .= Nothing Nothing -> do - aId <- startAnimation mgr (length frames3) 100 Forward Loop animation3Frame + aId <- startAnimation mgr (length frames3) 300 Forward Loop animation3Frame animation3ID .= Just aId AppEvent (AnimationUpdate act) -> act From 2652a1937c7fd09f25242257e128f9763b1bdaac Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Wed, 27 Nov 2024 22:45:40 -0800 Subject: [PATCH 032/134] AnimationDemo: comment --- programs/AnimationDemo.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 523f9ed7..908df2a5 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -394,6 +394,9 @@ drawAnimations st = ] ] +-- NOTE: +-- Perhaps introduce a Frames type here with a Vector to store frames +-- for more efficient indexing frames1 :: [Widget ()] frames1 = str <$> [".", "o", "O", "^", " "] From 1dd6b21f81361fd8d64502f6e62d4881c921e9c0 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 29 Nov 2024 17:43:33 -0800 Subject: [PATCH 033/134] hCenterWith: account for centered image width properly when computing additional right padding (see also #520) --- src/Brick/Widgets/Center.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Brick/Widgets/Center.hs b/src/Brick/Widgets/Center.hs index d89fc926..dcb19896 100644 --- a/src/Brick/Widgets/Center.hs +++ b/src/Brick/Widgets/Center.hs @@ -60,7 +60,7 @@ hCenterWith mChar p = c <- getContext let rWidth = result^.imageL.to imageWidth rHeight = result^.imageL.to imageHeight - remainder = max 0 $ c^.availWidthL - (leftPaddingAmount * 2) + remainder = max 0 $ c^.availWidthL - (rWidth + (leftPaddingAmount * 2)) leftPaddingAmount = max 0 $ (c^.availWidthL - rWidth) `div` 2 rightPaddingAmount = max 0 $ leftPaddingAmount + remainder leftPadding = charFill (c^.attrL) ch leftPaddingAmount rHeight From 9157e2f158ee8c6a043f446f6c86815777190961 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Sat, 30 Nov 2024 20:49:37 -0800 Subject: [PATCH 034/134] AnimationDemo: package animation frame and ID together, make ID managed by the manager thread --- programs/AnimationDemo.hs | 116 ++++++++++++++++++-------------------- 1 file changed, 56 insertions(+), 60 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 908df2a5..b8404cc9 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -6,7 +6,7 @@ {-# LANGUAGE ScopedTypeVariables #-} module Main where -import Lens.Micro ((^.), (%~), (.~), (&), Traversal') +import Lens.Micro ((^.), (%~), (.~), (&), Traversal', _Just) import Lens.Micro.TH (makeLenses) import Lens.Micro.Mtl import Control.Monad (forever, when) @@ -48,7 +48,7 @@ import Brick.Widgets.Core data AnimationManagerRequest s = Tick UTCTime - | StartAnimation AnimationID Int Integer AnimationMode Duration (Traversal' s (Maybe Int)) + | StartAnimation Int Integer AnimationMode Duration (Traversal' s (Maybe Animation)) -- ^ ID, frame count, frame duration in milliseconds, mode, duration, updater | StopAnimation AnimationID @@ -67,8 +67,15 @@ data AnimationMode = newtype AnimationID = AnimationID Int deriving (Eq, Ord, Show, Hashable) +data Animation = + Animation { _animationFrame :: Int + , _animationID :: AnimationID + } + +makeLenses ''Animation + data AnimationState s = - AnimationState { _animationID :: AnimationID + AnimationState { _animationStateID :: AnimationID , _animationNumFrames :: Int , _animationCurrentFrame :: Int , _animationPreviousFrame :: Maybe Int @@ -80,7 +87,7 @@ data AnimationState s = -- is used in all others) , _animationMode :: AnimationMode , _animationDuration :: Duration - , animationFrameUpdater :: Traversal' s (Maybe Int) + , animationFrameUpdater :: Traversal' s (Maybe Animation) , _animationNextFrameTime :: UTCTime } @@ -92,7 +99,6 @@ data AnimationManager s e n = , animationMgrOutputChan :: BChan e , animationMgrInputChan :: STM.TChan (AnimationManagerRequest s) , animationMgrEventConstructor :: EventM n s () -> e - , animationMgrNextAnimationID :: STM.TVar AnimationID , animationMgrRunning :: STM.TVar Bool } @@ -125,6 +131,7 @@ data ManagerState s e n = , _managerStateOutChan :: BChan e , _managerStateEventBuilder :: EventM n s () -> e , _managerStateAnimations :: HM.HashMap AnimationID (AnimationState s) + , _managerStateIDVar :: STM.TVar AnimationID } makeLenses ''ManagerState @@ -133,13 +140,15 @@ animationManagerThreadBody :: STM.TChan (AnimationManagerRequest s) -> BChan e -> (EventM n s () -> e) -> IO () -animationManagerThreadBody inChan outChan mkEvent = +animationManagerThreadBody inChan outChan mkEvent = do + idVar <- STM.newTVarIO $ AnimationID 1 let initial = ManagerState { _managerStateInChan = inChan , _managerStateOutChan = outChan , _managerStateEventBuilder = mkEvent , _managerStateAnimations = mempty + , _managerStateIDVar = idVar } - in evalStateT runManager initial + evalStateT runManager initial type ManagerM s e n a = StateT (ManagerState s e n) IO a @@ -164,11 +173,11 @@ lookupAnimation aId = insertAnimation :: AnimationState s -> ManagerM s e n () insertAnimation a = - managerStateAnimations %= HM.insert (a^.animationID) a + managerStateAnimations %= HM.insert (a^.animationStateID) a -getNextAnimationID :: (MonadIO m) => AnimationManager s e n -> m AnimationID -getNextAnimationID mgr = do - let var = animationMgrNextAnimationID mgr +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 @@ -180,11 +189,12 @@ runManager = forever $ do getNextManagerRequest >>= handleManagerRequest handleManagerRequest :: AnimationManagerRequest s -> ManagerM s e n () -handleManagerRequest (StartAnimation aId numFrames frameMs mode dur updater) = do +handleManagerRequest (StartAnimation numFrames frameMs mode dur updater) = do + aId <- getNextAnimationID now <- liftIO getCurrentTime let next = addUTCTime frameOffset now frameOffset = nominalDiffFromMs frameMs - a = AnimationState { _animationID = aId + a = AnimationState { _animationStateID = aId , _animationNumFrames = numFrames , _animationCurrentFrame = 0 , _animationPreviousFrame = Nothing @@ -196,7 +206,9 @@ handleManagerRequest (StartAnimation aId numFrames frameMs mode dur updater) = d } insertAnimation a - sendApplicationEvent $ updater .= Just 0 + sendApplicationEvent $ updater .= Just (Animation { _animationID = aId + , _animationFrame = 0 + }) handleManagerRequest (StopAnimation aId) = do mA <- lookupAnimation aId case mA of @@ -205,8 +217,8 @@ handleManagerRequest (StopAnimation aId) = do -- Remove the animation from the manager removeAnimation aId - -- Set the current frame in the application - -- state to none + -- Set the current animation state in the application state + -- to none sendApplicationEvent $ do animationFrameUpdater a .= Nothing handleManagerRequest (Tick tickTime) = do @@ -227,7 +239,7 @@ checkForFrames now = do let addUpdate a Nothing = Just $ updateFor a addUpdate a (Just updater) = Just $ updater >> updateFor a - updateFor a = animationFrameUpdater a .= Just (a^.animationCurrentFrame) + updateFor a = animationFrameUpdater a._Just.animationFrame .= (a^.animationCurrentFrame) go :: Maybe (EventM n s ()) -> [AnimationState s] -> ManagerM s e n (Maybe (EventM n s ())) go mUpdater [] = return mUpdater @@ -253,7 +265,7 @@ checkForFrames now = do a' = setNextFrameTime newNextTime $ advanceBy numFrames a - managerStateAnimations %= HM.insert (a'^.animationID) a' + managerStateAnimations %= HM.insert (a'^.animationStateID) a' -- NOTE! -- @@ -308,7 +320,6 @@ advanceByOne a = startAnimationManager :: BChan e -> (EventM n s () -> e) -> IO (AnimationManager s e n) startAnimationManager outChan mkEvent = do inChan <- STM.newTChanIO - idVar <- STM.newTVarIO $ AnimationID 1 reqTid <- forkIO $ animationManagerThreadBody inChan outChan mkEvent tickTid <- forkIO $ tickThreadBody inChan runningVar <- STM.newTVarIO True @@ -317,7 +328,6 @@ startAnimationManager outChan mkEvent = do , animationMgrEventConstructor = mkEvent , animationMgrOutputChan = outChan , animationMgrInputChan = inChan - , animationMgrNextAnimationID = idVar , animationMgrRunning = runningVar } @@ -348,12 +358,10 @@ startAnimation :: (MonadIO m) -> Integer -> AnimationMode -> Duration - -> Traversal' s (Maybe Int) - -> m AnimationID + -> Traversal' s (Maybe Animation) + -> m () startAnimation mgr numFrames frameMs mode duration updater = do - aId <- getNextAnimationID mgr - tellAnimationManager mgr $ StartAnimation aId numFrames frameMs mode duration updater - return aId + tellAnimationManager mgr $ StartAnimation numFrames frameMs mode duration updater stopAnimation :: (MonadIO m) => AnimationManager s e n @@ -367,12 +375,9 @@ data CustomEvent = data St = St { _stAnimationManager :: AnimationManager St CustomEvent () - , _animation1ID :: Maybe AnimationID - , _animation2ID :: Maybe AnimationID - , _animation3ID :: Maybe AnimationID - , _animation1Frame :: Maybe Int - , _animation2Frame :: Maybe Int - , _animation3Frame :: Maybe Int + , _animation1 :: Maybe Animation + , _animation2 :: Maybe Animation + , _animation3 :: Maybe Animation } makeLenses ''St @@ -382,15 +387,15 @@ drawUI st = [drawAnimations st] drawAnimations :: St -> Widget () drawAnimations st = - vBox [ hBox [ drawAnimation frames1 $ st^.animation1Frame + vBox [ hBox [ drawAnimation frames1 $ st^.animation1 , str " " - , drawAnimation frames2 $ st^.animation2Frame + , drawAnimation frames2 $ st^.animation2 , str " " - , drawAnimation frames3 $ st^.animation3Frame + , drawAnimation frames3 $ st^.animation3 ] - , vBox [ maybe (str " ") (const $ str "Animation #1 running") $ st^.animation1ID - , maybe (str " ") (const $ str "Animation #2 running") $ st^.animation2ID - , maybe (str " ") (const $ str "Animation #3 running") $ st^.animation3ID + , vBox [ maybe (str " ") (const $ str "Animation #1 running") $ st^.animation1 + , maybe (str " ") (const $ str "Animation #2 running") $ st^.animation2 + , maybe (str " ") (const $ str "Animation #3 running") $ st^.animation3 ] ] @@ -411,9 +416,9 @@ frames3 = , border $ vBox $ replicate 5 $ str $ replicate 5 ' ' ] -drawAnimation :: [Widget n] -> Maybe Int -> Widget n +drawAnimation :: [Widget n] -> Maybe Animation -> Widget n drawAnimation _ Nothing = str " " -drawAnimation frames (Just i) = frames !! i +drawAnimation frames (Just (Animation i _)) = frames !! i appEvent :: BrickEvent () CustomEvent -> EventM () St () appEvent e = do @@ -421,28 +426,22 @@ appEvent e = do case e of VtyEvent (V.EvKey V.KEsc []) -> halt VtyEvent (V.EvKey (V.KChar '1') []) -> do - mOld <- use animation1ID + mOld <- preuse (animation1._Just.animationID) case mOld of - Just i -> stopAnimation mgr i >> animation1ID .= Nothing - Nothing -> do - aId <- startAnimation mgr (length frames1) 1000 Forward Loop animation1Frame - animation1ID .= Just aId + Just i -> stopAnimation mgr i + Nothing -> startAnimation mgr (length frames1) 1000 Forward Loop animation1 VtyEvent (V.EvKey (V.KChar '2') []) -> do - mOld <- use animation2ID + mOld <- preuse (animation2._Just.animationID) case mOld of - Just i -> stopAnimation mgr i >> animation2ID .= Nothing - Nothing -> do - aId <- startAnimation mgr (length frames2) 100 Forward Loop animation2Frame - animation2ID .= Just aId + Just i -> stopAnimation mgr i + Nothing -> startAnimation mgr (length frames2) 100 Forward Loop animation2 VtyEvent (V.EvKey (V.KChar '3') []) -> do - mOld <- use animation3ID + mOld <- preuse (animation3._Just.animationID) case mOld of - Just i -> stopAnimation mgr i >> animation3ID .= Nothing - Nothing -> do - aId <- startAnimation mgr (length frames3) 300 Forward Loop animation3Frame - animation3ID .= Just aId + Just i -> stopAnimation mgr i + Nothing -> startAnimation mgr (length frames3) 300 Forward Loop animation3 AppEvent (AnimationUpdate act) -> act _ -> return () @@ -463,12 +462,9 @@ main = do let initialState = St { _stAnimationManager = mgr - , _animation1ID = Nothing - , _animation2ID = Nothing - , _animation3ID = Nothing - , _animation1Frame = Nothing - , _animation2Frame = Nothing - , _animation3Frame = Nothing + , _animation1 = Nothing + , _animation2 = Nothing + , _animation3 = Nothing } (_, vty) <- customMainWithDefaultVty (Just chan) theApp initialState From dd8d9e34f58dd3de253672ff0257ee4bcd031c1f Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Sat, 30 Nov 2024 20:51:40 -0800 Subject: [PATCH 035/134] AnimationDemo: streamline stopAnimation API --- programs/AnimationDemo.hs | 27 ++++++++++++++------------- 1 file changed, 14 insertions(+), 13 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index b8404cc9..1afa1828 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -50,7 +50,7 @@ data AnimationManagerRequest s = Tick UTCTime | StartAnimation Int Integer AnimationMode Duration (Traversal' s (Maybe Animation)) -- ^ ID, frame count, frame duration in milliseconds, mode, duration, updater - | StopAnimation AnimationID + | StopAnimation Animation -- Is this a good name for this type? If we added a 'manual' option -- where the application does frame updates, would it go here? @@ -209,18 +209,19 @@ handleManagerRequest (StartAnimation numFrames frameMs mode dur updater) = do sendApplicationEvent $ updater .= Just (Animation { _animationID = aId , _animationFrame = 0 }) -handleManagerRequest (StopAnimation aId) = do +handleManagerRequest (StopAnimation a) = do + let aId = a^.animationID mA <- lookupAnimation aId case mA of Nothing -> return () - Just a -> do + Just aState -> do -- Remove the animation from the manager removeAnimation aId -- Set the current animation state in the application state -- to none sendApplicationEvent $ do - animationFrameUpdater a .= Nothing + animationFrameUpdater aState .= Nothing handleManagerRequest (Tick tickTime) = do -- Check all animation states for frame advances -- based on the relationship between the tick time @@ -365,10 +366,10 @@ startAnimation mgr numFrames frameMs mode duration updater = do stopAnimation :: (MonadIO m) => AnimationManager s e n - -> AnimationID + -> Animation -> m () -stopAnimation mgr aId = - tellAnimationManager mgr $ StopAnimation aId +stopAnimation mgr a = + tellAnimationManager mgr $ StopAnimation a data CustomEvent = AnimationUpdate (EventM () St ()) @@ -426,21 +427,21 @@ appEvent e = do case e of VtyEvent (V.EvKey V.KEsc []) -> halt VtyEvent (V.EvKey (V.KChar '1') []) -> do - mOld <- preuse (animation1._Just.animationID) + mOld <- use animation1 case mOld of - Just i -> stopAnimation mgr i + Just a -> stopAnimation mgr a Nothing -> startAnimation mgr (length frames1) 1000 Forward Loop animation1 VtyEvent (V.EvKey (V.KChar '2') []) -> do - mOld <- preuse (animation2._Just.animationID) + mOld <- use animation2 case mOld of - Just i -> stopAnimation mgr i + Just a -> stopAnimation mgr a Nothing -> startAnimation mgr (length frames2) 100 Forward Loop animation2 VtyEvent (V.EvKey (V.KChar '3') []) -> do - mOld <- preuse (animation3._Just.animationID) + mOld <- use animation3 case mOld of - Just i -> stopAnimation mgr i + Just a -> stopAnimation mgr a Nothing -> startAnimation mgr (length frames3) 300 Forward Loop animation3 AppEvent (AnimationUpdate act) -> act From e4ebe3f129bf8074637cb71df4622554f3f865a7 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Sat, 30 Nov 2024 21:02:15 -0800 Subject: [PATCH 036/134] AnimationDemo: move animation implementation to Brick.Animation --- brick.cabal | 9 +- programs/AnimationDemo.hs | 367 ++------------------------------------ src/Brick/Animation.hs | 352 ++++++++++++++++++++++++++++++++++++ 3 files changed, 373 insertions(+), 355 deletions(-) create mode 100644 src/Brick/Animation.hs diff --git a/brick.cabal b/brick.cabal index 28368f68..e5851a2f 100644 --- a/brick.cabal +++ b/brick.cabal @@ -70,6 +70,7 @@ library hs-source-dirs: src exposed-modules: Brick + Brick.Animation Brick.AttrMap Brick.BChan Brick.BorderMap @@ -126,7 +127,10 @@ library 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) @@ -468,9 +472,6 @@ executable brick-animation-demo microlens-th, microlens-mtl, stm, - unordered-containers, - hashable, - time, mtl executable brick-custom-event-demo diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 1afa1828..7f8f8fa6 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -1,21 +1,10 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE CPP #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} module Main where -import Lens.Micro ((^.), (%~), (.~), (&), Traversal', _Just) +import Lens.Micro ((^.)) import Lens.Micro.TH (makeLenses) import Lens.Micro.Mtl -import Control.Monad (forever, when) -import Control.Concurrent (threadDelay, forkIO, ThreadId, killThread) -import Control.Monad.State.Strict -import Data.Hashable (Hashable) -import Data.Time.Clock -import qualified Data.HashMap.Strict as HM -import qualified Control.Concurrent.STM as STM #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid #endif @@ -45,340 +34,16 @@ import Brick.Widgets.Core , hLimit , vLimit ) - -data AnimationManagerRequest s = - Tick UTCTime - | StartAnimation Int Integer AnimationMode Duration (Traversal' s (Maybe Animation)) - -- ^ ID, frame count, frame duration in milliseconds, mode, duration, updater - | StopAnimation Animation - --- Is this a good name for this type? If we added a 'manual' option --- where the application does frame updates, would it go here? -data Duration = Once | Loop - deriving (Eq, Show, Ord) - -data AnimationMode = - Forward - -- | Backward - -- | PingPong - -- | Random - deriving (Eq, Show, Ord) - -newtype AnimationID = AnimationID Int - deriving (Eq, Ord, Show, Hashable) - -data Animation = - Animation { _animationFrame :: Int - , _animationID :: AnimationID - } - -makeLenses ''Animation - -data AnimationState s = - AnimationState { _animationStateID :: AnimationID - , _animationNumFrames :: Int - , _animationCurrentFrame :: Int - , _animationPreviousFrame :: Maybe Int - , _animationFrameMilliseconds :: Integer - -- what about tracking that an animation is currently - -- moving backward when it sometimes moves forward? Just - -- track the previous frame always, and use that? that - -- works in general (can be ignored in the random case but - -- is used in all others) - , _animationMode :: AnimationMode - , _animationDuration :: Duration - , animationFrameUpdater :: Traversal' s (Maybe Animation) - , _animationNextFrameTime :: UTCTime - } - -makeLenses ''AnimationState - -data AnimationManager s e n = - AnimationManager { animationMgrRequestThreadId :: ThreadId - , animationMgrTickThreadId :: ThreadId - , animationMgrOutputChan :: BChan e - , animationMgrInputChan :: STM.TChan (AnimationManagerRequest s) - , animationMgrEventConstructor :: EventM n s () -> e - , animationMgrRunning :: STM.TVar Bool - } - --- NOTE: should figure out if this should be configurable and, if so, --- whether it should be bounded in any way to avoid pitfalls. -tickMilliseconds :: Int -tickMilliseconds = 100 - -tickThreadBody :: STM.TChan (AnimationManagerRequest s) - -> IO () -tickThreadBody outChan = - forever $ do - threadDelay $ tickMilliseconds * 1000 - now <- getCurrentTime - STM.atomically $ STM.writeTChan outChan $ Tick now - -setNextFrameTime :: UTCTime -> AnimationState s -> AnimationState s -setNextFrameTime t a = a & animationNextFrameTime .~ t - -nominalDiffFromMs :: Integer -> NominalDiffTime -nominalDiffFromMs i = realToFrac (fromIntegral i / (1000.0::Float)) - -nominalDiffToMs :: NominalDiffTime -> Integer -nominalDiffToMs t = - -- NOTE: probably wrong, but we'll have to find out what this gives us - (round $ nominalDiffTimeToSeconds t) - -data ManagerState s e n = - ManagerState { _managerStateInChan :: STM.TChan (AnimationManagerRequest s) - , _managerStateOutChan :: BChan e - , _managerStateEventBuilder :: EventM n s () -> e - , _managerStateAnimations :: HM.HashMap AnimationID (AnimationState s) - , _managerStateIDVar :: STM.TVar AnimationID - } - -makeLenses ''ManagerState - -animationManagerThreadBody :: STM.TChan (AnimationManagerRequest s) - -> 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) -getNextManagerRequest = do - inChan <- use managerStateInChan - liftIO $ STM.atomically $ STM.readTChan inChan - -sendApplicationEvent :: EventM n s () -> ManagerM s e n () -sendApplicationEvent 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)) -lookupAnimation aId = - HM.lookup aId <$> use managerStateAnimations - -insertAnimation :: AnimationState s -> 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 next - -runManager :: ManagerM s e n () -runManager = forever $ do - getNextManagerRequest >>= handleManagerRequest - -handleManagerRequest :: AnimationManagerRequest s -> ManagerM s e n () -handleManagerRequest (StartAnimation numFrames frameMs mode dur updater) = do - aId <- getNextAnimationID - now <- liftIO getCurrentTime - let next = addUTCTime frameOffset now - frameOffset = nominalDiffFromMs frameMs - a = AnimationState { _animationStateID = aId - , _animationNumFrames = numFrames - , _animationCurrentFrame = 0 - , _animationPreviousFrame = Nothing - , _animationFrameMilliseconds = frameMs - , _animationMode = mode - , _animationDuration = dur - , animationFrameUpdater = updater - , _animationNextFrameTime = next - } - - insertAnimation a - sendApplicationEvent $ updater .= Just (Animation { _animationID = aId - , _animationFrame = 0 - }) -handleManagerRequest (StopAnimation a) = do - let aId = a^.animationID - 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 - sendApplicationEvent $ do - animationFrameUpdater aState .= Nothing -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 <- checkForFrames tickTime - case mUpdateAct of - Nothing -> return () - Just act -> sendApplicationEvent act - -checkForFrames :: UTCTime -> ManagerM s e n (Maybe (EventM n s ())) -checkForFrames now = do - -- 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 counter to be updated in the - -- application state. - let addUpdate a Nothing = Just $ updateFor a - addUpdate a (Just updater) = Just $ updater >> updateFor a - - updateFor a = animationFrameUpdater a._Just.animationFrame .= (a^.animationCurrentFrame) - - go :: Maybe (EventM n s ()) -> [AnimationState s] -> ManagerM s e n (Maybe (EventM n s ())) - go mUpdater [] = return mUpdater - go mUpdater (a:as) = do - -- Determine whether the next animation needs to have its - -- frame index advanced. - newUpdater <- if now < a^.animationNextFrameTime - then return mUpdater - else do - -- Determine how many frames have elapsed - -- for this animation, then advance the - -- frame index based the elapsed time. - -- Also set its next frame time. - let differenceMs = nominalDiffToMs $ - diffUTCTime now (a^.animationNextFrameTime) - numFrames = 1 + (differenceMs `div` (a^.animationFrameMilliseconds)) - newNextTime = addUTCTime (nominalDiffFromMs $ numFrames * (a^.animationFrameMilliseconds)) - (a^.animationNextFrameTime) - - -- The new frame is obtained by - -- advancing from the current frame by - -- numFrames. - a' = setNextFrameTime newNextTime $ - advanceBy numFrames a - - managerStateAnimations %= HM.insert (a'^.animationStateID) a' - - -- NOTE! - -- - -- - -- This always advances each animation - -- without regard for the loop mode. This - -- needs to be updated to account for the - -- Once mode where an animation reaches - -- its last frame and stays there. - -- - -- A related question: if something - -- animates once, should it terminate by - -- staying in its last frame? Or should it - -- be unscheduled? - return $ addUpdate a' mUpdater - go newUpdater as - - as <- HM.elems <$> use managerStateAnimations - go Nothing as - -advanceBy :: Integer -> AnimationState s -> AnimationState s -advanceBy n a - | n <= 0 = a - | otherwise = - advanceBy (n - 1) $ - advanceByOne a - -advanceByOne :: AnimationState s -> AnimationState s -advanceByOne a = - case a^.animationMode of - Forward -> - if a^.animationCurrentFrame == a^.animationNumFrames - 1 - then case a^.animationDuration of - Loop -> a & animationCurrentFrame .~ 0 - Once -> a - else a & animationCurrentFrame %~ (+ 1) - --- When a tick occurs: --- for each currently-running animation, --- check to see if the animation should advance and if so by how much --- if it advances at all, schedule that animation state to be updated --- if any animations have advanced, send an event to the application to --- update the animation states involved and redraw --- --- Meanwhile, we can also receive requests from the application to: --- --- * start a new free-running animation --- * start a manually-controlled animation --- * remove an animation (effectively stopping it) --- * shut down entirely - -startAnimationManager :: BChan e -> (EventM n s () -> e) -> IO (AnimationManager s e n) -startAnimationManager outChan mkEvent = do - inChan <- STM.newTChanIO - reqTid <- forkIO $ animationManagerThreadBody inChan outChan mkEvent - tickTid <- forkIO $ tickThreadBody inChan - runningVar <- STM.newTVarIO True - return $ AnimationManager { animationMgrRequestThreadId = reqTid - , animationMgrTickThreadId = tickTid - , animationMgrEventConstructor = mkEvent - , animationMgrOutputChan = outChan - , animationMgrInputChan = inChan - , animationMgrRunning = runningVar - } - -whenRunning :: AnimationManager s e n -> IO () -> IO () -whenRunning mgr act = do - running <- STM.atomically $ STM.readTVar (animationMgrRunning mgr) - when running act - -stopAnimationManager :: AnimationManager s e n -> IO () -stopAnimationManager mgr = - whenRunning mgr $ do - let reqTid = animationMgrRequestThreadId mgr - tickTid = animationMgrTickThreadId mgr - killThread reqTid - killThread tickTid - STM.atomically $ STM.writeTVar (animationMgrRunning mgr) False - -tellAnimationManager :: (MonadIO m) - => AnimationManager s e n -> AnimationManagerRequest s -> m () -tellAnimationManager mgr req = - liftIO $ - STM.atomically $ - STM.writeTChan (animationMgrInputChan mgr) req - -startAnimation :: (MonadIO m) - => AnimationManager s e n - -> Int - -> Integer - -> AnimationMode - -> Duration - -> Traversal' s (Maybe Animation) - -> m () -startAnimation mgr numFrames frameMs mode duration updater = do - tellAnimationManager mgr $ StartAnimation numFrames frameMs mode duration updater - -stopAnimation :: (MonadIO m) - => AnimationManager s e n - -> Animation - -> m () -stopAnimation mgr a = - tellAnimationManager mgr $ StopAnimation a +import qualified Brick.Animation as A data CustomEvent = AnimationUpdate (EventM () St ()) data St = - St { _stAnimationManager :: AnimationManager St CustomEvent () - , _animation1 :: Maybe Animation - , _animation2 :: Maybe Animation - , _animation3 :: Maybe Animation + St { _stAnimationManager :: A.AnimationManager St CustomEvent () + , _animation1 :: Maybe A.Animation + , _animation2 :: Maybe A.Animation + , _animation3 :: Maybe A.Animation } makeLenses ''St @@ -417,9 +82,9 @@ frames3 = , border $ vBox $ replicate 5 $ str $ replicate 5 ' ' ] -drawAnimation :: [Widget n] -> Maybe Animation -> Widget n +drawAnimation :: [Widget n] -> Maybe A.Animation -> Widget n drawAnimation _ Nothing = str " " -drawAnimation frames (Just (Animation i _)) = frames !! i +drawAnimation frames (Just a) = frames !! (A.animationFrame a) appEvent :: BrickEvent () CustomEvent -> EventM () St () appEvent e = do @@ -429,20 +94,20 @@ appEvent e = do VtyEvent (V.EvKey (V.KChar '1') []) -> do mOld <- use animation1 case mOld of - Just a -> stopAnimation mgr a - Nothing -> startAnimation mgr (length frames1) 1000 Forward Loop animation1 + Just a -> A.stopAnimation mgr a + Nothing -> A.startAnimation mgr (length frames1) 1000 A.Forward A.Loop animation1 VtyEvent (V.EvKey (V.KChar '2') []) -> do mOld <- use animation2 case mOld of - Just a -> stopAnimation mgr a - Nothing -> startAnimation mgr (length frames2) 100 Forward Loop animation2 + Just a -> A.stopAnimation mgr a + Nothing -> A.startAnimation mgr (length frames2) 100 A.Forward A.Loop animation2 VtyEvent (V.EvKey (V.KChar '3') []) -> do mOld <- use animation3 case mOld of - Just a -> stopAnimation mgr a - Nothing -> startAnimation mgr (length frames3) 300 Forward Loop animation3 + Just a -> A.stopAnimation mgr a + Nothing -> A.startAnimation mgr (length frames3) 300 A.Forward A.Loop animation3 AppEvent (AnimationUpdate act) -> act _ -> return () @@ -459,7 +124,7 @@ theApp = main :: IO () main = do chan <- newBChan 10 - mgr <- startAnimationManager chan AnimationUpdate + mgr <- A.startAnimationManager chan AnimationUpdate let initialState = St { _stAnimationManager = mgr diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs new file mode 100644 index 00000000..6121eee1 --- /dev/null +++ b/src/Brick/Animation.hs @@ -0,0 +1,352 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE RankNTypes #-} +module Brick.Animation + ( AnimationManager + , Animation + , animationFrame + , Duration(..) + , AnimationMode(..) + , startAnimationManager + , stopAnimationManager + , startAnimation + , stopAnimation + ) +where + +import Control.Concurrent (threadDelay, forkIO, ThreadId, killThread) +import qualified Control.Concurrent.STM as STM +import Control.Monad (forever, when) +import Control.Monad.State.Strict +import Data.Hashable (Hashable) +import qualified Data.HashMap.Strict as HM +import Data.Time.Clock +import Lens.Micro ((^.), (%~), (.~), (&), Traversal', _Just) +import Lens.Micro.TH (makeLenses) +import Lens.Micro.Mtl + +import Brick.BChan +import Brick.Types (EventM) + +data AnimationManagerRequest s = + Tick UTCTime + | StartAnimation Int Integer AnimationMode Duration (Traversal' s (Maybe Animation)) + -- ^ ID, frame count, frame duration in milliseconds, mode, duration, updater + | StopAnimation Animation + +-- Is this a good name for this type? If we added a 'manual' option +-- where the application does frame updates, would it go here? +data Duration = Once | Loop + deriving (Eq, Show, Ord) + +data AnimationMode = + Forward + -- | Backward + -- | PingPong + -- | Random + deriving (Eq, Show, Ord) + +newtype AnimationID = AnimationID Int + deriving (Eq, Ord, Show, Hashable) + +data Animation = + Animation { animationFrame :: Int + , animationID :: AnimationID + } + +data AnimationState s = + AnimationState { _animationStateID :: AnimationID + , _animationNumFrames :: Int + , _animationCurrentFrame :: Int + , _animationPreviousFrame :: Maybe Int + , _animationFrameMilliseconds :: Integer + -- what about tracking that an animation is currently + -- moving backward when it sometimes moves forward? Just + -- track the previous frame always, and use that? that + -- works in general (can be ignored in the random case but + -- is used in all others) + , _animationMode :: AnimationMode + , _animationDuration :: Duration + , animationFrameUpdater :: Traversal' s (Maybe Animation) + , _animationNextFrameTime :: UTCTime + } + +makeLenses ''AnimationState + +data AnimationManager s e n = + AnimationManager { animationMgrRequestThreadId :: ThreadId + , animationMgrTickThreadId :: ThreadId + , animationMgrOutputChan :: BChan e + , animationMgrInputChan :: STM.TChan (AnimationManagerRequest s) + , animationMgrEventConstructor :: EventM n s () -> e + , animationMgrRunning :: STM.TVar Bool + } + +-- NOTE: should figure out if this should be configurable and, if so, +-- whether it should be bounded in any way to avoid pitfalls. +tickMilliseconds :: Int +tickMilliseconds = 100 + +tickThreadBody :: STM.TChan (AnimationManagerRequest s) + -> IO () +tickThreadBody outChan = + forever $ do + threadDelay $ tickMilliseconds * 1000 + now <- getCurrentTime + STM.atomically $ STM.writeTChan outChan $ Tick now + +setNextFrameTime :: UTCTime -> AnimationState s -> AnimationState s +setNextFrameTime t a = a & animationNextFrameTime .~ t + +nominalDiffFromMs :: Integer -> NominalDiffTime +nominalDiffFromMs i = realToFrac (fromIntegral i / (1000.0::Float)) + +nominalDiffToMs :: NominalDiffTime -> Integer +nominalDiffToMs t = + -- NOTE: probably wrong, but we'll have to find out what this gives us + (round $ nominalDiffTimeToSeconds t) + +data ManagerState s e n = + ManagerState { _managerStateInChan :: STM.TChan (AnimationManagerRequest s) + , _managerStateOutChan :: BChan e + , _managerStateEventBuilder :: EventM n s () -> e + , _managerStateAnimations :: HM.HashMap AnimationID (AnimationState s) + , _managerStateIDVar :: STM.TVar AnimationID + } + +makeLenses ''ManagerState + +animationManagerThreadBody :: STM.TChan (AnimationManagerRequest s) + -> 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) +getNextManagerRequest = do + inChan <- use managerStateInChan + liftIO $ STM.atomically $ STM.readTChan inChan + +sendApplicationEvent :: EventM n s () -> ManagerM s e n () +sendApplicationEvent 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)) +lookupAnimation aId = + HM.lookup aId <$> use managerStateAnimations + +insertAnimation :: AnimationState s -> 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 next + +runManager :: ManagerM s e n () +runManager = forever $ do + getNextManagerRequest >>= handleManagerRequest + +handleManagerRequest :: AnimationManagerRequest s -> ManagerM s e n () +handleManagerRequest (StartAnimation numFrames frameMs mode dur updater) = do + aId <- getNextAnimationID + now <- liftIO getCurrentTime + let next = addUTCTime frameOffset now + frameOffset = nominalDiffFromMs frameMs + a = AnimationState { _animationStateID = aId + , _animationNumFrames = numFrames + , _animationCurrentFrame = 0 + , _animationPreviousFrame = Nothing + , _animationFrameMilliseconds = frameMs + , _animationMode = mode + , _animationDuration = dur + , animationFrameUpdater = updater + , _animationNextFrameTime = next + } + + insertAnimation a + sendApplicationEvent $ updater .= Just (Animation { animationID = aId + , animationFrame = 0 + }) +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 + sendApplicationEvent $ do + animationFrameUpdater aState .= Nothing +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 <- checkForFrames tickTime + case mUpdateAct of + Nothing -> return () + Just act -> sendApplicationEvent act + +checkForFrames :: UTCTime -> ManagerM s e n (Maybe (EventM n s ())) +checkForFrames now = do + -- 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 counter to be updated in the + -- application state. + let addUpdate a Nothing = Just $ updateFor a + addUpdate a (Just updater) = Just $ updater >> updateFor a + + updateFor a = animationFrameUpdater a._Just %= (\an -> an { animationFrame = a^.animationCurrentFrame }) + + go :: Maybe (EventM n s ()) -> [AnimationState s] -> ManagerM s e n (Maybe (EventM n s ())) + go mUpdater [] = return mUpdater + go mUpdater (a:as) = do + -- Determine whether the next animation needs to have its + -- frame index advanced. + newUpdater <- if now < a^.animationNextFrameTime + then return mUpdater + else do + -- Determine how many frames have elapsed + -- for this animation, then advance the + -- frame index based the elapsed time. + -- Also set its next frame time. + let differenceMs = nominalDiffToMs $ + diffUTCTime now (a^.animationNextFrameTime) + numFrames = 1 + (differenceMs `div` (a^.animationFrameMilliseconds)) + newNextTime = addUTCTime (nominalDiffFromMs $ numFrames * (a^.animationFrameMilliseconds)) + (a^.animationNextFrameTime) + + -- The new frame is obtained by + -- advancing from the current frame by + -- numFrames. + a' = setNextFrameTime newNextTime $ + advanceBy numFrames a + + managerStateAnimations %= HM.insert (a'^.animationStateID) a' + + -- NOTE! + -- + -- + -- This always advances each animation + -- without regard for the loop mode. This + -- needs to be updated to account for the + -- Once mode where an animation reaches + -- its last frame and stays there. + -- + -- A related question: if something + -- animates once, should it terminate by + -- staying in its last frame? Or should it + -- be unscheduled? + return $ addUpdate a' mUpdater + go newUpdater as + + as <- HM.elems <$> use managerStateAnimations + go Nothing as + +advanceBy :: Integer -> AnimationState s -> AnimationState s +advanceBy n a + | n <= 0 = a + | otherwise = + advanceBy (n - 1) $ + advanceByOne a + +advanceByOne :: AnimationState s -> AnimationState s +advanceByOne a = + case a^.animationMode of + Forward -> + if a^.animationCurrentFrame == a^.animationNumFrames - 1 + then case a^.animationDuration of + Loop -> a & animationCurrentFrame .~ 0 + Once -> a + else a & animationCurrentFrame %~ (+ 1) + +-- When a tick occurs: +-- for each currently-running animation, +-- check to see if the animation should advance and if so by how much +-- if it advances at all, schedule that animation state to be updated +-- if any animations have advanced, send an event to the application to +-- update the animation states involved and redraw +-- +-- Meanwhile, we can also receive requests from the application to: +-- +-- * start a new free-running animation +-- * start a manually-controlled animation +-- * remove an animation (effectively stopping it) +-- * shut down entirely + +startAnimationManager :: BChan e -> (EventM n s () -> e) -> IO (AnimationManager s e n) +startAnimationManager outChan mkEvent = do + inChan <- STM.newTChanIO + reqTid <- forkIO $ animationManagerThreadBody inChan outChan mkEvent + tickTid <- forkIO $ tickThreadBody inChan + runningVar <- STM.newTVarIO True + return $ AnimationManager { animationMgrRequestThreadId = reqTid + , animationMgrTickThreadId = tickTid + , animationMgrEventConstructor = mkEvent + , animationMgrOutputChan = outChan + , animationMgrInputChan = inChan + , animationMgrRunning = runningVar + } + +whenRunning :: AnimationManager s e n -> IO () -> IO () +whenRunning mgr act = do + running <- STM.atomically $ STM.readTVar (animationMgrRunning mgr) + when running act + +stopAnimationManager :: AnimationManager s e n -> IO () +stopAnimationManager mgr = + whenRunning mgr $ do + let reqTid = animationMgrRequestThreadId mgr + tickTid = animationMgrTickThreadId mgr + killThread reqTid + killThread tickTid + STM.atomically $ STM.writeTVar (animationMgrRunning mgr) False + +tellAnimationManager :: (MonadIO m) + => AnimationManager s e n -> AnimationManagerRequest s -> m () +tellAnimationManager mgr req = + liftIO $ + STM.atomically $ + STM.writeTChan (animationMgrInputChan mgr) req + +startAnimation :: (MonadIO m) + => AnimationManager s e n + -> Int + -> Integer + -> AnimationMode + -> Duration + -> Traversal' s (Maybe Animation) + -> m () +startAnimation mgr numFrames frameMs mode duration updater = do + tellAnimationManager mgr $ StartAnimation numFrames frameMs mode duration updater + +stopAnimation :: (MonadIO m) + => AnimationManager s e n + -> Animation + -> m () +stopAnimation mgr a = + tellAnimationManager mgr $ StopAnimation a From 02ba8a7c0bee5260b94a632812e129061498da90 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Sun, 1 Dec 2024 10:59:53 -0800 Subject: [PATCH 037/134] getNextAnimationID: return next ID correctly --- src/Brick/Animation.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 6121eee1..e3dac990 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -162,7 +162,7 @@ getNextAnimationID = do AnimationID i <- STM.readTVar var let next = AnimationID $ i + 1 STM.writeTVar var next - return next + return $ AnimationID i runManager :: ManagerM s e n () runManager = forever $ do From d4bde40e3f766bbff8418eeb47262e666c70f8eb Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Tue, 3 Dec 2024 19:23:25 -0800 Subject: [PATCH 038/134] AnimationDemo: improve UI layout --- programs/AnimationDemo.hs | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 7f8f8fa6..f6d1d359 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -28,7 +28,8 @@ import Brick.Types import Brick.Widgets.Border (border) import Brick.Widgets.Center (center) import Brick.Widgets.Core - ( str + ( (<+>) + , str , vBox , hBox , hLimit @@ -53,17 +54,19 @@ drawUI st = [drawAnimations st] drawAnimations :: St -> Widget () drawAnimations st = - vBox [ hBox [ drawAnimation frames1 $ st^.animation1 - , str " " - , drawAnimation frames2 $ st^.animation2 - , str " " - , drawAnimation frames3 $ st^.animation3 - ] - , vBox [ maybe (str " ") (const $ str "Animation #1 running") $ st^.animation1 - , maybe (str " ") (const $ str "Animation #2 running") $ st^.animation2 - , maybe (str " ") (const $ str "Animation #3 running") $ st^.animation3 - ] - ] + let animStatus label a = + str (label <> ": ") <+> + maybe (str "Not running") (const $ str "Running") a + in vBox [ animStatus "Animation #1" (st^.animation1) + , animStatus "Animation #2" (st^.animation2) + , animStatus "Animation #3" (st^.animation3) + , hBox [ drawAnimation frames1 $ st^.animation1 + , str " " + , drawAnimation frames2 $ st^.animation2 + , str " " + , drawAnimation frames3 $ st^.animation3 + ] + ] -- NOTE: -- Perhaps introduce a Frames type here with a Vector to store frames From 2411cd1d26a410cc35607e67dd4d31515c0cc82f Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Tue, 3 Dec 2024 19:50:21 -0800 Subject: [PATCH 039/134] Brick.Animation: introduce Frames type and store frames in Animations --- programs/AnimationDemo.hs | 38 ++++++++--------- src/Brick/Animation.hs | 86 ++++++++++++++++++++++++--------------- 2 files changed, 70 insertions(+), 54 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index f6d1d359..405e7f98 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -42,9 +42,9 @@ data CustomEvent = data St = St { _stAnimationManager :: A.AnimationManager St CustomEvent () - , _animation1 :: Maybe A.Animation - , _animation2 :: Maybe A.Animation - , _animation3 :: Maybe A.Animation + , _animation1 :: Maybe (A.Animation St ()) + , _animation2 :: Maybe (A.Animation St ()) + , _animation3 :: Maybe (A.Animation St ()) } makeLenses ''St @@ -60,35 +60,29 @@ drawAnimations st = in vBox [ animStatus "Animation #1" (st^.animation1) , animStatus "Animation #2" (st^.animation2) , animStatus "Animation #3" (st^.animation3) - , hBox [ drawAnimation frames1 $ st^.animation1 + , hBox [ A.drawAnimation (str " ") st $ st^.animation1 , str " " - , drawAnimation frames2 $ st^.animation2 + , A.drawAnimation (str " ") st $ st^.animation2 , str " " - , drawAnimation frames3 $ st^.animation3 + , A.drawAnimation (str " ") st $ st^.animation3 ] ] --- NOTE: --- Perhaps introduce a Frames type here with a Vector to store frames --- for more efficient indexing -frames1 :: [Widget ()] -frames1 = str <$> [".", "o", "O", "^", " "] +frames1 :: A.Frames St () +frames1 = A.newFrames $ (const . str) <$> [".", "o", "O", "^", " "] -frames2 :: [Widget ()] -frames2 = str <$> ["|", "/", "-", "\\"] +frames2 :: A.Frames St () +frames2 = A.newFrames $ (const . str) <$> ["|", "/", "-", "\\"] -frames3 :: [Widget ()] +frames3 :: A.Frames St () frames3 = - (hLimit 9 . vLimit 9 . border . center) <$> + A.newFrames $ + (const . hLimit 9 . vLimit 9 . border . center) <$> [ border $ str " " , border $ vBox $ replicate 3 $ str $ replicate 3 ' ' , border $ vBox $ replicate 5 $ str $ replicate 5 ' ' ] -drawAnimation :: [Widget n] -> Maybe A.Animation -> Widget n -drawAnimation _ Nothing = str " " -drawAnimation frames (Just a) = frames !! (A.animationFrame a) - appEvent :: BrickEvent () CustomEvent -> EventM () St () appEvent e = do mgr <- use stAnimationManager @@ -98,19 +92,19 @@ appEvent e = do mOld <- use animation1 case mOld of Just a -> A.stopAnimation mgr a - Nothing -> A.startAnimation mgr (length frames1) 1000 A.Forward A.Loop animation1 + Nothing -> A.startAnimation mgr frames1 1000 A.Forward A.Loop animation1 VtyEvent (V.EvKey (V.KChar '2') []) -> do mOld <- use animation2 case mOld of Just a -> A.stopAnimation mgr a - Nothing -> A.startAnimation mgr (length frames2) 100 A.Forward A.Loop animation2 + Nothing -> A.startAnimation mgr frames2 100 A.Forward A.Loop animation2 VtyEvent (V.EvKey (V.KChar '3') []) -> do mOld <- use animation3 case mOld of Just a -> A.stopAnimation mgr a - Nothing -> A.startAnimation mgr (length frames3) 300 A.Forward A.Loop animation3 + Nothing -> A.startAnimation mgr frames3 300 A.Forward A.Loop animation3 AppEvent (AnimationUpdate act) -> act _ -> return () diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index e3dac990..67643468 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -4,13 +4,16 @@ module Brick.Animation ( AnimationManager , Animation - , animationFrame + , animationFrameIndex , Duration(..) , AnimationMode(..) , startAnimationManager , stopAnimationManager , startAnimation , stopAnimation + , drawAnimation + , Frames + , newFrames ) where @@ -20,19 +23,26 @@ import Control.Monad (forever, when) import Control.Monad.State.Strict import Data.Hashable (Hashable) import qualified Data.HashMap.Strict as HM +import Data.Maybe (fromMaybe) +import qualified Data.Vector as V import Data.Time.Clock import Lens.Micro ((^.), (%~), (.~), (&), Traversal', _Just) import Lens.Micro.TH (makeLenses) import Lens.Micro.Mtl import Brick.BChan -import Brick.Types (EventM) +import Brick.Types (EventM, Widget) -data AnimationManagerRequest s = +newtype Frames s n = Frames (V.Vector (s -> Widget n)) + +newFrames :: [s -> Widget n] -> Frames s n +newFrames = Frames . V.fromList + +data AnimationManagerRequest s n = Tick UTCTime - | StartAnimation Int Integer AnimationMode Duration (Traversal' s (Maybe Animation)) + | StartAnimation (Frames s n) Integer AnimationMode Duration (Traversal' s (Maybe (Animation s n))) -- ^ ID, frame count, frame duration in milliseconds, mode, duration, updater - | StopAnimation Animation + | StopAnimation (Animation s n) -- Is this a good name for this type? If we added a 'manual' option -- where the application does frame updates, would it go here? @@ -49,12 +59,23 @@ data AnimationMode = newtype AnimationID = AnimationID Int deriving (Eq, Ord, Show, Hashable) -data Animation = - Animation { animationFrame :: Int +data Animation s n = + Animation { animationFrameIndex :: Int , animationID :: AnimationID + , animationFrames :: Frames s n } -data AnimationState s = +drawAnimation :: Widget n -> s -> Maybe (Animation s n) -> Widget n +drawAnimation fallback input mAnim = + draw input + where + draw = fromMaybe (const fallback) $ do + a <- mAnim + let idx = animationFrameIndex a + Frames fs = animationFrames a + fs V.!? idx + +data AnimationState s n = AnimationState { _animationStateID :: AnimationID , _animationNumFrames :: Int , _animationCurrentFrame :: Int @@ -67,7 +88,7 @@ data AnimationState s = -- is used in all others) , _animationMode :: AnimationMode , _animationDuration :: Duration - , animationFrameUpdater :: Traversal' s (Maybe Animation) + , animationFrameUpdater :: Traversal' s (Maybe (Animation s n)) , _animationNextFrameTime :: UTCTime } @@ -77,7 +98,7 @@ data AnimationManager s e n = AnimationManager { animationMgrRequestThreadId :: ThreadId , animationMgrTickThreadId :: ThreadId , animationMgrOutputChan :: BChan e - , animationMgrInputChan :: STM.TChan (AnimationManagerRequest s) + , animationMgrInputChan :: STM.TChan (AnimationManagerRequest s n) , animationMgrEventConstructor :: EventM n s () -> e , animationMgrRunning :: STM.TVar Bool } @@ -87,7 +108,7 @@ data AnimationManager s e n = tickMilliseconds :: Int tickMilliseconds = 100 -tickThreadBody :: STM.TChan (AnimationManagerRequest s) +tickThreadBody :: STM.TChan (AnimationManagerRequest s n) -> IO () tickThreadBody outChan = forever $ do @@ -95,7 +116,7 @@ tickThreadBody outChan = now <- getCurrentTime STM.atomically $ STM.writeTChan outChan $ Tick now -setNextFrameTime :: UTCTime -> AnimationState s -> AnimationState s +setNextFrameTime :: UTCTime -> AnimationState s n -> AnimationState s n setNextFrameTime t a = a & animationNextFrameTime .~ t nominalDiffFromMs :: Integer -> NominalDiffTime @@ -107,16 +128,16 @@ nominalDiffToMs t = (round $ nominalDiffTimeToSeconds t) data ManagerState s e n = - ManagerState { _managerStateInChan :: STM.TChan (AnimationManagerRequest s) + ManagerState { _managerStateInChan :: STM.TChan (AnimationManagerRequest s n) , _managerStateOutChan :: BChan e , _managerStateEventBuilder :: EventM n s () -> e - , _managerStateAnimations :: HM.HashMap AnimationID (AnimationState s) + , _managerStateAnimations :: HM.HashMap AnimationID (AnimationState s n) , _managerStateIDVar :: STM.TVar AnimationID } makeLenses ''ManagerState -animationManagerThreadBody :: STM.TChan (AnimationManagerRequest s) +animationManagerThreadBody :: STM.TChan (AnimationManagerRequest s n) -> BChan e -> (EventM n s () -> e) -> IO () @@ -132,7 +153,7 @@ animationManagerThreadBody inChan outChan mkEvent = do type ManagerM s e n a = StateT (ManagerState s e n) IO a -getNextManagerRequest :: ManagerM s e n (AnimationManagerRequest s) +getNextManagerRequest :: ManagerM s e n (AnimationManagerRequest s n) getNextManagerRequest = do inChan <- use managerStateInChan liftIO $ STM.atomically $ STM.readTChan inChan @@ -147,11 +168,11 @@ removeAnimation :: AnimationID -> ManagerM s e n () removeAnimation aId = managerStateAnimations %= HM.delete aId -lookupAnimation :: AnimationID -> ManagerM s e n (Maybe (AnimationState s)) +lookupAnimation :: AnimationID -> ManagerM s e n (Maybe (AnimationState s n)) lookupAnimation aId = HM.lookup aId <$> use managerStateAnimations -insertAnimation :: AnimationState s -> ManagerM s e n () +insertAnimation :: AnimationState s n -> ManagerM s e n () insertAnimation a = managerStateAnimations %= HM.insert (a^.animationStateID) a @@ -168,14 +189,14 @@ runManager :: ManagerM s e n () runManager = forever $ do getNextManagerRequest >>= handleManagerRequest -handleManagerRequest :: AnimationManagerRequest s -> ManagerM s e n () -handleManagerRequest (StartAnimation numFrames frameMs mode dur updater) = do +handleManagerRequest :: AnimationManagerRequest s n -> ManagerM s e n () +handleManagerRequest (StartAnimation frames@(Frames fs) frameMs mode dur updater) = do aId <- getNextAnimationID now <- liftIO getCurrentTime let next = addUTCTime frameOffset now frameOffset = nominalDiffFromMs frameMs a = AnimationState { _animationStateID = aId - , _animationNumFrames = numFrames + , _animationNumFrames = V.length fs , _animationCurrentFrame = 0 , _animationPreviousFrame = Nothing , _animationFrameMilliseconds = frameMs @@ -187,7 +208,8 @@ handleManagerRequest (StartAnimation numFrames frameMs mode dur updater) = do insertAnimation a sendApplicationEvent $ updater .= Just (Animation { animationID = aId - , animationFrame = 0 + , animationFrameIndex = 0 + , animationFrames = frames }) handleManagerRequest (StopAnimation a) = do let aId = animationID a @@ -220,9 +242,9 @@ checkForFrames now = do let addUpdate a Nothing = Just $ updateFor a addUpdate a (Just updater) = Just $ updater >> updateFor a - updateFor a = animationFrameUpdater a._Just %= (\an -> an { animationFrame = a^.animationCurrentFrame }) + updateFor a = animationFrameUpdater a._Just %= (\an -> an { animationFrameIndex = a^.animationCurrentFrame }) - go :: Maybe (EventM n s ()) -> [AnimationState s] -> ManagerM s e n (Maybe (EventM n s ())) + go :: Maybe (EventM n s ()) -> [AnimationState s n] -> ManagerM s e n (Maybe (EventM n s ())) go mUpdater [] = return mUpdater go mUpdater (a:as) = do -- Determine whether the next animation needs to have its @@ -267,14 +289,14 @@ checkForFrames now = do as <- HM.elems <$> use managerStateAnimations go Nothing as -advanceBy :: Integer -> AnimationState s -> AnimationState s +advanceBy :: Integer -> AnimationState s n -> AnimationState s n advanceBy n a | n <= 0 = a | otherwise = advanceBy (n - 1) $ advanceByOne a -advanceByOne :: AnimationState s -> AnimationState s +advanceByOne :: AnimationState s n -> AnimationState s n advanceByOne a = case a^.animationMode of Forward -> @@ -327,7 +349,7 @@ stopAnimationManager mgr = STM.atomically $ STM.writeTVar (animationMgrRunning mgr) False tellAnimationManager :: (MonadIO m) - => AnimationManager s e n -> AnimationManagerRequest s -> m () + => AnimationManager s e n -> AnimationManagerRequest s n -> m () tellAnimationManager mgr req = liftIO $ STM.atomically $ @@ -335,18 +357,18 @@ tellAnimationManager mgr req = startAnimation :: (MonadIO m) => AnimationManager s e n - -> Int + -> Frames s n -> Integer -> AnimationMode -> Duration - -> Traversal' s (Maybe Animation) + -> Traversal' s (Maybe (Animation s n)) -> m () -startAnimation mgr numFrames frameMs mode duration updater = do - tellAnimationManager mgr $ StartAnimation numFrames frameMs mode duration updater +startAnimation mgr frames frameMs mode duration updater = do + tellAnimationManager mgr $ StartAnimation frames frameMs mode duration updater stopAnimation :: (MonadIO m) => AnimationManager s e n - -> Animation + -> Animation s n -> m () stopAnimation mgr a = tellAnimationManager mgr $ StopAnimation a From 2319ef42749cb21f9267b5aa4873ee9b2dc0d951 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Tue, 3 Dec 2024 19:52:44 -0800 Subject: [PATCH 040/134] Brick.Animation: drawAnimation -> renderAnimation --- programs/AnimationDemo.hs | 6 +++--- src/Brick/Animation.hs | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 405e7f98..20f96164 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -60,11 +60,11 @@ drawAnimations st = in vBox [ animStatus "Animation #1" (st^.animation1) , animStatus "Animation #2" (st^.animation2) , animStatus "Animation #3" (st^.animation3) - , hBox [ A.drawAnimation (str " ") st $ st^.animation1 + , hBox [ A.renderAnimation (str " ") st $ st^.animation1 , str " " - , A.drawAnimation (str " ") st $ st^.animation2 + , A.renderAnimation (str " ") st $ st^.animation2 , str " " - , A.drawAnimation (str " ") st $ st^.animation3 + , A.renderAnimation (str " ") st $ st^.animation3 ] ] diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 67643468..880a26aa 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -11,7 +11,7 @@ module Brick.Animation , stopAnimationManager , startAnimation , stopAnimation - , drawAnimation + , renderAnimation , Frames , newFrames ) @@ -65,8 +65,8 @@ data Animation s n = , animationFrames :: Frames s n } -drawAnimation :: Widget n -> s -> Maybe (Animation s n) -> Widget n -drawAnimation fallback input mAnim = +renderAnimation :: Widget n -> s -> Maybe (Animation s n) -> Widget n +renderAnimation fallback input mAnim = draw input where draw = fromMaybe (const fallback) $ do From a3ba3e8bddf042a2665b5664d0927d67e4b42a5f Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Sat, 7 Dec 2024 08:46:56 -0800 Subject: [PATCH 041/134] Brick.Animation: add pingPong frame sequence transformation --- src/Brick/Animation.hs | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 880a26aa..c86e28ae 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -14,6 +14,7 @@ module Brick.Animation , renderAnimation , Frames , newFrames + , pingPong ) where @@ -38,6 +39,14 @@ newtype Frames s n = Frames (V.Vector (s -> Widget n)) newFrames :: [s -> Widget n] -> Frames s n newFrames = Frames . V.fromList +-- | Given a frame sequence, extend it so that when the original +-- sequence end is reached, it reverses order. +-- +-- For example, if this is given frames A, B, C, and D, then this +-- returns a frame sequence A, B, C, D, C, B. +pingPong :: Frames s n -> Frames s n +pingPong (Frames fs) = Frames $ fs <> V.reverse (V.init $ V.tail fs) + data AnimationManagerRequest s n = Tick UTCTime | StartAnimation (Frames s n) Integer AnimationMode Duration (Traversal' s (Maybe (Animation s n))) From cad86371faf392ee8b8b244913310f6c2254a3e8 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Sat, 7 Dec 2024 08:47:32 -0800 Subject: [PATCH 042/134] Brick.Animation: nit --- src/Brick/Animation.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index c86e28ae..b7fa761e 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -61,7 +61,6 @@ data Duration = Once | Loop data AnimationMode = Forward -- | Backward - -- | PingPong -- | Random deriving (Eq, Show, Ord) From f6cbfcd90980aa6d283e7257e8fd31717f860cf8 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Sat, 7 Dec 2024 08:51:21 -0800 Subject: [PATCH 043/134] Brick.Animation: add reverseFrames, update pingPong for frames < 2 --- src/Brick/Animation.hs | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index b7fa761e..b598e39d 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -44,8 +44,16 @@ newFrames = Frames . V.fromList -- -- For example, if this is given frames A, B, C, and D, then this -- returns a frame sequence A, B, C, D, C, B. +-- +-- If the given 'Frames' contains less than two frames, this is +-- equivalent to 'id'. pingPong :: Frames s n -> Frames s n -pingPong (Frames fs) = Frames $ fs <> V.reverse (V.init $ V.tail fs) +pingPong (Frames fs) | V.length fs >= 2 = + Frames $ fs <> V.reverse (V.init $ V.tail fs) +pingPong fs = fs + +reverseFrames :: Frames s n -> Frames s n +reverseFrames (Frames fs) = Frames $ V.reverse fs data AnimationManagerRequest s n = Tick UTCTime @@ -60,7 +68,6 @@ data Duration = Once | Loop data AnimationMode = Forward - -- | Backward -- | Random deriving (Eq, Show, Ord) From ea421d8689f1253e944f6b45383557a29400c6a6 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Sat, 7 Dec 2024 08:52:20 -0800 Subject: [PATCH 044/134] Brick.Animation: rename pingPong --- src/Brick/Animation.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index b598e39d..3c938aa7 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -14,7 +14,7 @@ module Brick.Animation , renderAnimation , Frames , newFrames - , pingPong + , pingPongFrames ) where @@ -47,10 +47,10 @@ newFrames = Frames . V.fromList -- -- If the given 'Frames' contains less than two frames, this is -- equivalent to 'id'. -pingPong :: Frames s n -> Frames s n -pingPong (Frames fs) | V.length fs >= 2 = +pingPongFrames :: Frames s n -> Frames s n +pingPongFrames (Frames fs) | V.length fs >= 2 = Frames $ fs <> V.reverse (V.init $ V.tail fs) -pingPong fs = fs +pingPongFrames fs = fs reverseFrames :: Frames s n -> Frames s n reverseFrames (Frames fs) = Frames $ V.reverse fs From 2833dfcda977a96d3c256c31929b4c71c5cf7f45 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Sat, 7 Dec 2024 08:52:31 -0800 Subject: [PATCH 045/134] Brick.Animation: export reverseFrames --- src/Brick/Animation.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 3c938aa7..b1da2a94 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -15,6 +15,7 @@ module Brick.Animation , Frames , newFrames , pingPongFrames + , reverseFrames ) where From 2afb2c9c18f4881e7014769274ed5d0fd598205f Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 12 Dec 2024 10:35:01 -0800 Subject: [PATCH 046/134] Brick.Animation: remove unused _animationPreviousFrame --- src/Brick/Animation.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index b1da2a94..9f203a13 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -95,7 +95,6 @@ data AnimationState s n = AnimationState { _animationStateID :: AnimationID , _animationNumFrames :: Int , _animationCurrentFrame :: Int - , _animationPreviousFrame :: Maybe Int , _animationFrameMilliseconds :: Integer -- what about tracking that an animation is currently -- moving backward when it sometimes moves forward? Just @@ -214,7 +213,6 @@ handleManagerRequest (StartAnimation frames@(Frames fs) frameMs mode dur updater a = AnimationState { _animationStateID = aId , _animationNumFrames = V.length fs , _animationCurrentFrame = 0 - , _animationPreviousFrame = Nothing , _animationFrameMilliseconds = frameMs , _animationMode = mode , _animationDuration = dur From e0f11da18144719d23cb68c46e0fcdd91f695043 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 12 Dec 2024 10:37:23 -0800 Subject: [PATCH 047/134] AnimationDemo: add keyboard hints to UI --- programs/AnimationDemo.hs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 20f96164..862354ab 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -54,12 +54,13 @@ drawUI st = [drawAnimations st] drawAnimations :: St -> Widget () drawAnimations st = - let animStatus label a = + let animStatus label key a = str (label <> ": ") <+> - maybe (str "Not running") (const $ str "Running") a - in vBox [ animStatus "Animation #1" (st^.animation1) - , animStatus "Animation #2" (st^.animation2) - , animStatus "Animation #3" (st^.animation3) + maybe (str "Not running") (const $ str "Running") a <+> + str (" (Press " <> key <> " to toggle)") + in vBox [ animStatus "Animation #1" "1" (st^.animation1) + , animStatus "Animation #2" "2" (st^.animation2) + , animStatus "Animation #3" "3" (st^.animation3) , hBox [ A.renderAnimation (str " ") st $ st^.animation1 , str " " , A.renderAnimation (str " ") st $ st^.animation2 From c6d9d34b2807e061a36ae404d5961c0376611c7b Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 12 Dec 2024 10:39:16 -0800 Subject: [PATCH 048/134] Brick.Animation: remove stale comment --- src/Brick/Animation.hs | 5 ----- 1 file changed, 5 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 9f203a13..e0b9cf45 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -96,11 +96,6 @@ data AnimationState s n = , _animationNumFrames :: Int , _animationCurrentFrame :: Int , _animationFrameMilliseconds :: Integer - -- what about tracking that an animation is currently - -- moving backward when it sometimes moves forward? Just - -- track the previous frame always, and use that? that - -- works in general (can be ignored in the random case but - -- is used in all others) , _animationMode :: AnimationMode , _animationDuration :: Duration , animationFrameUpdater :: Traversal' s (Maybe (Animation s n)) From 5b0b70561cffc3c79ee4cc2909edafd7749d1bc7 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 12 Dec 2024 10:52:53 -0800 Subject: [PATCH 049/134] Brick.Animation: get rid of AnimationMode since that can be emulated with Frames transformations --- programs/AnimationDemo.hs | 6 +++--- src/Brick/Animation.hs | 31 ++++++++++--------------------- 2 files changed, 13 insertions(+), 24 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 862354ab..af9b233b 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -93,19 +93,19 @@ appEvent e = do mOld <- use animation1 case mOld of Just a -> A.stopAnimation mgr a - Nothing -> A.startAnimation mgr frames1 1000 A.Forward A.Loop animation1 + Nothing -> A.startAnimation mgr frames1 1000 A.Loop animation1 VtyEvent (V.EvKey (V.KChar '2') []) -> do mOld <- use animation2 case mOld of Just a -> A.stopAnimation mgr a - Nothing -> A.startAnimation mgr frames2 100 A.Forward A.Loop animation2 + Nothing -> A.startAnimation mgr frames2 100 A.Loop animation2 VtyEvent (V.EvKey (V.KChar '3') []) -> do mOld <- use animation3 case mOld of Just a -> A.stopAnimation mgr a - Nothing -> A.startAnimation mgr frames3 300 A.Forward A.Loop animation3 + Nothing -> A.startAnimation mgr frames3 300 A.Loop animation3 AppEvent (AnimationUpdate act) -> act _ -> return () diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index e0b9cf45..ecc7a45c 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -6,7 +6,6 @@ module Brick.Animation , Animation , animationFrameIndex , Duration(..) - , AnimationMode(..) , startAnimationManager , stopAnimationManager , startAnimation @@ -58,8 +57,8 @@ reverseFrames (Frames fs) = Frames $ V.reverse fs data AnimationManagerRequest s n = Tick UTCTime - | StartAnimation (Frames s n) Integer AnimationMode Duration (Traversal' s (Maybe (Animation s n))) - -- ^ ID, frame count, frame duration in milliseconds, mode, duration, updater + | StartAnimation (Frames s n) Integer Duration (Traversal' s (Maybe (Animation s n))) + -- ^ ID, frame count, frame duration in milliseconds, duration, updater | StopAnimation (Animation s n) -- Is this a good name for this type? If we added a 'manual' option @@ -67,11 +66,6 @@ data AnimationManagerRequest s n = data Duration = Once | Loop deriving (Eq, Show, Ord) -data AnimationMode = - Forward - -- | Random - deriving (Eq, Show, Ord) - newtype AnimationID = AnimationID Int deriving (Eq, Ord, Show, Hashable) @@ -96,7 +90,6 @@ data AnimationState s n = , _animationNumFrames :: Int , _animationCurrentFrame :: Int , _animationFrameMilliseconds :: Integer - , _animationMode :: AnimationMode , _animationDuration :: Duration , animationFrameUpdater :: Traversal' s (Maybe (Animation s n)) , _animationNextFrameTime :: UTCTime @@ -200,7 +193,7 @@ runManager = forever $ do getNextManagerRequest >>= handleManagerRequest handleManagerRequest :: AnimationManagerRequest s n -> ManagerM s e n () -handleManagerRequest (StartAnimation frames@(Frames fs) frameMs mode dur updater) = do +handleManagerRequest (StartAnimation frames@(Frames fs) frameMs dur updater) = do aId <- getNextAnimationID now <- liftIO getCurrentTime let next = addUTCTime frameOffset now @@ -209,7 +202,6 @@ handleManagerRequest (StartAnimation frames@(Frames fs) frameMs mode dur updater , _animationNumFrames = V.length fs , _animationCurrentFrame = 0 , _animationFrameMilliseconds = frameMs - , _animationMode = mode , _animationDuration = dur , animationFrameUpdater = updater , _animationNextFrameTime = next @@ -307,13 +299,11 @@ advanceBy n a advanceByOne :: AnimationState s n -> AnimationState s n advanceByOne a = - case a^.animationMode of - Forward -> - if a^.animationCurrentFrame == a^.animationNumFrames - 1 - then case a^.animationDuration of - Loop -> a & animationCurrentFrame .~ 0 - Once -> a - else a & animationCurrentFrame %~ (+ 1) + if a^.animationCurrentFrame == a^.animationNumFrames - 1 + then case a^.animationDuration of + Loop -> a & animationCurrentFrame .~ 0 + Once -> a + else a & animationCurrentFrame %~ (+ 1) -- When a tick occurs: -- for each currently-running animation, @@ -368,12 +358,11 @@ startAnimation :: (MonadIO m) => AnimationManager s e n -> Frames s n -> Integer - -> AnimationMode -> Duration -> Traversal' s (Maybe (Animation s n)) -> m () -startAnimation mgr frames frameMs mode duration updater = do - tellAnimationManager mgr $ StartAnimation frames frameMs mode duration updater +startAnimation mgr frames frameMs duration updater = do + tellAnimationManager mgr $ StartAnimation frames frameMs duration updater stopAnimation :: (MonadIO m) => AnimationManager s e n From 50d77196e0d1c793b0e3dbb3b63d2cc6e3d1336e Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 12 Dec 2024 11:23:26 -0800 Subject: [PATCH 050/134] AnimationDemo: make mouse clicks toggle animations at click locations --- brick.cabal | 6 ++--- programs/AnimationDemo.hs | 46 ++++++++++++++++++++++++++++++--------- 2 files changed, 39 insertions(+), 13 deletions(-) diff --git a/brick.cabal b/brick.cabal index e5851a2f..de875b1f 100644 --- a/brick.cabal +++ b/brick.cabal @@ -467,10 +467,10 @@ executable brick-animation-demo build-depends: base, brick, vty, + vty-crossplatform, + containers, text, - microlens >= 0.3.0.0, - microlens-th, - microlens-mtl, + microlens-platform, stm, mtl diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index af9b233b..1c020b99 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -2,19 +2,20 @@ {-# LANGUAGE TemplateHaskell #-} module Main where -import Lens.Micro ((^.)) -import Lens.Micro.TH (makeLenses) -import Lens.Micro.Mtl +import Control.Monad (void) +import Lens.Micro.Platform #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.Main ( App(..) , showFirstCursor - , customMainWithDefaultVty + , customMain , halt ) import Brick.AttrMap @@ -24,6 +25,7 @@ import Brick.Types ( Widget , EventM , BrickEvent(..) + , Location(..) ) import Brick.Widgets.Border (border) import Brick.Widgets.Center (center) @@ -34,6 +36,7 @@ import Brick.Widgets.Core , hBox , hLimit , vLimit + , translateBy ) import qualified Brick.Animation as A @@ -45,12 +48,22 @@ data St = , _animation1 :: Maybe (A.Animation St ()) , _animation2 :: Maybe (A.Animation St ()) , _animation3 :: Maybe (A.Animation St ()) + , _clickAnimations :: M.Map Location (A.Animation St ()) } makeLenses ''St drawUI :: St -> [Widget ()] -drawUI st = [drawAnimations st] +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 (str " ") st (Just a) drawAnimations :: St -> Widget () drawAnimations st = @@ -69,13 +82,13 @@ drawAnimations st = ] ] -frames1 :: A.Frames St () +frames1 :: A.Frames a () frames1 = A.newFrames $ (const . str) <$> [".", "o", "O", "^", " "] -frames2 :: A.Frames St () +frames2 :: A.Frames a () frames2 = A.newFrames $ (const . str) <$> ["|", "/", "-", "\\"] -frames3 :: A.Frames St () +frames3 :: A.Frames a () frames3 = A.newFrames $ (const . hLimit 9 . vLimit 9 . border . center) <$> @@ -88,6 +101,14 @@ appEvent :: BrickEvent () CustomEvent -> EventM () St () appEvent e = do mgr <- use stAnimationManager case e of + VtyEvent (V.EvMouseDown col row _ _) -> do + -- If an animation is already running here, stop it; else + -- start a new one. + let l = Location (col, row) + mA <- use (clickAnimations.at l) + case mA of + Nothing -> A.startAnimation mgr frames2 100 A.Loop (clickAnimations.at l) + Just a -> A.stopAnimation mgr a VtyEvent (V.EvKey V.KEsc []) -> halt VtyEvent (V.EvKey (V.KChar '1') []) -> do mOld <- use animation1 @@ -129,7 +150,12 @@ main = do , _animation1 = Nothing , _animation2 = Nothing , _animation3 = Nothing + , _clickAnimations = mempty } + buildVty = do + v <- mkVty V.defaultConfig + V.setMode (V.outputIface v) V.Mouse True + return v - (_, vty) <- customMainWithDefaultVty (Just chan) theApp initialState - V.shutdown vty + initialVty <- buildVty + void $ customMain initialVty buildVty (Just chan) theApp initialState From 4ef24de12302244842bd4b9a8f046accffdd2d79 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 12 Dec 2024 15:24:52 -0800 Subject: [PATCH 051/134] Brick.Animation: qualify import of Data.Time.Clock --- src/Brick/Animation.hs | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index ecc7a45c..1d4a55e7 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -26,7 +26,7 @@ import Data.Hashable (Hashable) import qualified Data.HashMap.Strict as HM import Data.Maybe (fromMaybe) import qualified Data.Vector as V -import Data.Time.Clock +import qualified Data.Time.Clock as C import Lens.Micro ((^.), (%~), (.~), (&), Traversal', _Just) import Lens.Micro.TH (makeLenses) import Lens.Micro.Mtl @@ -56,7 +56,7 @@ reverseFrames :: Frames s n -> Frames s n reverseFrames (Frames fs) = Frames $ V.reverse fs data AnimationManagerRequest s n = - Tick UTCTime + Tick C.UTCTime | StartAnimation (Frames s n) Integer Duration (Traversal' s (Maybe (Animation s n))) -- ^ ID, frame count, frame duration in milliseconds, duration, updater | StopAnimation (Animation s n) @@ -92,7 +92,7 @@ data AnimationState s n = , _animationFrameMilliseconds :: Integer , _animationDuration :: Duration , animationFrameUpdater :: Traversal' s (Maybe (Animation s n)) - , _animationNextFrameTime :: UTCTime + , _animationNextFrameTime :: C.UTCTime } makeLenses ''AnimationState @@ -116,19 +116,19 @@ tickThreadBody :: STM.TChan (AnimationManagerRequest s n) tickThreadBody outChan = forever $ do threadDelay $ tickMilliseconds * 1000 - now <- getCurrentTime + now <- C.getCurrentTime STM.atomically $ STM.writeTChan outChan $ Tick now -setNextFrameTime :: UTCTime -> AnimationState s n -> AnimationState s n +setNextFrameTime :: C.UTCTime -> AnimationState s n -> AnimationState s n setNextFrameTime t a = a & animationNextFrameTime .~ t -nominalDiffFromMs :: Integer -> NominalDiffTime +nominalDiffFromMs :: Integer -> C.NominalDiffTime nominalDiffFromMs i = realToFrac (fromIntegral i / (1000.0::Float)) -nominalDiffToMs :: NominalDiffTime -> Integer +nominalDiffToMs :: C.NominalDiffTime -> Integer nominalDiffToMs t = -- NOTE: probably wrong, but we'll have to find out what this gives us - (round $ nominalDiffTimeToSeconds t) + (round $ C.nominalDiffTimeToSeconds t) data ManagerState s e n = ManagerState { _managerStateInChan :: STM.TChan (AnimationManagerRequest s n) @@ -195,8 +195,8 @@ runManager = forever $ do handleManagerRequest :: AnimationManagerRequest s n -> ManagerM s e n () handleManagerRequest (StartAnimation frames@(Frames fs) frameMs dur updater) = do aId <- getNextAnimationID - now <- liftIO getCurrentTime - let next = addUTCTime frameOffset now + now <- liftIO C.getCurrentTime + let next = C.addUTCTime frameOffset now frameOffset = nominalDiffFromMs frameMs a = AnimationState { _animationStateID = aId , _animationNumFrames = V.length fs @@ -234,7 +234,7 @@ handleManagerRequest (Tick tickTime) = do Nothing -> return () Just act -> sendApplicationEvent act -checkForFrames :: UTCTime -> ManagerM s e n (Maybe (EventM n s ())) +checkForFrames :: C.UTCTime -> ManagerM s e n (Maybe (EventM n s ())) checkForFrames now = do -- For each active animation, check to see if the animation's next -- frame time has passed. If it has, advance its frame counter as @@ -258,10 +258,10 @@ checkForFrames now = do -- frame index based the elapsed time. -- Also set its next frame time. let differenceMs = nominalDiffToMs $ - diffUTCTime now (a^.animationNextFrameTime) + C.diffUTCTime now (a^.animationNextFrameTime) numFrames = 1 + (differenceMs `div` (a^.animationFrameMilliseconds)) - newNextTime = addUTCTime (nominalDiffFromMs $ numFrames * (a^.animationFrameMilliseconds)) - (a^.animationNextFrameTime) + newNextTime = C.addUTCTime (nominalDiffFromMs $ numFrames * (a^.animationFrameMilliseconds)) + (a^.animationNextFrameTime) -- The new frame is obtained by -- advancing from the current frame by From 03dcb2231fa22e2d1d8221b0f3d33a7da124a713 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 12 Dec 2024 16:34:28 -0800 Subject: [PATCH 052/134] Brick.Animation: make newFrames raise an exception on an empty list --- src/Brick/Animation.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 1d4a55e7..6048aa04 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -37,7 +37,8 @@ import Brick.Types (EventM, Widget) newtype Frames s n = Frames (V.Vector (s -> Widget n)) newFrames :: [s -> Widget n] -> Frames s n -newFrames = Frames . V.fromList +newFrames [] = error "newFrames: got an empty list" +newFrames fs = Frames $ V.fromList fs -- | Given a frame sequence, extend it so that when the original -- sequence end is reached, it reverses order. From ae0c5e9fb420d0062a907ba571d02e1b43171b96 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 12 Dec 2024 16:37:51 -0800 Subject: [PATCH 053/134] Brick.Animation: Frames -> FrameSeq, newFrames -> newFrameSeq --- programs/AnimationDemo.hs | 12 ++++++------ src/Brick/Animation.hs | 32 ++++++++++++++++---------------- 2 files changed, 22 insertions(+), 22 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 1c020b99..98401361 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -82,15 +82,15 @@ drawAnimations st = ] ] -frames1 :: A.Frames a () -frames1 = A.newFrames $ (const . str) <$> [".", "o", "O", "^", " "] +frames1 :: A.FrameSeq a () +frames1 = A.newFrameSeq $ (const . str) <$> [".", "o", "O", "^", " "] -frames2 :: A.Frames a () -frames2 = A.newFrames $ (const . str) <$> ["|", "/", "-", "\\"] +frames2 :: A.FrameSeq a () +frames2 = A.newFrameSeq $ (const . str) <$> ["|", "/", "-", "\\"] -frames3 :: A.Frames a () +frames3 :: A.FrameSeq a () frames3 = - A.newFrames $ + A.newFrameSeq $ (const . hLimit 9 . vLimit 9 . border . center) <$> [ border $ str " " , border $ vBox $ replicate 3 $ str $ replicate 3 ' ' diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 6048aa04..c26e9111 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -11,8 +11,8 @@ module Brick.Animation , startAnimation , stopAnimation , renderAnimation - , Frames - , newFrames + , FrameSeq + , newFrameSeq , pingPongFrames , reverseFrames ) @@ -34,11 +34,11 @@ import Lens.Micro.Mtl import Brick.BChan import Brick.Types (EventM, Widget) -newtype Frames s n = Frames (V.Vector (s -> Widget n)) +newtype FrameSeq s n = FrameSeq (V.Vector (s -> Widget n)) -newFrames :: [s -> Widget n] -> Frames s n -newFrames [] = error "newFrames: got an empty list" -newFrames fs = Frames $ V.fromList fs +newFrameSeq :: [s -> Widget n] -> FrameSeq s n +newFrameSeq [] = error "newFrameSeq: got an empty list" +newFrameSeq fs = FrameSeq $ V.fromList fs -- | Given a frame sequence, extend it so that when the original -- sequence end is reached, it reverses order. @@ -48,17 +48,17 @@ newFrames fs = Frames $ V.fromList fs -- -- If the given 'Frames' contains less than two frames, this is -- equivalent to 'id'. -pingPongFrames :: Frames s n -> Frames s n -pingPongFrames (Frames fs) | V.length fs >= 2 = - Frames $ fs <> V.reverse (V.init $ V.tail fs) +pingPongFrames :: FrameSeq s n -> FrameSeq s n +pingPongFrames (FrameSeq fs) | V.length fs >= 2 = + FrameSeq $ fs <> V.reverse (V.init $ V.tail fs) pingPongFrames fs = fs -reverseFrames :: Frames s n -> Frames s n -reverseFrames (Frames fs) = Frames $ V.reverse fs +reverseFrames :: FrameSeq s n -> FrameSeq s n +reverseFrames (FrameSeq fs) = FrameSeq $ V.reverse fs data AnimationManagerRequest s n = Tick C.UTCTime - | StartAnimation (Frames s n) Integer Duration (Traversal' s (Maybe (Animation s n))) + | StartAnimation (FrameSeq s n) Integer Duration (Traversal' s (Maybe (Animation s n))) -- ^ ID, frame count, frame duration in milliseconds, duration, updater | StopAnimation (Animation s n) @@ -73,7 +73,7 @@ newtype AnimationID = AnimationID Int data Animation s n = Animation { animationFrameIndex :: Int , animationID :: AnimationID - , animationFrames :: Frames s n + , animationFrames :: FrameSeq s n } renderAnimation :: Widget n -> s -> Maybe (Animation s n) -> Widget n @@ -83,7 +83,7 @@ renderAnimation fallback input mAnim = draw = fromMaybe (const fallback) $ do a <- mAnim let idx = animationFrameIndex a - Frames fs = animationFrames a + FrameSeq fs = animationFrames a fs V.!? idx data AnimationState s n = @@ -194,7 +194,7 @@ runManager = forever $ do getNextManagerRequest >>= handleManagerRequest handleManagerRequest :: AnimationManagerRequest s n -> ManagerM s e n () -handleManagerRequest (StartAnimation frames@(Frames fs) frameMs dur updater) = do +handleManagerRequest (StartAnimation frames@(FrameSeq fs) frameMs dur updater) = do aId <- getNextAnimationID now <- liftIO C.getCurrentTime let next = C.addUTCTime frameOffset now @@ -357,7 +357,7 @@ tellAnimationManager mgr req = startAnimation :: (MonadIO m) => AnimationManager s e n - -> Frames s n + -> FrameSeq s n -> Integer -> Duration -> Traversal' s (Maybe (Animation s n)) From 4afb6ad9a6e74bcaef63c57e9054837046957e68 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 12 Dec 2024 16:41:27 -0800 Subject: [PATCH 054/134] Brick.Animation: make manager tick rate configurable and lower-bounded --- programs/AnimationDemo.hs | 2 +- src/Brick/Animation.hs | 22 ++++++++++++---------- 2 files changed, 13 insertions(+), 11 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 98401361..e8543177 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -143,7 +143,7 @@ theApp = main :: IO () main = do chan <- newBChan 10 - mgr <- A.startAnimationManager chan AnimationUpdate + mgr <- A.startAnimationManager 100 chan AnimationUpdate let initialState = St { _stAnimationManager = mgr diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index c26e9111..6c7b0ef3 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -10,6 +10,7 @@ module Brick.Animation , stopAnimationManager , startAnimation , stopAnimation + , minTickDelay , renderAnimation , FrameSeq , newFrameSeq @@ -107,14 +108,10 @@ data AnimationManager s e n = , animationMgrRunning :: STM.TVar Bool } --- NOTE: should figure out if this should be configurable and, if so, --- whether it should be bounded in any way to avoid pitfalls. -tickMilliseconds :: Int -tickMilliseconds = 100 - -tickThreadBody :: STM.TChan (AnimationManagerRequest s n) +tickThreadBody :: Int + -> STM.TChan (AnimationManagerRequest s n) -> IO () -tickThreadBody outChan = +tickThreadBody tickMilliseconds outChan = forever $ do threadDelay $ tickMilliseconds * 1000 now <- C.getCurrentTime @@ -320,11 +317,16 @@ advanceByOne a = -- * remove an animation (effectively stopping it) -- * shut down entirely -startAnimationManager :: BChan e -> (EventM n s () -> e) -> IO (AnimationManager s e n) -startAnimationManager outChan mkEvent = do +minTickDelay :: Int +minTickDelay = 25 + +startAnimationManager :: Int -> BChan e -> (EventM n s () -> e) -> IO (AnimationManager s e n) +startAnimationManager tickMilliseconds _ _ | tickMilliseconds < minTickDelay = + error $ "startAnimationManager: tick delay too small (minimum is " <> show minTickDelay <> ")" +startAnimationManager tickMilliseconds outChan mkEvent = do inChan <- STM.newTChanIO reqTid <- forkIO $ animationManagerThreadBody inChan outChan mkEvent - tickTid <- forkIO $ tickThreadBody inChan + tickTid <- forkIO $ tickThreadBody tickMilliseconds inChan runningVar <- STM.newTVarIO True return $ AnimationManager { animationMgrRequestThreadId = reqTid , animationMgrTickThreadId = tickTid From dfd3e1ff34715082d7ab7189c798daf8eb02c46e Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 12 Dec 2024 16:42:20 -0800 Subject: [PATCH 055/134] Brick.Animation: remove stale comment --- src/Brick/Animation.hs | 14 -------------- 1 file changed, 14 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 6c7b0ef3..70e6a287 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -303,20 +303,6 @@ advanceByOne a = Once -> a else a & animationCurrentFrame %~ (+ 1) --- When a tick occurs: --- for each currently-running animation, --- check to see if the animation should advance and if so by how much --- if it advances at all, schedule that animation state to be updated --- if any animations have advanced, send an event to the application to --- update the animation states involved and redraw --- --- Meanwhile, we can also receive requests from the application to: --- --- * start a new free-running animation --- * start a manually-controlled animation --- * remove an animation (effectively stopping it) --- * shut down entirely - minTickDelay :: Int minTickDelay = 25 From f5a0f094d36b01785896286a84fce564a90ca983 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 12 Dec 2024 16:43:24 -0800 Subject: [PATCH 056/134] Brick.Animation: minTickDelay -> minTickTime --- src/Brick/Animation.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 70e6a287..ef144146 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -10,7 +10,7 @@ module Brick.Animation , stopAnimationManager , startAnimation , stopAnimation - , minTickDelay + , minTickTime , renderAnimation , FrameSeq , newFrameSeq @@ -303,12 +303,12 @@ advanceByOne a = Once -> a else a & animationCurrentFrame %~ (+ 1) -minTickDelay :: Int -minTickDelay = 25 +minTickTime :: Int +minTickTime = 25 startAnimationManager :: Int -> BChan e -> (EventM n s () -> e) -> IO (AnimationManager s e n) -startAnimationManager tickMilliseconds _ _ | tickMilliseconds < minTickDelay = - error $ "startAnimationManager: tick delay too small (minimum is " <> show minTickDelay <> ")" +startAnimationManager tickMilliseconds _ _ | tickMilliseconds < minTickTime = + error $ "startAnimationManager: tick delay too small (minimum is " <> show minTickTime <> ")" startAnimationManager tickMilliseconds outChan mkEvent = do inChan <- STM.newTChanIO reqTid <- forkIO $ animationManagerThreadBody inChan outChan mkEvent From a10ca591896558e096cf5120c9762c152f2afd58 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 12 Dec 2024 16:44:58 -0800 Subject: [PATCH 057/134] Brick.Animation: update docs for pingPongFrames --- src/Brick/Animation.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index ef144146..ae34787a 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -41,13 +41,13 @@ newFrameSeq :: [s -> Widget n] -> FrameSeq s n newFrameSeq [] = error "newFrameSeq: got an empty list" newFrameSeq fs = FrameSeq $ V.fromList fs --- | Given a frame sequence, extend it so that when the original --- sequence end is reached, it reverses order. +-- | Extend a frame sequence so that when the original sequence end is +-- reached, it reverses order. -- -- For example, if this is given frames A, B, C, and D, then this -- returns a frame sequence A, B, C, D, C, B. -- --- If the given 'Frames' contains less than two frames, this is +-- If the given sequence contains less than two frames, this is -- equivalent to 'id'. pingPongFrames :: FrameSeq s n -> FrameSeq s n pingPongFrames (FrameSeq fs) | V.length fs >= 2 = From c1d682590d7b755becc8da801337afdb7a1b9778 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 12 Dec 2024 16:45:15 -0800 Subject: [PATCH 058/134] Brick.Animation: add haddock for reverseFrames --- src/Brick/Animation.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index ae34787a..8d9280f4 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -54,6 +54,7 @@ pingPongFrames (FrameSeq fs) | V.length fs >= 2 = FrameSeq $ fs <> V.reverse (V.init $ V.tail fs) pingPongFrames fs = fs +-- | Reverse a frame sequence. reverseFrames :: FrameSeq s n -> FrameSeq s n reverseFrames (FrameSeq fs) = FrameSeq $ V.reverse fs From 582ad6e92d9f153f38664a9c55a5e7a84da77af0 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 12 Dec 2024 16:47:34 -0800 Subject: [PATCH 059/134] Brick.Animation: Duration -> RunMode --- src/Brick/Animation.hs | 26 ++++++++++++-------------- 1 file changed, 12 insertions(+), 14 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 8d9280f4..1628c1bb 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -5,7 +5,7 @@ module Brick.Animation ( AnimationManager , Animation , animationFrameIndex - , Duration(..) + , RunMode(..) , startAnimationManager , stopAnimationManager , startAnimation @@ -60,13 +60,11 @@ reverseFrames (FrameSeq fs) = FrameSeq $ V.reverse fs data AnimationManagerRequest s n = Tick C.UTCTime - | StartAnimation (FrameSeq s n) Integer Duration (Traversal' s (Maybe (Animation s n))) - -- ^ ID, frame count, frame duration in milliseconds, duration, updater + | StartAnimation (FrameSeq s n) Integer RunMode (Traversal' s (Maybe (Animation s n))) + -- ^ ID, frame count, frame duration in milliseconds, run mode, updater | StopAnimation (Animation s n) --- Is this a good name for this type? If we added a 'manual' option --- where the application does frame updates, would it go here? -data Duration = Once | Loop +data RunMode = Once | Loop deriving (Eq, Show, Ord) newtype AnimationID = AnimationID Int @@ -93,7 +91,7 @@ data AnimationState s n = , _animationNumFrames :: Int , _animationCurrentFrame :: Int , _animationFrameMilliseconds :: Integer - , _animationDuration :: Duration + , _animationRunMode :: RunMode , animationFrameUpdater :: Traversal' s (Maybe (Animation s n)) , _animationNextFrameTime :: C.UTCTime } @@ -192,7 +190,7 @@ runManager = forever $ do getNextManagerRequest >>= handleManagerRequest handleManagerRequest :: AnimationManagerRequest s n -> ManagerM s e n () -handleManagerRequest (StartAnimation frames@(FrameSeq fs) frameMs dur updater) = do +handleManagerRequest (StartAnimation frames@(FrameSeq fs) frameMs runMode updater) = do aId <- getNextAnimationID now <- liftIO C.getCurrentTime let next = C.addUTCTime frameOffset now @@ -201,7 +199,7 @@ handleManagerRequest (StartAnimation frames@(FrameSeq fs) frameMs dur updater) = , _animationNumFrames = V.length fs , _animationCurrentFrame = 0 , _animationFrameMilliseconds = frameMs - , _animationDuration = dur + , _animationRunMode = runMode , animationFrameUpdater = updater , _animationNextFrameTime = next } @@ -274,7 +272,7 @@ checkForFrames now = do -- -- -- This always advances each animation - -- without regard for the loop mode. This + -- without regard for the run mode. This -- needs to be updated to account for the -- Once mode where an animation reaches -- its last frame and stays there. @@ -299,7 +297,7 @@ advanceBy n a advanceByOne :: AnimationState s n -> AnimationState s n advanceByOne a = if a^.animationCurrentFrame == a^.animationNumFrames - 1 - then case a^.animationDuration of + then case a^.animationRunMode of Loop -> a & animationCurrentFrame .~ 0 Once -> a else a & animationCurrentFrame %~ (+ 1) @@ -348,11 +346,11 @@ startAnimation :: (MonadIO m) => AnimationManager s e n -> FrameSeq s n -> Integer - -> Duration + -> RunMode -> Traversal' s (Maybe (Animation s n)) -> m () -startAnimation mgr frames frameMs duration updater = do - tellAnimationManager mgr $ StartAnimation frames frameMs duration updater +startAnimation mgr frames frameMs runMode updater = do + tellAnimationManager mgr $ StartAnimation frames frameMs runMode updater stopAnimation :: (MonadIO m) => AnimationManager s e n From 49e631522267e9c11c4871b1a759f8970b738edc Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 12 Dec 2024 17:12:02 -0800 Subject: [PATCH 060/134] Brick.Animation: support one-shot animations --- src/Brick/Animation.hs | 95 +++++++++++++++++++++++++----------------- 1 file changed, 56 insertions(+), 39 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 1628c1bb..af7d31ce 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -1,6 +1,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE MultiWayIf #-} module Brick.Animation ( AnimationManager , Animation @@ -220,8 +221,7 @@ handleManagerRequest (StopAnimation a) = do -- Set the current animation state in the application state -- to none - sendApplicationEvent $ do - animationFrameUpdater aState .= Nothing + sendApplicationEvent $ clearStateAction aState handleManagerRequest (Tick tickTime) = do -- Check all animation states for frame advances -- based on the relationship between the tick time @@ -231,14 +231,17 @@ handleManagerRequest (Tick tickTime) = do Nothing -> return () Just act -> sendApplicationEvent act +clearStateAction :: AnimationState s n -> EventM n s () +clearStateAction a = animationFrameUpdater a .= Nothing + checkForFrames :: C.UTCTime -> ManagerM s e n (Maybe (EventM n s ())) checkForFrames now = do -- 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 counter to be updated in the -- application state. - let addUpdate a Nothing = Just $ updateFor a - addUpdate a (Just updater) = Just $ updater >> updateFor a + let addUpdate act Nothing = Just act + addUpdate act (Just updater) = Just $ updater >> act updateFor a = animationFrameUpdater a._Just %= (\an -> an { animationFrameIndex = a^.animationCurrentFrame }) @@ -247,46 +250,60 @@ checkForFrames now = do go mUpdater (a:as) = do -- Determine whether the next animation needs to have its -- frame index advanced. - newUpdater <- if now < a^.animationNextFrameTime - then return mUpdater - else do - -- Determine how many frames have elapsed - -- for this animation, then advance the - -- frame index based the elapsed time. - -- Also set its next frame time. - let differenceMs = nominalDiffToMs $ - C.diffUTCTime now (a^.animationNextFrameTime) - numFrames = 1 + (differenceMs `div` (a^.animationFrameMilliseconds)) - newNextTime = C.addUTCTime (nominalDiffFromMs $ numFrames * (a^.animationFrameMilliseconds)) - (a^.animationNextFrameTime) - - -- The new frame is obtained by - -- advancing from the current frame by - -- numFrames. - a' = setNextFrameTime newNextTime $ - advanceBy numFrames a - - managerStateAnimations %= HM.insert (a'^.animationStateID) a' - - -- NOTE! - -- - -- - -- This always advances each animation - -- without regard for the run mode. This - -- needs to be updated to account for the - -- Once mode where an animation reaches - -- its last frame and stays there. - -- - -- A related question: if something - -- animates once, should it terminate by - -- staying in its last frame? Or should it - -- be unscheduled? - return $ addUpdate a' mUpdater + newUpdater <- if | (now < a^.animationNextFrameTime) -> + -- This animation is not due for an + -- update, so don't do anything. + return mUpdater + | finished a -> do + -- This animation has completed, so + -- clear it from the manager and the + -- application state. + removeAnimation (a^.animationStateID) + return $ addUpdate (clearStateAction a) mUpdater + | 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 differenceMs = nominalDiffToMs $ + C.diffUTCTime now (a^.animationNextFrameTime) + numFrames = 1 + (differenceMs `div` (a^.animationFrameMilliseconds)) + newNextTime = C.addUTCTime (nominalDiffFromMs $ numFrames * (a^.animationFrameMilliseconds)) + (a^.animationNextFrameTime) + + -- The new frame is obtained by + -- advancing from the current frame by + -- numFrames. + a' = setNextFrameTime newNextTime $ + advanceBy numFrames a + + managerStateAnimations %= HM.insert (a'^.animationStateID) a' + + -- NOTE! + -- + -- + -- This always advances each animation + -- without regard for the run mode. This + -- needs to be updated to account for the + -- Once mode where an animation reaches + -- its last frame and stays there. + -- + -- A related question: if something + -- animates once, should it terminate by + -- staying in its last frame? Or should it + -- be unscheduled? + return $ addUpdate (updateFor a') mUpdater go newUpdater as as <- HM.elems <$> use managerStateAnimations go Nothing as +finished :: AnimationState s n -> Bool +finished a = + a^.animationRunMode == Once && + a^.animationCurrentFrame == a^.animationNumFrames - 1 + advanceBy :: Integer -> AnimationState s n -> AnimationState s n advanceBy n a | n <= 0 = a From 8682370bd2704c42be0037538a9bf7ef891f8d41 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 12 Dec 2024 17:12:08 -0800 Subject: [PATCH 061/134] AnimationDemo: tweaks --- programs/AnimationDemo.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index e8543177..dd1f3066 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -107,7 +107,7 @@ appEvent e = do let l = Location (col, row) mA <- use (clickAnimations.at l) case mA of - Nothing -> A.startAnimation mgr frames2 100 A.Loop (clickAnimations.at l) + Nothing -> A.startAnimation mgr frames2 100 A.Once (clickAnimations.at l) Just a -> A.stopAnimation mgr a VtyEvent (V.EvKey V.KEsc []) -> halt VtyEvent (V.EvKey (V.KChar '1') []) -> do @@ -126,7 +126,7 @@ appEvent e = do mOld <- use animation3 case mOld of Just a -> A.stopAnimation mgr a - Nothing -> A.startAnimation mgr frames3 300 A.Loop animation3 + Nothing -> A.startAnimation mgr frames3 300 A.Once animation3 AppEvent (AnimationUpdate act) -> act _ -> return () From 0ff0fd823f13d23885daa357dcd707703aa42682 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 12 Dec 2024 17:17:34 -0800 Subject: [PATCH 062/134] AnimationDemo: factor toggleMouseClickAnimation out of appEvent --- programs/AnimationDemo.hs | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index dd1f3066..74669f5e 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -97,18 +97,22 @@ frames3 = , border $ vBox $ replicate 5 $ str $ replicate 5 ' ' ] +toggleMouseClickAnimation :: Location -> EventM () St () +toggleMouseClickAnimation l = do + -- If an animation is already running at this location, stop it; + -- else start a new one. + mgr <- use stAnimationManager + mA <- use (clickAnimations.at l) + case mA of + Nothing -> A.startAnimation mgr frames2 100 A.Once (clickAnimations.at l) + Just a -> A.stopAnimation mgr a + appEvent :: BrickEvent () CustomEvent -> EventM () St () appEvent e = do mgr <- use stAnimationManager case e of VtyEvent (V.EvMouseDown col row _ _) -> do - -- If an animation is already running here, stop it; else - -- start a new one. - let l = Location (col, row) - mA <- use (clickAnimations.at l) - case mA of - Nothing -> A.startAnimation mgr frames2 100 A.Once (clickAnimations.at l) - Just a -> A.stopAnimation mgr a + toggleMouseClickAnimation (Location (col, row)) VtyEvent (V.EvKey V.KEsc []) -> halt VtyEvent (V.EvKey (V.KChar '1') []) -> do mOld <- use animation1 From 33dacb39cae6fc6a828a3697a06e44fd5a73178b Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 12 Dec 2024 17:18:01 -0800 Subject: [PATCH 063/134] AnimationDemo: appEvent layout nit --- programs/AnimationDemo.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 74669f5e..39d8607f 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -113,7 +113,7 @@ appEvent e = do case e of VtyEvent (V.EvMouseDown col row _ _) -> do toggleMouseClickAnimation (Location (col, row)) - VtyEvent (V.EvKey V.KEsc []) -> halt + VtyEvent (V.EvKey (V.KChar '1') []) -> do mOld <- use animation1 case mOld of @@ -133,6 +133,9 @@ appEvent e = do Nothing -> A.startAnimation mgr frames3 300 A.Once animation3 AppEvent (AnimationUpdate act) -> act + + VtyEvent (V.EvKey V.KEsc []) -> halt + _ -> return () theApp :: App St CustomEvent () From dcc029cd3fb6563d3ded22ec4f04df762d6c4b6e Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 12 Dec 2024 17:26:39 -0800 Subject: [PATCH 064/134] Brick.Animation: nit --- src/Brick/Animation.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index af7d31ce..98b1b99d 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -366,7 +366,7 @@ startAnimation :: (MonadIO m) -> RunMode -> Traversal' s (Maybe (Animation s n)) -> m () -startAnimation mgr frames frameMs runMode updater = do +startAnimation mgr frames frameMs runMode updater = tellAnimationManager mgr $ StartAnimation frames frameMs runMode updater stopAnimation :: (MonadIO m) From a3772f411a3a38b60116315d0e677e18c08f3615 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 12 Dec 2024 17:39:57 -0800 Subject: [PATCH 065/134] Brick.Animation: make FrameSeq derive Semigroup --- src/Brick/Animation.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 98b1b99d..878f9db8 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -37,6 +37,7 @@ import Brick.BChan import Brick.Types (EventM, Widget) newtype FrameSeq s n = FrameSeq (V.Vector (s -> Widget n)) + deriving (Semigroup) newFrameSeq :: [s -> Widget n] -> FrameSeq s n newFrameSeq [] = error "newFrameSeq: got an empty list" From 26c5844fc76ad75ecaefb22a961d8e3317f1cade Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 12 Dec 2024 17:40:26 -0800 Subject: [PATCH 066/134] AnimationDemo: generalize machinery for handling demo animations --- programs/AnimationDemo.hs | 74 ++++++++++++++++++++++++--------------- 1 file changed, 45 insertions(+), 29 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 39d8607f..c087fe70 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -1,9 +1,11 @@ {-# 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 @@ -71,16 +73,15 @@ drawAnimations st = str (label <> ": ") <+> maybe (str "Not running") (const $ str "Running") a <+> str (" (Press " <> key <> " to toggle)") - in vBox [ animStatus "Animation #1" "1" (st^.animation1) - , animStatus "Animation #2" "2" (st^.animation2) - , animStatus "Animation #3" "3" (st^.animation3) - , hBox [ A.renderAnimation (str " ") st $ st^.animation1 - , str " " - , A.renderAnimation (str " ") st $ st^.animation2 - , str " " - , A.renderAnimation (str " ") st $ st^.animation3 - ] - ] + statusMessages = statusMessage <$> zip [(0::Int)..] animations + statusMessage (i, (c, config)) = + animStatus ("Animation #" <> (show $ i + 1)) [c] + (st^.(animationTarget config)) + animationDrawings = hBox $ intersperse (str " ") $ + drawSingle <$> animations + drawSingle (_, config) = + A.renderAnimation (str " ") st (st^.(animationTarget config)) + in vBox $ statusMessages <> [animationDrawings] frames1 :: A.FrameSeq a () frames1 = A.newFrameSeq $ (const . str) <$> [".", "o", "O", "^", " "] @@ -104,33 +105,48 @@ toggleMouseClickAnimation l = do mgr <- use stAnimationManager mA <- use (clickAnimations.at l) case mA of - Nothing -> A.startAnimation mgr frames2 100 A.Once (clickAnimations.at l) + Nothing -> A.startAnimation mgr (frames2 <> frames2) 100 A.Once (clickAnimations.at l) Just a -> A.stopAnimation mgr a +data AnimationConfig = + AnimationConfig { animationTarget :: Lens' St (Maybe (A.Animation St ())) + , animationFrames :: A.FrameSeq St () + , animationFrameTime :: Integer + , animationMode :: A.RunMode + } + +animations :: [(Char, AnimationConfig)] +animations = + [ ('1', AnimationConfig animation1 frames1 1000 A.Loop) + , ('2', AnimationConfig animation2 frames2 100 A.Loop) + , ('3', AnimationConfig animation3 frames3 100 A.Once) + ] + +startAnimationFromConfig :: AnimationConfig -> EventM () St () +startAnimationFromConfig config = do + mgr <- use stAnimationManager + A.startAnimation mgr (animationFrames config) + (animationFrameTime config) + (animationMode config) + (animationTarget config) + +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 + appEvent :: BrickEvent () CustomEvent -> EventM () St () appEvent e = do - mgr <- use stAnimationManager case e of VtyEvent (V.EvMouseDown col row _ _) -> do toggleMouseClickAnimation (Location (col, row)) - VtyEvent (V.EvKey (V.KChar '1') []) -> do - mOld <- use animation1 - case mOld of - Just a -> A.stopAnimation mgr a - Nothing -> A.startAnimation mgr frames1 1000 A.Loop animation1 - - VtyEvent (V.EvKey (V.KChar '2') []) -> do - mOld <- use animation2 - case mOld of - Just a -> A.stopAnimation mgr a - Nothing -> A.startAnimation mgr frames2 100 A.Loop animation2 - - VtyEvent (V.EvKey (V.KChar '3') []) -> do - mOld <- use animation3 - case mOld of - Just a -> A.stopAnimation mgr a - Nothing -> A.startAnimation mgr frames3 300 A.Once animation3 + VtyEvent (V.EvKey (V.KChar c) []) + | Just aConfig <- lookup c animations -> + toggleAnimationFromConfig aConfig AppEvent (AnimationUpdate act) -> act From 4bd989b89235dceedd97971c3e1748fa0effab74 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 12 Dec 2024 17:41:55 -0800 Subject: [PATCH 067/134] AnimationDemo: nit --- programs/AnimationDemo.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index c087fe70..189ab1e4 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -78,8 +78,8 @@ drawAnimations st = animStatus ("Animation #" <> (show $ i + 1)) [c] (st^.(animationTarget config)) animationDrawings = hBox $ intersperse (str " ") $ - drawSingle <$> animations - drawSingle (_, config) = + drawSingleAnimation <$> animations + drawSingleAnimation (_, config) = A.renderAnimation (str " ") st (st^.(animationTarget config)) in vBox $ statusMessages <> [animationDrawings] From 0c529be3868a0b695e71584ef1d4fe664eb98267 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 12 Dec 2024 17:45:10 -0800 Subject: [PATCH 068/134] Brick.Animation: factor frameUpdateAction out of checkForFrames --- src/Brick/Animation.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 878f9db8..3721e52b 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -235,6 +235,11 @@ handleManagerRequest (Tick tickTime) = do 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 }) + checkForFrames :: C.UTCTime -> ManagerM s e n (Maybe (EventM n s ())) checkForFrames now = do -- For each active animation, check to see if the animation's next @@ -244,8 +249,6 @@ checkForFrames now = do let addUpdate act Nothing = Just act addUpdate act (Just updater) = Just $ updater >> act - updateFor a = animationFrameUpdater a._Just %= (\an -> an { animationFrameIndex = a^.animationCurrentFrame }) - go :: Maybe (EventM n s ()) -> [AnimationState s n] -> ManagerM s e n (Maybe (EventM n s ())) go mUpdater [] = return mUpdater go mUpdater (a:as) = do @@ -294,7 +297,7 @@ checkForFrames now = do -- animates once, should it terminate by -- staying in its last frame? Or should it -- be unscheduled? - return $ addUpdate (updateFor a') mUpdater + return $ addUpdate (frameUpdateAction a') mUpdater go newUpdater as as <- HM.elems <$> use managerStateAnimations From 02161313cab7773312c4172deacec670ab89436f Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 12 Dec 2024 17:48:04 -0800 Subject: [PATCH 069/134] Brick.Animation: factor updateAnimationState out of checkForFrames --- src/Brick/Animation.hs | 39 +++++++++++++-------------------------- 1 file changed, 13 insertions(+), 26 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 3721e52b..d8f84255 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -240,6 +240,18 @@ frameUpdateAction a = animationFrameUpdater a._Just %= (\an -> an { animationFrameIndex = a^.animationCurrentFrame }) +updateAnimationState :: C.UTCTime -> AnimationState s n -> AnimationState s n +updateAnimationState now a = + let differenceMs = nominalDiffToMs $ + C.diffUTCTime now (a^.animationNextFrameTime) + numFrames = 1 + (differenceMs `div` (a^.animationFrameMilliseconds)) + newNextTime = C.addUTCTime (nominalDiffFromMs $ numFrames * (a^.animationFrameMilliseconds)) + (a^.animationNextFrameTime) + + -- The new frame is obtained by advancing from the current frame by + -- numFrames. + in setNextFrameTime newNextTime $ advanceBy numFrames a + checkForFrames :: C.UTCTime -> ManagerM s e n (Maybe (EventM n s ())) checkForFrames now = do -- For each active animation, check to see if the animation's next @@ -270,33 +282,8 @@ checkForFrames now = do -- elapsed for it and then advance the -- frame index based the elapsed time. -- Also set its next frame time. - let differenceMs = nominalDiffToMs $ - C.diffUTCTime now (a^.animationNextFrameTime) - numFrames = 1 + (differenceMs `div` (a^.animationFrameMilliseconds)) - newNextTime = C.addUTCTime (nominalDiffFromMs $ numFrames * (a^.animationFrameMilliseconds)) - (a^.animationNextFrameTime) - - -- The new frame is obtained by - -- advancing from the current frame by - -- numFrames. - a' = setNextFrameTime newNextTime $ - advanceBy numFrames a - + let a' = updateAnimationState now a managerStateAnimations %= HM.insert (a'^.animationStateID) a' - - -- NOTE! - -- - -- - -- This always advances each animation - -- without regard for the run mode. This - -- needs to be updated to account for the - -- Once mode where an animation reaches - -- its last frame and stays there. - -- - -- A related question: if something - -- animates once, should it terminate by - -- staying in its last frame? Or should it - -- be unscheduled? return $ addUpdate (frameUpdateAction a') mUpdater go newUpdater as From 169103909c442169f3ce2c2f4c4b20f68412dc99 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 12 Dec 2024 17:54:45 -0800 Subject: [PATCH 070/134] AnimationDemo: make mouse animation use colors --- programs/AnimationDemo.hs | 41 ++++++++++++++++++++++++++++++++++++--- 1 file changed, 38 insertions(+), 3 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 189ab1e4..7cce2b42 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -14,6 +14,7 @@ import qualified Graphics.Vty as V import Graphics.Vty.CrossPlatform (mkVty) import Brick.BChan +import Brick.Util (fg) import Brick.Main ( App(..) , showFirstCursor @@ -21,7 +22,10 @@ import Brick.Main , halt ) import Brick.AttrMap - ( attrMap + ( AttrName + , AttrMap + , attrMap + , attrName ) import Brick.Types ( Widget @@ -39,6 +43,7 @@ import Brick.Widgets.Core , hLimit , vLimit , translateBy + , withDefAttr ) import qualified Brick.Animation as A @@ -98,6 +103,36 @@ frames3 = , border $ vBox $ replicate 5 $ str $ replicate 5 ' ' ] +mouseClickFrames :: A.FrameSeq a () +mouseClickFrames = + A.newFrameSeq $ const <$> + [ withDefAttr attr4 $ str "|" + , withDefAttr attr3 $ str "/" + , withDefAttr attr2 $ str "-" + , withDefAttr attr1 $ str "\\" + ] + +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 + [ (attr4, fg V.white) + , (attr3, fg V.cyan) + , (attr2, fg V.blue) + , (attr1, fg V.black) + ] + toggleMouseClickAnimation :: Location -> EventM () St () toggleMouseClickAnimation l = do -- If an animation is already running at this location, stop it; @@ -105,7 +140,7 @@ toggleMouseClickAnimation l = do mgr <- use stAnimationManager mA <- use (clickAnimations.at l) case mA of - Nothing -> A.startAnimation mgr (frames2 <> frames2) 100 A.Once (clickAnimations.at l) + Nothing -> A.startAnimation mgr mouseClickFrames 100 A.Once (clickAnimations.at l) Just a -> A.stopAnimation mgr a data AnimationConfig = @@ -160,7 +195,7 @@ theApp = , appChooseCursor = showFirstCursor , appHandleEvent = appEvent , appStartEvent = return () - , appAttrMap = const $ attrMap V.defAttr [] + , appAttrMap = const attrs } main :: IO () From ac7d21ac5ddaabb0efee25cb6e0031f48abd0b6f Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 12 Dec 2024 17:56:25 -0800 Subject: [PATCH 071/134] AnimationDemo: improve mouse animation frames --- programs/AnimationDemo.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 7cce2b42..907161be 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -106,10 +106,10 @@ frames3 = mouseClickFrames :: A.FrameSeq a () mouseClickFrames = A.newFrameSeq $ const <$> - [ withDefAttr attr4 $ str "|" - , withDefAttr attr3 $ str "/" - , withDefAttr attr2 $ str "-" - , withDefAttr attr1 $ str "\\" + [ withDefAttr attr4 $ str "O" + , withDefAttr attr3 $ str "o" + , withDefAttr attr2 $ str "*" + , withDefAttr attr1 $ str "." ] attr4 :: AttrName From 93ccea4187f060d92743c5a9cfba6f8ab0fc0874 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 12 Dec 2024 18:05:02 -0800 Subject: [PATCH 072/134] AnimationDemo: improve mouse animation frames --- programs/AnimationDemo.hs | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 907161be..fb56bf68 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -106,12 +106,20 @@ frames3 = mouseClickFrames :: A.FrameSeq a () mouseClickFrames = A.newFrameSeq $ const <$> - [ withDefAttr attr4 $ str "O" - , withDefAttr attr3 $ str "o" - , withDefAttr attr2 $ str "*" + [ 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" @@ -127,7 +135,9 @@ attr1 = attrName "attr1" attrs :: AttrMap attrs = attrMap V.defAttr - [ (attr4, fg V.white) + [ (attr6, fg V.white) + , (attr5, fg V.brightYellow) + , (attr4, fg V.brightGreen) , (attr3, fg V.cyan) , (attr2, fg V.blue) , (attr1, fg V.black) From a4930e96d522da85efdb1079e89ce0e8cc5c231d Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 12 Dec 2024 18:07:45 -0800 Subject: [PATCH 073/134] AnimationDemo: simplify mouse animation initiation --- programs/AnimationDemo.hs | 17 ++++++----------- 1 file changed, 6 insertions(+), 11 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index fb56bf68..fe3ee470 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -143,16 +143,6 @@ attrs = , (attr1, fg V.black) ] -toggleMouseClickAnimation :: Location -> EventM () St () -toggleMouseClickAnimation l = do - -- If an animation is already running at this location, stop it; - -- else start a new one. - mgr <- use stAnimationManager - mA <- use (clickAnimations.at l) - case mA of - Nothing -> A.startAnimation mgr mouseClickFrames 100 A.Once (clickAnimations.at l) - Just a -> A.stopAnimation mgr a - data AnimationConfig = AnimationConfig { animationTarget :: Lens' St (Maybe (A.Animation St ())) , animationFrames :: A.FrameSeq St () @@ -183,11 +173,16 @@ toggleAnimationFromConfig config = do Just a -> A.stopAnimation mgr a Nothing -> startAnimationFromConfig config +startMouseClickAnimation :: Location -> EventM () St () +startMouseClickAnimation l = do + mgr <- use stAnimationManager + A.startAnimation mgr mouseClickFrames 100 A.Once (clickAnimations.at l) + appEvent :: BrickEvent () CustomEvent -> EventM () St () appEvent e = do case e of VtyEvent (V.EvMouseDown col row _ _) -> do - toggleMouseClickAnimation (Location (col, row)) + startMouseClickAnimation (Location (col, row)) VtyEvent (V.EvKey (V.KChar c) []) | Just aConfig <- lookup c animations -> From 7b1ce6a54e521accfca9471a3452f4429680bda1 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 12 Dec 2024 18:09:22 -0800 Subject: [PATCH 074/134] AnimationDemo: condense imports --- programs/AnimationDemo.hs | 32 ++++---------------------------- 1 file changed, 4 insertions(+), 28 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index fe3ee470..f201992e 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -15,36 +15,12 @@ import Graphics.Vty.CrossPlatform (mkVty) import Brick.BChan import Brick.Util (fg) -import Brick.Main - ( App(..) - , showFirstCursor - , customMain - , halt - ) -import Brick.AttrMap - ( AttrName - , AttrMap - , attrMap - , attrName - ) -import Brick.Types - ( Widget - , EventM - , BrickEvent(..) - , Location(..) - ) +import Brick.Main (App(..), showFirstCursor, 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 Brick.Widgets.Core ((<+>), str, vBox, hBox, hLimit, vLimit, translateBy, withDefAttr) import qualified Brick.Animation as A data CustomEvent = From 493f2b83a18167787d79fc82ffcd622b3f9d7c45 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 13 Dec 2024 09:09:49 -0800 Subject: [PATCH 075/134] AnimationDemo: add UI note about possible actions --- programs/AnimationDemo.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index f201992e..bc4ac1c3 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -62,7 +62,10 @@ drawAnimations st = drawSingleAnimation <$> animations drawSingleAnimation (_, config) = A.renderAnimation (str " ") st (st^.(animationTarget config)) - in vBox $ statusMessages <> [animationDrawings] + in vBox $ + str "Click and drag the mouse or press keys to start animations." : + str " " : + statusMessages <> [animationDrawings] frames1 :: A.FrameSeq a () frames1 = A.newFrameSeq $ (const . str) <$> [".", "o", "O", "^", " "] From 5e847f7d9b5a8946821752b0e75a3b9b1ffd4a33 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 13 Dec 2024 09:19:45 -0800 Subject: [PATCH 076/134] Brick.Animation: finished -> isFinished --- src/Brick/Animation.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index d8f84255..a52512c6 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -270,7 +270,7 @@ checkForFrames now = do -- This animation is not due for an -- update, so don't do anything. return mUpdater - | finished a -> do + | isFinished a -> do -- This animation has completed, so -- clear it from the manager and the -- application state. @@ -290,8 +290,8 @@ checkForFrames now = do as <- HM.elems <$> use managerStateAnimations go Nothing as -finished :: AnimationState s n -> Bool -finished a = +isFinished :: AnimationState s n -> Bool +isFinished a = a^.animationRunMode == Once && a^.animationCurrentFrame == a^.animationNumFrames - 1 From 6c0fbbfa0713fc4f13050a3557373cfdb566c5c2 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 13 Dec 2024 09:25:31 -0800 Subject: [PATCH 077/134] Brick.Animation: clean up checkForFrames --- src/Brick/Animation.hs | 56 ++++++++++++++++++++---------------------- 1 file changed, 26 insertions(+), 30 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index a52512c6..73ae26d4 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -26,7 +26,7 @@ import Control.Monad (forever, when) import Control.Monad.State.Strict import Data.Hashable (Hashable) import qualified Data.HashMap.Strict as HM -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, catMaybes) import qualified Data.Vector as V import qualified Data.Time.Clock as C import Lens.Micro ((^.), (%~), (.~), (&), Traversal', _Just) @@ -258,37 +258,33 @@ checkForFrames now = do -- frame time has passed. If it has, advance its frame counter as -- appropriate and schedule its frame counter to be updated in the -- application state. - let addUpdate act Nothing = Just act - addUpdate act (Just updater) = Just $ updater >> act - - go :: Maybe (EventM n s ()) -> [AnimationState s n] -> ManagerM s e n (Maybe (EventM n s ())) - go mUpdater [] = return mUpdater - go mUpdater (a:as) = do - -- Determine whether the next animation needs to have its - -- frame index advanced. - newUpdater <- if | (now < a^.animationNextFrameTime) -> - -- This animation is not due for an - -- update, so don't do anything. - return mUpdater - | isFinished a -> do - -- This animation has completed, so - -- clear it from the manager and the - -- application state. - removeAnimation (a^.animationStateID) - return $ addUpdate (clearStateAction a) mUpdater - | 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 $ addUpdate (frameUpdateAction a') mUpdater - go newUpdater as + let getUpdater :: AnimationState s n -> ManagerM s e n (Maybe (EventM n s ())) + getUpdater a = + if | (now < a^.animationNextFrameTime) -> + -- This animation is not due for an + -- update, so don't do anything. + return Nothing + | isFinished a -> do + -- This animation has completed, so + -- clear it from the manager and the + -- application state. + removeAnimation (a^.animationStateID) + return $ Just $ clearStateAction a + | 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' as <- HM.elems <$> use managerStateAnimations - go Nothing as + updaters <- catMaybes <$> mapM getUpdater as + case updaters of + [] -> return Nothing + _ -> return $ Just $ sequence_ updaters isFinished :: AnimationState s n -> Bool isFinished a = From 28c878d9ccb1165c273e139360d87680554bc7e7 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 13 Dec 2024 09:26:32 -0800 Subject: [PATCH 078/134] Brick.Animation: replace multi-way if with function guards in checkForFrames --- src/Brick/Animation.hs | 41 ++++++++++++++++++++--------------------- 1 file changed, 20 insertions(+), 21 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 73ae26d4..304ff094 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -1,7 +1,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE MultiWayIf #-} module Brick.Animation ( AnimationManager , Animation @@ -259,26 +258,26 @@ checkForFrames now = do -- appropriate and schedule its frame counter to be updated in the -- application state. let getUpdater :: AnimationState s n -> ManagerM s e n (Maybe (EventM n s ())) - getUpdater a = - if | (now < a^.animationNextFrameTime) -> - -- This animation is not due for an - -- update, so don't do anything. - return Nothing - | isFinished a -> do - -- This animation has completed, so - -- clear it from the manager and the - -- application state. - removeAnimation (a^.animationStateID) - return $ Just $ clearStateAction a - | 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' + getUpdater a + | (now < a^.animationNextFrameTime) = + -- This animation is not due for an + -- update, so don't do anything. + return Nothing + | isFinished a = do + -- This animation has completed, so + -- clear it from the manager and the + -- application state. + removeAnimation (a^.animationStateID) + return $ Just $ clearStateAction a + | 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' as <- HM.elems <$> use managerStateAnimations updaters <- catMaybes <$> mapM getUpdater as From ec92fde99a10e34bc014dcaa31e03cc54a9ab2a1 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 13 Dec 2024 09:28:04 -0800 Subject: [PATCH 079/134] Brick.Animation: factor checkAnimation out of checkForFrames --- src/Brick/Animation.hs | 54 +++++++++++++++++++++--------------------- 1 file changed, 27 insertions(+), 27 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 304ff094..0bc1de4c 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -253,38 +253,38 @@ updateAnimationState now a = checkForFrames :: C.UTCTime -> ManagerM s e n (Maybe (EventM n s ())) checkForFrames now = do - -- 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 counter to be updated in the - -- application state. - let getUpdater :: AnimationState s n -> ManagerM s e n (Maybe (EventM n s ())) - getUpdater a - | (now < a^.animationNextFrameTime) = - -- This animation is not due for an - -- update, so don't do anything. - return Nothing - | isFinished a = do - -- This animation has completed, so - -- clear it from the manager and the - -- application state. - removeAnimation (a^.animationStateID) - return $ Just $ clearStateAction a - | 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' - as <- HM.elems <$> use managerStateAnimations - updaters <- catMaybes <$> mapM getUpdater as + updaters <- catMaybes <$> mapM (checkAnimation now) as 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 counter to be updated in the +-- application state. +checkAnimation :: C.UTCTime -> AnimationState s n -> ManagerM s e n (Maybe (EventM n s ())) +checkAnimation now a + | (now < a^.animationNextFrameTime) = + -- This animation is not due for an + -- update, so don't do anything. + return Nothing + | isFinished a = do + -- This animation has completed, so + -- clear it from the manager and the + -- application state. + removeAnimation (a^.animationStateID) + return $ Just $ clearStateAction a + | 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 = a^.animationRunMode == Once && From 2a9c9a5df716d5a49e889722374a9132786a1d48 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 13 Dec 2024 09:28:26 -0800 Subject: [PATCH 080/134] Brick.Animation: rename checkForFrames to checkAnimations --- src/Brick/Animation.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 0bc1de4c..5464502d 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -226,7 +226,7 @@ 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 <- checkForFrames tickTime + mUpdateAct <- checkAnimations tickTime case mUpdateAct of Nothing -> return () Just act -> sendApplicationEvent act @@ -251,8 +251,8 @@ updateAnimationState now a = -- numFrames. in setNextFrameTime newNextTime $ advanceBy numFrames a -checkForFrames :: C.UTCTime -> ManagerM s e n (Maybe (EventM n s ())) -checkForFrames now = do +checkAnimations :: C.UTCTime -> ManagerM s e n (Maybe (EventM n s ())) +checkAnimations now = do as <- HM.elems <$> use managerStateAnimations updaters <- catMaybes <$> mapM (checkAnimation now) as case updaters of From 3214023230f0b4d5e263dca90ccb91d9793af458 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 13 Dec 2024 09:28:52 -0800 Subject: [PATCH 081/134] Brick.Animation.checkAnimation: update comment formatting --- src/Brick/Animation.hs | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 5464502d..cfe3e602 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -266,21 +266,18 @@ checkAnimations now = do checkAnimation :: C.UTCTime -> AnimationState s n -> ManagerM s e n (Maybe (EventM n s ())) checkAnimation now a | (now < a^.animationNextFrameTime) = - -- This animation is not due for an - -- update, so don't do anything. + -- This animation is not due for an update, so don't do + -- anything. return Nothing | isFinished a = do - -- This animation has completed, so - -- clear it from the manager and the - -- application state. + -- This animation has completed, so clear it from the manager + -- and the application state. removeAnimation (a^.animationStateID) return $ Just $ clearStateAction a | 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. + -- 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' From 67c5920c77c34625f6f500c6a54c4f9f5c6bc965 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 13 Dec 2024 09:40:13 -0800 Subject: [PATCH 082/134] Brick.Animation: run stopAnimationManager in MonadIO --- src/Brick/Animation.hs | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index cfe3e602..bdb0872a 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -302,6 +302,8 @@ advanceByOne a = Once -> a else a & animationCurrentFrame %~ (+ 1) +-- | The minimum tick duration in milliseconds allowed by +-- 'startAnimationManager'. minTickTime :: Int minTickTime = 25 @@ -321,18 +323,18 @@ startAnimationManager tickMilliseconds outChan mkEvent = do , animationMgrRunning = runningVar } -whenRunning :: AnimationManager s e n -> IO () -> IO () +-- | Execute the specified action only when this manager is running. +whenRunning :: (MonadIO m) => AnimationManager s e n -> IO () -> m () whenRunning mgr act = do - running <- STM.atomically $ STM.readTVar (animationMgrRunning mgr) - when running act + running <- liftIO $ STM.atomically $ STM.readTVar (animationMgrRunning mgr) + when running $ liftIO act -stopAnimationManager :: AnimationManager s e n -> IO () +-- | Stop the animation manager, ending all animations. +stopAnimationManager :: (MonadIO m) => AnimationManager s e n -> m () stopAnimationManager mgr = whenRunning mgr $ do - let reqTid = animationMgrRequestThreadId mgr - tickTid = animationMgrTickThreadId mgr - killThread reqTid - killThread tickTid + tellAnimationManager mgr Shutdown + killThread $ animationMgrTickThreadId mgr STM.atomically $ STM.writeTVar (animationMgrRunning mgr) False tellAnimationManager :: (MonadIO m) From ac2301cccf8fc83e9a97dd7c2ac2703718824db7 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 13 Dec 2024 09:40:34 -0800 Subject: [PATCH 083/134] Brick.Animation: have manager shut down on request and stop all running animations --- src/Brick/Animation.hs | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index bdb0872a..0af5aff1 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -19,7 +19,7 @@ module Brick.Animation ) where -import Control.Concurrent (threadDelay, forkIO, ThreadId, killThread) +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 @@ -64,6 +64,7 @@ data AnimationManagerRequest s n = | StartAnimation (FrameSeq s n) Integer RunMode (Traversal' s (Maybe (Animation s n))) -- ^ ID, frame count, frame duration in milliseconds, run mode, updater | StopAnimation (Animation s n) + | Shutdown data RunMode = Once | Loop deriving (Eq, Show, Ord) @@ -222,6 +223,14 @@ handleManagerRequest (StopAnimation a) = do -- Set the current animation state in the application state -- to none sendApplicationEvent $ clearStateAction aState +handleManagerRequest Shutdown = do + as <- HM.elems <$> use managerStateAnimations + + let updater = sequence_ $ clearStateAction <$> as + when (length as > 0) $ do + sendApplicationEvent updater + + liftIO $ myThreadId >>= killThread handleManagerRequest (Tick tickTime) = do -- Check all animation states for frame advances -- based on the relationship between the tick time From 604c9ad9fa107414e78734375c110c695b96d6ec Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 13 Dec 2024 09:40:52 -0800 Subject: [PATCH 084/134] Brick.Animation: add startAnimationManager haddock --- src/Brick/Animation.hs | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 0af5aff1..70e1e307 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -316,7 +316,19 @@ advanceByOne a = minTickTime :: Int minTickTime = 25 -startAnimationManager :: Int -> BChan e -> (EventM n s () -> e) -> IO (AnimationManager s e n) +-- | Start a new animation manager. +-- +-- If the specifie tick duration is less than 'minTickTime', this will +-- call 'error'. +startAnimationManager :: Int + -- ^ The tick duration for this manager in milliseconds + -> BChan e + -- ^ The event channel to use to send updates to + -- the application + -> (EventM n s () -> e) + -- ^ A constructor for building custom events that + -- perform application state updates + -> IO (AnimationManager s e n) startAnimationManager tickMilliseconds _ _ | tickMilliseconds < minTickTime = error $ "startAnimationManager: tick delay too small (minimum is " <> show minTickTime <> ")" startAnimationManager tickMilliseconds outChan mkEvent = do From fda8f2c3666990e179d2b78c7434dd88fe32b84d Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 13 Dec 2024 09:47:34 -0800 Subject: [PATCH 085/134] Brick.Animation: add more haddock comments --- src/Brick/Animation.hs | 33 ++++++++++++++++++++++++++++++++- 1 file changed, 32 insertions(+), 1 deletion(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 70e1e307..f1a1a85e 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -38,6 +38,8 @@ import Brick.Types (EventM, Widget) newtype FrameSeq s n = FrameSeq (V.Vector (s -> Widget n)) deriving (Semigroup) +-- | Build a new frame sequence. If the provided list is empty, this +-- calls 'error'. newFrameSeq :: [s -> Widget n] -> FrameSeq s n newFrameSeq [] = error "newFrameSeq: got an empty list" newFrameSeq fs = FrameSeq $ V.fromList fs @@ -72,13 +74,28 @@ data RunMode = Once | Loop newtype AnimationID = AnimationID Int deriving (Eq, Ord, Show, Hashable) +-- | The state of a running animation. data Animation s n = Animation { animationFrameIndex :: Int + -- ^ The animation's current frame index. Applications + -- won't need to access this in most situations; use + -- 'renderAnimation' instead. , animationID :: AnimationID + -- ^ The animation's internally-managed ID , animationFrames :: FrameSeq s n + -- ^ The animation's frame sequence } -renderAnimation :: Widget n -> s -> Maybe (Animation s n) -> Widget n +-- | Render an animation. +renderAnimation :: Widget n + -- ^ The fallback drawing to render if the animation is + -- not running + -> s + -- ^ The state to provide when constructing the + -- animation's current frame + -> Maybe (Animation s n) + -- ^ The animation state itself + -> Widget n renderAnimation fallback input mAnim = draw input where @@ -365,16 +382,30 @@ tellAnimationManager mgr req = 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. startAnimation :: (MonadIO m) => AnimationManager s e n + -- ^ The manager to run the animation -> FrameSeq s n + -- ^ The frames for the animation -> Integer + -- ^ The animation's tick duration in milliseconds -> RunMode + -- ^ The animation's run mode -> Traversal' s (Maybe (Animation s n)) + -- ^ Where in the application state to manage this + -- animation -> 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 From a045787630e4e00a1bd70a68daef3a904a491f13 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 13 Dec 2024 09:48:30 -0800 Subject: [PATCH 086/134] Brick.Animation: organize exports --- src/Brick/Animation.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index f1a1a85e..dacbd145 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -3,15 +3,18 @@ {-# LANGUAGE RankNTypes #-} module Brick.Animation ( AnimationManager + , startAnimationManager + , stopAnimationManager + , Animation , animationFrameIndex + , RunMode(..) - , startAnimationManager - , stopAnimationManager , startAnimation , stopAnimation , minTickTime , renderAnimation + , FrameSeq , newFrameSeq , pingPongFrames From 31571dd9368c8cdaee7f239b0f16db09d7e80bcf Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 13 Dec 2024 09:49:00 -0800 Subject: [PATCH 087/134] Brick.Animation: add haddock comment for FrameSeq --- src/Brick/Animation.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index dacbd145..2351ea39 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -38,6 +38,7 @@ import Lens.Micro.Mtl import Brick.BChan import Brick.Types (EventM, Widget) +-- | A sequence of a animation frames. newtype FrameSeq s n = FrameSeq (V.Vector (s -> Widget n)) deriving (Semigroup) From 378e18665ad91986adab83187cc2590ae8313fd1 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 13 Dec 2024 10:12:12 -0800 Subject: [PATCH 088/134] Brick.Animation: haddock updates --- src/Brick/Animation.hs | 62 ++++++++++++++++++++++++++++++++++-------- 1 file changed, 51 insertions(+), 11 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 2351ea39..0f21ca07 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -2,19 +2,24 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE RankNTypes #-} module Brick.Animation - ( AnimationManager + ( -- * Animation managers + AnimationManager , startAnimationManager , stopAnimationManager + , minTickTime , Animation , animationFrameIndex + -- * Starting and stopping animations , RunMode(..) , startAnimation , stopAnimation - , minTickTime + + -- * Rendering animation frames , renderAnimation + -- * Building and transforming frame sequences , FrameSeq , newFrameSeq , pingPongFrames @@ -42,14 +47,20 @@ import Brick.Types (EventM, Widget) newtype FrameSeq s n = FrameSeq (V.Vector (s -> Widget n)) deriving (Semigroup) --- | Build a new frame sequence. If the provided list is empty, this --- calls 'error'. +-- | Build a new frame sequence. +-- +-- Each entry in a frame sequence is 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 'appDraw'. +-- +-- If the provided list is empty, this calls 'error'. newFrameSeq :: [s -> Widget n] -> FrameSeq s n newFrameSeq [] = error "newFrameSeq: got an empty list" newFrameSeq fs = FrameSeq $ V.fromList fs --- | Extend a frame sequence so that when the original sequence end is --- reached, it reverses order. +-- | Extend a frame sequence so that when the end of the original +-- sequence is reached, it continues in reverse order to create a loop. -- -- For example, if this is given frames A, B, C, and D, then this -- returns a frame sequence A, B, C, D, C, B. @@ -72,7 +83,12 @@ data AnimationManagerRequest s n = | StopAnimation (Animation s n) | Shutdown -data RunMode = Once | Loop +-- | 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 @@ -121,6 +137,9 @@ data AnimationState s n = makeLenses ''AnimationState +-- | A manager for animations. +-- +-- Create one of these for your application. data AnimationManager s e n = AnimationManager { animationMgrRequestThreadId :: ThreadId , animationMgrTickThreadId :: ThreadId @@ -339,16 +358,37 @@ minTickTime = 25 -- | Start a new animation manager. -- --- If the specifie tick duration is less than 'minTickTime', this will --- call 'error'. +-- The animation manager internally runs at a tick rate, specified here +-- as a tick duration in milliseconds. The tick duration determines how +-- often the manager will check for animation updates and send them to +-- the application, so the smaller the tick duration, the more often the +-- manager will trigger screen redraws and application state updates. +-- Not only does this mean that this should be taken into consideration +-- when thinking about the performance and animation needs of your +-- application, but it also means that if an animation has a shorter +-- tick duration than the manager, that animation may skip frames. +-- +-- When the manager needs to send state updates, it does so by using +-- the provided custom event constructor here. This allows the manager +-- to schedule a state update which the application is responsible for +-- evaluating. The state updates are built from the traversals provided +-- to 'startAnimation'. +-- +-- 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 :: Int -- ^ The tick duration for this manager in milliseconds -> BChan e -- ^ The event channel to use to send updates to -- the application -> (EventM n s () -> e) - -- ^ A constructor for building custom events that - -- perform application state updates + -- ^ A constructor for building custom events + -- that perform application state updates. The + -- application must evaluate the provided 'EventM' + -- action given by these events in order to get + -- animation updates made to the application + -- state. -> IO (AnimationManager s e n) startAnimationManager tickMilliseconds _ _ | tickMilliseconds < minTickTime = error $ "startAnimationManager: tick delay too small (minimum is " <> show minTickTime <> ")" From bbc12c4d7ff9508d332765eff6b251360c2e5545 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 13 Dec 2024 10:12:24 -0800 Subject: [PATCH 089/134] Brick.Animation: add newFrameSeq_ --- programs/AnimationDemo.hs | 8 ++++---- src/Brick/Animation.hs | 6 ++++++ 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index bc4ac1c3..3d149cc6 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -68,15 +68,15 @@ drawAnimations st = statusMessages <> [animationDrawings] frames1 :: A.FrameSeq a () -frames1 = A.newFrameSeq $ (const . str) <$> [".", "o", "O", "^", " "] +frames1 = A.newFrameSeq_ $ str <$> [".", "o", "O", "^", " "] frames2 :: A.FrameSeq a () -frames2 = A.newFrameSeq $ (const . str) <$> ["|", "/", "-", "\\"] +frames2 = A.newFrameSeq_ $ str <$> ["|", "/", "-", "\\"] frames3 :: A.FrameSeq a () frames3 = - A.newFrameSeq $ - (const . hLimit 9 . vLimit 9 . border . center) <$> + A.newFrameSeq_ $ + (hLimit 9 . vLimit 9 . border . center) <$> [ border $ str " " , border $ vBox $ replicate 3 $ str $ replicate 3 ' ' , border $ vBox $ replicate 5 $ str $ replicate 5 ' ' diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 0f21ca07..4ce7948f 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -22,6 +22,7 @@ module Brick.Animation -- * Building and transforming frame sequences , FrameSeq , newFrameSeq + , newFrameSeq_ , pingPongFrames , reverseFrames ) @@ -59,6 +60,11 @@ newFrameSeq :: [s -> Widget n] -> FrameSeq s n newFrameSeq [] = error "newFrameSeq: got an empty list" newFrameSeq fs = FrameSeq $ V.fromList fs +-- | Like 'newFrameSeq' but allows state to be ignored when building +-- frames. +newFrameSeq_ :: [Widget n] -> FrameSeq s n +newFrameSeq_ ws = newFrameSeq $ const <$> ws + -- | Extend a frame sequence so that when the end of the original -- sequence is reached, it continues in reverse order to create a loop. -- From f51c42e2c65687e0b2cf5cf7de43fdf35637cd83 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 13 Dec 2024 10:14:19 -0800 Subject: [PATCH 090/134] Brick.Animation: haddock nit --- src/Brick/Animation.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 4ce7948f..a9a87da0 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -103,9 +103,9 @@ newtype AnimationID = AnimationID Int -- | The state of a running animation. data Animation s n = Animation { animationFrameIndex :: Int - -- ^ The animation's current frame index. Applications - -- won't need to access this in most situations; use - -- 'renderAnimation' instead. + -- ^ 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 , animationFrames :: FrameSeq s n From b763ad181b2003e753b480de1c2d8529104c3ebb Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 13 Dec 2024 10:15:56 -0800 Subject: [PATCH 091/134] Brick.Animation: make renderAnimation take a function as a fallback to be consistent with frame sequence functions --- programs/AnimationDemo.hs | 4 ++-- src/Brick/Animation.hs | 8 ++++---- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 3d149cc6..f164cc96 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -46,7 +46,7 @@ drawClickAnimations st = drawClickAnimation :: St -> (Location, A.Animation St ()) -> Widget () drawClickAnimation st (l, a) = translateBy l $ - A.renderAnimation (str " ") st (Just a) + A.renderAnimation (const $ str " ") st (Just a) drawAnimations :: St -> Widget () drawAnimations st = @@ -61,7 +61,7 @@ drawAnimations st = animationDrawings = hBox $ intersperse (str " ") $ drawSingleAnimation <$> animations drawSingleAnimation (_, config) = - A.renderAnimation (str " ") st (st^.(animationTarget config)) + A.renderAnimation (const $ str " ") st (st^.(animationTarget config)) in vBox $ str "Click and drag the mouse or press keys to start animations." : str " " : diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index a9a87da0..ecd3da9e 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -113,9 +113,9 @@ data Animation s n = } -- | Render an animation. -renderAnimation :: Widget n - -- ^ The fallback drawing to render if the animation is - -- not running +renderAnimation :: (s -> Widget n) + -- ^ The fallback function to use for drawing if the + -- animation is not running -> s -- ^ The state to provide when constructing the -- animation's current frame @@ -125,7 +125,7 @@ renderAnimation :: Widget n renderAnimation fallback input mAnim = draw input where - draw = fromMaybe (const fallback) $ do + draw = fromMaybe fallback $ do a <- mAnim let idx = animationFrameIndex a FrameSeq fs = animationFrames a From 1df66e527bc7be2ecf5644865aded8259946e881 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 13 Dec 2024 10:29:19 -0800 Subject: [PATCH 092/134] AnimationDemo: nit --- programs/AnimationDemo.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index f164cc96..6c786384 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -160,7 +160,7 @@ startMouseClickAnimation l = do appEvent :: BrickEvent () CustomEvent -> EventM () St () appEvent e = do case e of - VtyEvent (V.EvMouseDown col row _ _) -> do + VtyEvent (V.EvMouseDown col row _ _) -> startMouseClickAnimation (Location (col, row)) VtyEvent (V.EvKey (V.KChar c) []) From 22256a6a10d4c5c821e047e6bffd8012f561752c Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 13 Dec 2024 11:00:19 -0800 Subject: [PATCH 093/134] Brick.Animation: haddock edits --- src/Brick/Animation.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index ecd3da9e..2308d8e5 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -372,7 +372,8 @@ minTickTime = 25 -- Not only does this mean that this should be taken into consideration -- when thinking about the performance and animation needs of your -- application, but it also means that if an animation has a shorter --- tick duration than the manager, that animation may skip frames. +-- frame duration than the manager's tick duration, that animation may +-- skip frames. -- -- When the manager needs to send state updates, it does so by using -- the provided custom event constructor here. This allows the manager @@ -442,7 +443,7 @@ startAnimation :: (MonadIO m) -> FrameSeq s n -- ^ The frames for the animation -> Integer - -- ^ The animation's tick duration in milliseconds + -- ^ The animation's frame duration in milliseconds -> RunMode -- ^ The animation's run mode -> Traversal' s (Maybe (Animation s n)) From bd7b6186e545fbaeb8da7de19095e05dad4ced65 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 26 Dec 2024 10:40:41 -0800 Subject: [PATCH 094/134] AnimationDemo: use newFrameSeq_ more --- programs/AnimationDemo.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 6c786384..139f835e 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -84,7 +84,7 @@ frames3 = mouseClickFrames :: A.FrameSeq a () mouseClickFrames = - A.newFrameSeq $ const <$> + A.newFrameSeq_ $ [ withDefAttr attr6 $ str "0" , withDefAttr attr5 $ str "O" , withDefAttr attr4 $ str "o" From b144d15e97b6c71f9fd9115648024de3bfe8068f Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 26 Dec 2024 11:11:00 -0800 Subject: [PATCH 095/134] Brick.Animation: newFrameSeq(_) -> frameSeq(_) --- programs/AnimationDemo.hs | 8 ++++---- src/Brick/Animation.hs | 18 +++++++++--------- 2 files changed, 13 insertions(+), 13 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 139f835e..383e3bb0 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -68,14 +68,14 @@ drawAnimations st = statusMessages <> [animationDrawings] frames1 :: A.FrameSeq a () -frames1 = A.newFrameSeq_ $ str <$> [".", "o", "O", "^", " "] +frames1 = A.frameSeq_ $ str <$> [".", "o", "O", "^", " "] frames2 :: A.FrameSeq a () -frames2 = A.newFrameSeq_ $ str <$> ["|", "/", "-", "\\"] +frames2 = A.frameSeq_ $ str <$> ["|", "/", "-", "\\"] frames3 :: A.FrameSeq a () frames3 = - A.newFrameSeq_ $ + A.frameSeq_ $ (hLimit 9 . vLimit 9 . border . center) <$> [ border $ str " " , border $ vBox $ replicate 3 $ str $ replicate 3 ' ' @@ -84,7 +84,7 @@ frames3 = mouseClickFrames :: A.FrameSeq a () mouseClickFrames = - A.newFrameSeq_ $ + A.frameSeq_ $ [ withDefAttr attr6 $ str "0" , withDefAttr attr5 $ str "O" , withDefAttr attr4 $ str "o" diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 2308d8e5..76f70a61 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -21,8 +21,8 @@ module Brick.Animation -- * Building and transforming frame sequences , FrameSeq - , newFrameSeq - , newFrameSeq_ + , frameSeq + , frameSeq_ , pingPongFrames , reverseFrames ) @@ -48,7 +48,7 @@ import Brick.Types (EventM, Widget) newtype FrameSeq s n = FrameSeq (V.Vector (s -> Widget n)) deriving (Semigroup) --- | Build a new frame sequence. +-- | Build a frame sequence. -- -- Each entry in a frame sequence is a function from a state to a -- 'Widget'. This allows applications to determine on a per-frame basis @@ -56,14 +56,14 @@ newtype FrameSeq s n = FrameSeq (V.Vector (s -> Widget n)) -- desired, in the same style as 'appDraw'. -- -- If the provided list is empty, this calls 'error'. -newFrameSeq :: [s -> Widget n] -> FrameSeq s n -newFrameSeq [] = error "newFrameSeq: got an empty list" -newFrameSeq fs = FrameSeq $ V.fromList fs +frameSeq :: [s -> Widget n] -> FrameSeq s n +frameSeq [] = error "frameSeq: got an empty list" +frameSeq fs = FrameSeq $ V.fromList fs --- | Like 'newFrameSeq' but allows state to be ignored when building +-- | Like 'frameSeq' but allows state to be ignored when building -- frames. -newFrameSeq_ :: [Widget n] -> FrameSeq s n -newFrameSeq_ ws = newFrameSeq $ const <$> ws +frameSeq_ :: [Widget n] -> FrameSeq s n +frameSeq_ ws = frameSeq $ const <$> ws -- | Extend a frame sequence so that when the end of the original -- sequence is reached, it continues in reverse order to create a loop. From 0e63d5a99344e1557e4d6f5f851bcf193ece3423 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 26 Dec 2024 11:21:18 -0800 Subject: [PATCH 096/134] Brick.Animation: replace "FrameSeq" API with "Clip" API --- programs/AnimationDemo.hs | 32 +++++++-------- src/Brick/Animation.hs | 82 ++++++++++++++++++++------------------- 2 files changed, 59 insertions(+), 55 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 383e3bb0..91499723 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -67,24 +67,24 @@ drawAnimations st = str " " : statusMessages <> [animationDrawings] -frames1 :: A.FrameSeq a () -frames1 = A.frameSeq_ $ str <$> [".", "o", "O", "^", " "] +clip1 :: A.Clip a () +clip1 = A.newClip_ $ str <$> [".", "o", "O", "^", " "] -frames2 :: A.FrameSeq a () -frames2 = A.frameSeq_ $ str <$> ["|", "/", "-", "\\"] +clip2 :: A.Clip a () +clip2 = A.newClip_ $ str <$> ["|", "/", "-", "\\"] -frames3 :: A.FrameSeq a () -frames3 = - A.frameSeq_ $ +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 ' ' ] -mouseClickFrames :: A.FrameSeq a () -mouseClickFrames = - A.frameSeq_ $ +mouseClickClip :: A.Clip a () +mouseClickClip = + A.newClip_ $ [ withDefAttr attr6 $ str "0" , withDefAttr attr5 $ str "O" , withDefAttr attr4 $ str "o" @@ -124,22 +124,22 @@ attrs = data AnimationConfig = AnimationConfig { animationTarget :: Lens' St (Maybe (A.Animation St ())) - , animationFrames :: A.FrameSeq St () + , animationClip :: A.Clip St () , animationFrameTime :: Integer , animationMode :: A.RunMode } animations :: [(Char, AnimationConfig)] animations = - [ ('1', AnimationConfig animation1 frames1 1000 A.Loop) - , ('2', AnimationConfig animation2 frames2 100 A.Loop) - , ('3', AnimationConfig animation3 frames3 100 A.Once) + [ ('1', AnimationConfig animation1 clip1 1000 A.Loop) + , ('2', AnimationConfig animation2 clip2 100 A.Loop) + , ('3', AnimationConfig animation3 clip3 100 A.Once) ] startAnimationFromConfig :: AnimationConfig -> EventM () St () startAnimationFromConfig config = do mgr <- use stAnimationManager - A.startAnimation mgr (animationFrames config) + A.startAnimation mgr (animationClip config) (animationFrameTime config) (animationMode config) (animationTarget config) @@ -155,7 +155,7 @@ toggleAnimationFromConfig config = do startMouseClickAnimation :: Location -> EventM () St () startMouseClickAnimation l = do mgr <- use stAnimationManager - A.startAnimation mgr mouseClickFrames 100 A.Once (clickAnimations.at l) + A.startAnimation mgr mouseClickClip 100 A.Once (clickAnimations.at l) appEvent :: BrickEvent () CustomEvent -> EventM () St () appEvent e = do diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 76f70a61..3d91aa27 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -19,12 +19,13 @@ module Brick.Animation -- * Rendering animation frames , renderAnimation - -- * Building and transforming frame sequences - , FrameSeq - , frameSeq - , frameSeq_ - , pingPongFrames - , reverseFrames + -- * Building and transforming clips + , Clip + , newClip + , newClip_ + , clipLength + , pingPongClip + , reverseClip ) where @@ -45,46 +46,49 @@ import Brick.BChan import Brick.Types (EventM, Widget) -- | A sequence of a animation frames. -newtype FrameSeq s n = FrameSeq (V.Vector (s -> Widget n)) +newtype Clip s n = Clip (V.Vector (s -> Widget n)) deriving (Semigroup) --- | Build a frame sequence. +-- | Get the number of frames in a clip. +clipLength :: Clip s n -> Int +clipLength (Clip fs) = V.length fs + +-- | Build a clip. -- --- Each entry in a frame sequence is 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 'appDraw'. +-- Each entry in a clip is 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 'appDraw'. -- -- If the provided list is empty, this calls 'error'. -frameSeq :: [s -> Widget n] -> FrameSeq s n -frameSeq [] = error "frameSeq: got an empty list" -frameSeq fs = FrameSeq $ V.fromList fs +newClip :: [s -> Widget n] -> Clip s n +newClip [] = error "clip: got an empty list" +newClip fs = Clip $ V.fromList fs --- | Like 'frameSeq' but allows state to be ignored when building --- frames. -frameSeq_ :: [Widget n] -> FrameSeq s n -frameSeq_ ws = frameSeq $ const <$> ws +-- | Like 'newClip' but allows state to be ignored when building frames. +newClip_ :: [Widget n] -> Clip s n +newClip_ ws = newClip $ const <$> ws --- | Extend a frame sequence so that when the end of the original --- sequence is reached, it continues in reverse order to create a loop. +-- | 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 frames A, B, C, and D, then this --- returns a frame sequence A, B, C, D, C, B. +-- returns a clip with frames A, B, C, D, C, B. -- --- If the given sequence contains less than two frames, this is --- equivalent to 'id'. -pingPongFrames :: FrameSeq s n -> FrameSeq s n -pingPongFrames (FrameSeq fs) | V.length fs >= 2 = - FrameSeq $ fs <> V.reverse (V.init $ V.tail fs) -pingPongFrames fs = fs +-- 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 frame sequence. -reverseFrames :: FrameSeq s n -> FrameSeq s n -reverseFrames (FrameSeq fs) = FrameSeq $ V.reverse fs +-- | Reverse a clip. +reverseClip :: Clip s n -> Clip s n +reverseClip (Clip fs) = Clip $ V.reverse fs data AnimationManagerRequest s n = Tick C.UTCTime - | StartAnimation (FrameSeq s n) Integer RunMode (Traversal' s (Maybe (Animation s n))) + | StartAnimation (Clip s n) Integer RunMode (Traversal' s (Maybe (Animation s n))) -- ^ ID, frame count, frame duration in milliseconds, run mode, updater | StopAnimation (Animation s n) | Shutdown @@ -108,8 +112,8 @@ data Animation s n = -- most situations; use 'renderAnimation' instead. , animationID :: AnimationID -- ^ The animation's internally-managed ID - , animationFrames :: FrameSeq s n - -- ^ The animation's frame sequence + , animationClip :: Clip s n + -- ^ The animation's clip } -- | Render an animation. @@ -128,7 +132,7 @@ renderAnimation fallback input mAnim = draw = fromMaybe fallback $ do a <- mAnim let idx = animationFrameIndex a - FrameSeq fs = animationFrames a + Clip fs = animationClip a fs V.!? idx data AnimationState s n = @@ -238,13 +242,13 @@ runManager = forever $ do getNextManagerRequest >>= handleManagerRequest handleManagerRequest :: AnimationManagerRequest s n -> ManagerM s e n () -handleManagerRequest (StartAnimation frames@(FrameSeq fs) frameMs runMode updater) = do +handleManagerRequest (StartAnimation clip frameMs runMode updater) = do aId <- getNextAnimationID now <- liftIO C.getCurrentTime let next = C.addUTCTime frameOffset now frameOffset = nominalDiffFromMs frameMs a = AnimationState { _animationStateID = aId - , _animationNumFrames = V.length fs + , _animationNumFrames = clipLength clip , _animationCurrentFrame = 0 , _animationFrameMilliseconds = frameMs , _animationRunMode = runMode @@ -255,7 +259,7 @@ handleManagerRequest (StartAnimation frames@(FrameSeq fs) frameMs runMode update insertAnimation a sendApplicationEvent $ updater .= Just (Animation { animationID = aId , animationFrameIndex = 0 - , animationFrames = frames + , animationClip = clip }) handleManagerRequest (StopAnimation a) = do let aId = animationID a @@ -440,7 +444,7 @@ tellAnimationManager mgr req = startAnimation :: (MonadIO m) => AnimationManager s e n -- ^ The manager to run the animation - -> FrameSeq s n + -> Clip s n -- ^ The frames for the animation -> Integer -- ^ The animation's frame duration in milliseconds From 9cc0956009595279f6995540dffa64c07d7ccf4b Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 26 Dec 2024 11:21:57 -0800 Subject: [PATCH 097/134] Brick.Animation: update comment for StartAnimation constructor --- src/Brick/Animation.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 3d91aa27..1b321d6f 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -89,7 +89,7 @@ reverseClip (Clip fs) = Clip $ V.reverse fs data AnimationManagerRequest s n = Tick C.UTCTime | StartAnimation (Clip s n) Integer RunMode (Traversal' s (Maybe (Animation s n))) - -- ^ ID, frame count, frame duration in milliseconds, run mode, updater + -- ^ Clip, frame duration in milliseconds, run mode, updater | StopAnimation (Animation s n) | Shutdown From 3849dba1086879936871b3a3bd827ee5df6af59f Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 26 Dec 2024 11:27:27 -0800 Subject: [PATCH 098/134] AnimationDemo: remove redundant $ --- programs/AnimationDemo.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 91499723..260fe347 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -84,7 +84,7 @@ clip3 = mouseClickClip :: A.Clip a () mouseClickClip = - A.newClip_ $ + A.newClip_ [ withDefAttr attr6 $ str "0" , withDefAttr attr5 $ str "O" , withDefAttr attr4 $ str "o" From e42b94d89315546092b910ee7a17da84279f247f Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 26 Dec 2024 11:29:19 -0800 Subject: [PATCH 099/134] Haddock edit --- src/Brick/Animation.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 1b321d6f..e5fb7a07 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -72,8 +72,8 @@ 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 frames A, B, C, and D, then this --- returns a clip with frames A, B, C, D, C, B. +-- 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'. From ba0404563abe9482bf755a9c937feceb25addbb0 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 26 Dec 2024 11:32:55 -0800 Subject: [PATCH 100/134] AnimationDemo: haddock edits --- src/Brick/Animation.hs | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index e5fb7a07..99e4a00c 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -65,7 +65,7 @@ newClip :: [s -> Widget n] -> Clip s n newClip [] = error "clip: got an empty list" newClip fs = Clip $ V.fromList fs --- | Like 'newClip' but allows state to be ignored when building frames. +-- | Like 'newClip' but for static frames. newClip_ :: [Widget n] -> Clip s n newClip_ ws = newClip $ const <$> ws @@ -121,8 +121,8 @@ renderAnimation :: (s -> Widget n) -- ^ The fallback function to use for drawing if the -- animation is not running -> s - -- ^ The state to provide when constructing the - -- animation's current frame + -- ^ The state to provide when rendering the animation's + -- current frame -> Maybe (Animation s n) -- ^ The animation state itself -> Widget n @@ -396,10 +396,9 @@ startAnimationManager :: Int -> (EventM n s () -> e) -- ^ A constructor for building custom events -- that perform application state updates. The - -- application must evaluate the provided 'EventM' - -- action given by these events in order to get - -- animation updates made to the application - -- state. + -- application must evaluate these custom events' + -- 'EventM' actions in order to record animation + -- updates in the application state. -> IO (AnimationManager s e n) startAnimationManager tickMilliseconds _ _ | tickMilliseconds < minTickTime = error $ "startAnimationManager: tick delay too small (minimum is " <> show minTickTime <> ")" From b06d7fcd1dab2926f3cf393d23668e835858a0e4 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 26 Dec 2024 12:17:44 -0800 Subject: [PATCH 101/134] Brick.Animation: haddock updates --- src/Brick/Animation.hs | 128 +++++++++++++++++++++++++++++++++-------- 1 file changed, 105 insertions(+), 23 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 99e4a00c..8c33cd58 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -1,6 +1,52 @@ {-# 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', or 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@ and give the event type a constructor +-- @EventM n s () -> e@. 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. +-- +-- * Create an 'AnimationManager' at startup with +-- 'startAnimationManager' and store it 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 has a lens, usually by using +-- 'Lens.Micro.TH.makeLenses'. +-- +-- * Create clips with 'newClip', 'newClip_', and the clip +-- transformation functions. +-- +-- * Start new animations with 'startAnimation'; stop them with +-- 'stopAnimation'. +-- +-- * Call 'renderAnimation' in 'appDraw' for each animation in the +-- application state. module Brick.Animation ( -- * Animation managers AnimationManager @@ -105,6 +151,9 @@ 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 @@ -149,7 +198,55 @@ makeLenses ''AnimationState -- | A manager for animations. -- --- Create one of these for your application. +-- 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 +-- then 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 @@ -366,24 +463,8 @@ advanceByOne a = minTickTime :: Int minTickTime = 25 --- | Start a new animation manager. --- --- The animation manager internally runs at a tick rate, specified here --- as a tick duration in milliseconds. The tick duration determines how --- often the manager will check for animation updates and send them to --- the application, so the smaller the tick duration, the more often the --- manager will trigger screen redraws and application state updates. --- Not only does this mean that this should be taken into consideration --- when thinking about the performance and animation needs of your --- application, but it also means that if an animation has a shorter --- frame duration than the manager's tick duration, that animation may --- skip frames. --- --- When the manager needs to send state updates, it does so by using --- the provided custom event constructor here. This allows the manager --- to schedule a state update which the application is responsible for --- evaluating. The state updates are built from the traversals provided --- to 'startAnimation'. +-- | 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 @@ -392,7 +473,8 @@ startAnimationManager :: Int -- ^ The tick duration for this manager in milliseconds -> BChan e -- ^ The event channel to use to send updates to - -- the application + -- 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 @@ -421,7 +503,7 @@ whenRunning mgr act = do running <- liftIO $ STM.atomically $ STM.readTVar (animationMgrRunning mgr) when running $ liftIO act --- | Stop the animation manager, ending all animations. +-- | Stop the animation manager, ending all running animations. stopAnimationManager :: (MonadIO m) => AnimationManager s e n -> m () stopAnimationManager mgr = whenRunning mgr $ do @@ -439,7 +521,7 @@ tellAnimationManager mgr req = -- | Start a new animation at its first frame. -- -- This will result in an application state update to initialize the --- animation. +-- animation state at the provided traversal's location. startAnimation :: (MonadIO m) => AnimationManager s e n -- ^ The manager to run the animation @@ -451,7 +533,7 @@ startAnimation :: (MonadIO m) -- ^ The animation's run mode -> Traversal' s (Maybe (Animation s n)) -- ^ Where in the application state to manage this - -- animation + -- animation's state -> m () startAnimation mgr frames frameMs runMode updater = tellAnimationManager mgr $ StartAnimation frames frameMs runMode updater From ea5817f29e4bb810647da93abc1fb5d1cf7a742d Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 26 Dec 2024 12:28:57 -0800 Subject: [PATCH 102/134] Brick.Animation: haddock edits --- src/Brick/Animation.hs | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 8c33cd58..97a8de5b 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -22,14 +22,15 @@ -- To use this module: -- -- * Use a custom event type @e@ and give the event type a constructor --- @EventM n s () -> e@. This will require the use of --- 'Brick.Main.customMain' and will also require the creation of a --- 'Brick.BChan.BChan' for custom events. +-- @EventM n s () -> e@ (where @s@ is your application state type). +-- 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. -- -- * Create an 'AnimationManager' at startup with --- 'startAnimationManager' and store it in the application state. +-- '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)@, @@ -42,11 +43,13 @@ -- * Create clips with 'newClip', 'newClip_', and the clip -- transformation functions. -- --- * Start new animations with 'startAnimation'; stop them with --- 'stopAnimation'. +-- * Start new animations in 'EventM' with 'startAnimation'; stop them +-- with 'stopAnimation'. -- --- * Call 'renderAnimation' in 'appDraw' for each animation in the +-- * Call 'renderAnimation' in 'Brick.Main.appDraw' for each animation in the -- application state. +-- +-- * If needed, stop the animation manager with 'stopAnimationManager'. module Brick.Animation ( -- * Animation managers AnimationManager @@ -101,10 +104,10 @@ clipLength (Clip fs) = V.length fs -- | Build a clip. -- --- Each entry in a clip is 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 'appDraw'. +-- 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 @@ -240,7 +243,7 @@ makeLenses ''AnimationState -- 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 --- then to 'Nothing'. +-- 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 From 31bc1d9fc55045a253d902bba151e5f79cf77a2b Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 26 Dec 2024 12:30:56 -0800 Subject: [PATCH 103/134] Brick.Animation: haddock nit --- src/Brick/Animation.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 97a8de5b..730ccea0 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -15,8 +15,8 @@ -- 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', or sequence of --- frames, which may be static or may be built from the application +-- 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: From a88c141c907992defbf2ab0bc15a17d739ebb7b6 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 26 Dec 2024 12:35:28 -0800 Subject: [PATCH 104/134] guide.rst: mention animations --- docs/guide.rst | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/docs/guide.rst b/docs/guide.rst index 5e06a65f..4d60d29c 100644 --- a/docs/guide.rst +++ b/docs/guide.rst @@ -1966,6 +1966,14 @@ When creating new widgets, if you would like ``joinBorders`` and 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 =================== From 95082415a9adc45f7ac361bb707fbbf241bebb19 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 26 Dec 2024 12:37:23 -0800 Subject: [PATCH 105/134] README: mention animations --- README.md | 1 + 1 file changed, 1 insertion(+) diff --git a/README.md b/README.md index f48a152b..9ea9caac 100644 --- a/README.md +++ b/README.md @@ -143,6 +143,7 @@ Feature Overview * 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 From 8dbea9b797f77701675ccb620733d787439cabe2 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Fri, 27 Dec 2024 12:47:56 -0800 Subject: [PATCH 106/134] AnimationDemo: never show any cursors --- programs/AnimationDemo.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 260fe347..bd4ff186 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -15,7 +15,7 @@ import Graphics.Vty.CrossPlatform (mkVty) import Brick.BChan import Brick.Util (fg) -import Brick.Main (App(..), showFirstCursor, customMain, halt) +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) @@ -176,7 +176,7 @@ appEvent e = do theApp :: App St CustomEvent () theApp = App { appDraw = drawUI - , appChooseCursor = showFirstCursor + , appChooseCursor = neverShowCursor , appHandleEvent = appEvent , appStartEvent = return () , appAttrMap = const attrs From 59b08c29feec67d316cb9195a777fbee293625cc Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Tue, 31 Dec 2024 15:58:18 -0800 Subject: [PATCH 107/134] Brick.Animation: more haddock edits --- src/Brick/Animation.hs | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 730ccea0..8e7f76e8 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -21,12 +21,13 @@ -- -- To use this module: -- --- * Use a custom event type @e@ and give the event type a constructor --- @EventM n s () -> e@ (where @s@ is your application state type). --- This will require the use of 'Brick.Main.customMain' and will also --- require the creation of a 'Brick.BChan.BChan' for custom events. +-- * Use a custom event type @e@ in your '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. +-- * Add an 'AnimationManager' field to the application state @s@. -- -- * Create an 'AnimationManager' at startup with -- 'startAnimationManager', providing the custom event constructor and @@ -37,19 +38,20 @@ -- initialized to 'Nothing'. A value of 'Nothing' indicates that the -- animation is not running. -- --- * Ensure that each animation state field has a lens, usually by using --- 'Lens.Micro.TH.makeLenses'. --- --- * Create clips with 'newClip', 'newClip_', and the clip --- transformation functions. +-- * 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'. +-- 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 From da4b642ff200b055e61c7509efa8804fa4e41491 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Tue, 31 Dec 2024 16:00:11 -0800 Subject: [PATCH 108/134] Brick.Animation: rearrange haddock sections --- src/Brick/Animation.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 8e7f76e8..ddedaf94 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -67,14 +67,16 @@ module Brick.Animation , startAnimation , stopAnimation - -- * Rendering animation frames + -- * Rendering animations , renderAnimation - -- * Building and transforming clips + -- * Creating clips , Clip , newClip , newClip_ , clipLength + + -- * Transforming clips , pingPongClip , reverseClip ) From 4a0e10edecb077ee6c141aa9de005f2ebdc117db Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Tue, 31 Dec 2024 16:00:44 -0800 Subject: [PATCH 109/134] Brick.Animation: haddock nit --- src/Brick/Animation.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index ddedaf94..4e9bd756 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -59,6 +59,7 @@ module Brick.Animation , stopAnimationManager , minTickTime + -- * Animations , Animation , animationFrameIndex From 2dc05959b16de629dea84b5a859941f977f83208 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Tue, 31 Dec 2024 16:06:51 -0800 Subject: [PATCH 110/134] AnimationDemo: add various comments --- programs/AnimationDemo.hs | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index bd4ff186..f5428fee 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -25,13 +25,18 @@ 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 @@ -122,6 +127,7 @@ attrs = , (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 () @@ -136,6 +142,7 @@ animations = , ('3', AnimationConfig animation3 clip3 100 A.Once) ] +-- | Start the animation specified by this config. startAnimationFromConfig :: AnimationConfig -> EventM () St () startAnimationFromConfig config = do mgr <- use stAnimationManager @@ -144,6 +151,8 @@ startAnimationFromConfig config = do (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 @@ -152,6 +161,7 @@ toggleAnimationFromConfig config = do Just a -> A.stopAnimation mgr a Nothing -> startAnimationFromConfig config +-- | Start a new mouse click animation at the specified location. startMouseClickAnimation :: Location -> EventM () St () startMouseClickAnimation l = do mgr <- use stAnimationManager @@ -160,13 +170,17 @@ startMouseClickAnimation l = do 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. 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 From 672b7ad460786a826a8cc8d6fbed26c919f2df4a Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Tue, 31 Dec 2024 16:08:19 -0800 Subject: [PATCH 111/134] Brick.Animation: run startAnimationManager in MonadIO --- src/Brick/Animation.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 4e9bd756..6c9d0cd3 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -477,7 +477,8 @@ minTickTime = 25 -- 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 :: Int +startAnimationManager :: (MonadIO m) + => Int -- ^ The tick duration for this manager in milliseconds -> BChan e -- ^ The event channel to use to send updates to @@ -489,10 +490,10 @@ startAnimationManager :: Int -- application must evaluate these custom events' -- 'EventM' actions in order to record animation -- updates in the application state. - -> IO (AnimationManager s e n) + -> m (AnimationManager s e n) startAnimationManager tickMilliseconds _ _ | tickMilliseconds < minTickTime = error $ "startAnimationManager: tick delay too small (minimum is " <> show minTickTime <> ")" -startAnimationManager tickMilliseconds outChan mkEvent = do +startAnimationManager tickMilliseconds outChan mkEvent = liftIO $ do inChan <- STM.newTChanIO reqTid <- forkIO $ animationManagerThreadBody inChan outChan mkEvent tickTid <- forkIO $ tickThreadBody tickMilliseconds inChan From d97d76d6e9fd72f5b12d0b2e179a0001c96f8341 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Tue, 31 Dec 2024 16:14:00 -0800 Subject: [PATCH 112/134] Brick.Animation: haddock nit --- src/Brick/Animation.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 6c9d0cd3..e3ae8511 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -423,10 +423,9 @@ checkAnimations now = do [] -> 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 counter to be updated in the --- application state. +-- 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.UTCTime -> AnimationState s n -> ManagerM s e n (Maybe (EventM n s ())) checkAnimation now a | (now < a^.animationNextFrameTime) = From e5af4fd540ef60a5887ee87e3798a7d95374bfb7 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Tue, 31 Dec 2024 16:14:19 -0800 Subject: [PATCH 113/134] Brick.Animation: checkAnimation: only send a state update if the frame index actually changed --- src/Brick/Animation.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index e3ae8511..c08c8a1e 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -442,8 +442,11 @@ checkAnimation now a -- 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' + if a'^.animationCurrentFrame == a^.animationCurrentFrame + then return Nothing + else do + managerStateAnimations %= HM.insert (a'^.animationStateID) a' + return $ Just $ frameUpdateAction a' isFinished :: AnimationState s n -> Bool isFinished a = From 077799e4562c0acb118275176dee88a935d0003c Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Tue, 31 Dec 2024 16:15:02 -0800 Subject: [PATCH 114/134] Revert "Brick.Animation: checkAnimation: only send a state update if the frame index actually changed" This reverts commit e5af4fd540ef60a5887ee87e3798a7d95374bfb7. That change was problematic because skipping the update also meant not updating the animation's next frame time. --- src/Brick/Animation.hs | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index c08c8a1e..e3ae8511 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -442,11 +442,8 @@ checkAnimation now a -- 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 - if a'^.animationCurrentFrame == a^.animationCurrentFrame - then return Nothing - else do - managerStateAnimations %= HM.insert (a'^.animationStateID) a' - return $ Just $ frameUpdateAction a' + managerStateAnimations %= HM.insert (a'^.animationStateID) a' + return $ Just $ frameUpdateAction a' isFinished :: AnimationState s n -> Bool isFinished a = From 3590320295ff26e405c74bfb30762abf15f74586 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Tue, 31 Dec 2024 16:18:29 -0800 Subject: [PATCH 115/134] Brick.Animation: haddock edits --- src/Brick/Animation.hs | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index e3ae8511..068fa16f 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -21,11 +21,11 @@ -- -- To use this module: -- --- * Use a custom event type @e@ in your '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. +-- * 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@. -- @@ -204,7 +204,8 @@ data AnimationState s n = makeLenses ''AnimationState --- | A manager for animations. +-- | 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 From dcbf2cd155412e8a0ca0fb74b11658345cb99383 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Tue, 31 Dec 2024 16:21:03 -0800 Subject: [PATCH 116/134] Brick.Animation: isFinished: use case expression to get warned about unhandled run modes --- src/Brick/Animation.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 068fa16f..fa3549e6 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -448,8 +448,9 @@ checkAnimation now a isFinished :: AnimationState s n -> Bool isFinished a = - a^.animationRunMode == Once && - a^.animationCurrentFrame == a^.animationNumFrames - 1 + case a^.animationRunMode of + Once -> a^.animationCurrentFrame == a^.animationNumFrames - 1 + Loop -> False advanceBy :: Integer -> AnimationState s n -> AnimationState s n advanceBy n a From f47b4110a2476878a8946a85b91d709e677eeff4 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Tue, 31 Dec 2024 16:22:19 -0800 Subject: [PATCH 117/134] Brick.Animation: error message edit --- src/Brick/Animation.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index fa3549e6..a4465520 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -493,7 +493,7 @@ startAnimationManager :: (MonadIO m) -- updates in the application state. -> m (AnimationManager s e n) startAnimationManager tickMilliseconds _ _ | tickMilliseconds < minTickTime = - error $ "startAnimationManager: tick delay too small (minimum is " <> show 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 From 4e6c87ff039de8e16512e161db2c0018dd463ef3 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Tue, 31 Dec 2024 16:29:50 -0800 Subject: [PATCH 118/134] Brick.Animation: length nit --- src/Brick/Animation.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index a4465520..c0b53d01 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -383,7 +383,7 @@ handleManagerRequest Shutdown = do as <- HM.elems <$> use managerStateAnimations let updater = sequence_ $ clearStateAction <$> as - when (length as > 0) $ do + when (not $ null as) $ do sendApplicationEvent updater liftIO $ myThreadId >>= killThread From 9a542597dbaf474edd0e21499ef003aa52275df7 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Tue, 31 Dec 2024 16:35:26 -0800 Subject: [PATCH 119/134] Brick.Animation: checkAnimations: use a map fold rather than elems+catMaybes --- src/Brick/Animation.hs | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index c0b53d01..9448ba07 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -87,9 +87,10 @@ 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, catMaybes) +import Data.Maybe (fromMaybe) import qualified Data.Vector as V import qualified Data.Time.Clock as C import Lens.Micro ((^.), (%~), (.~), (&), Traversal', _Just) @@ -418,8 +419,15 @@ updateAnimationState now a = checkAnimations :: C.UTCTime -> ManagerM s e n (Maybe (EventM n s ())) checkAnimations now = do - as <- HM.elems <$> use managerStateAnimations - updaters <- catMaybes <$> mapM (checkAnimation now) as + 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 From 2909a79a7779405d640b5a4f7abb066dfb84e9c1 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Tue, 31 Dec 2024 16:36:44 -0800 Subject: [PATCH 120/134] Brick.Animation: internal naming nit --- src/Brick/Animation.hs | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 9448ba07..5f18efb8 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -317,8 +317,8 @@ getNextManagerRequest = do inChan <- use managerStateInChan liftIO $ STM.atomically $ STM.readTChan inChan -sendApplicationEvent :: EventM n s () -> ManagerM s e n () -sendApplicationEvent act = do +sendApplicationStateUpdate :: EventM n s () -> ManagerM s e n () +sendApplicationStateUpdate act = do outChan <- use managerStateOutChan mkEvent <- use managerStateEventBuilder liftIO $ writeBChan outChan $ mkEvent act @@ -364,10 +364,10 @@ handleManagerRequest (StartAnimation clip frameMs runMode updater) = do } insertAnimation a - sendApplicationEvent $ updater .= Just (Animation { animationID = aId - , animationFrameIndex = 0 - , animationClip = clip - }) + sendApplicationStateUpdate $ updater .= Just (Animation { animationID = aId + , animationFrameIndex = 0 + , animationClip = clip + }) handleManagerRequest (StopAnimation a) = do let aId = animationID a mA <- lookupAnimation aId @@ -379,13 +379,13 @@ handleManagerRequest (StopAnimation a) = do -- Set the current animation state in the application state -- to none - sendApplicationEvent $ clearStateAction aState + sendApplicationStateUpdate $ clearStateAction aState handleManagerRequest Shutdown = do as <- HM.elems <$> use managerStateAnimations let updater = sequence_ $ clearStateAction <$> as when (not $ null as) $ do - sendApplicationEvent updater + sendApplicationStateUpdate updater liftIO $ myThreadId >>= killThread handleManagerRequest (Tick tickTime) = do @@ -395,7 +395,7 @@ handleManagerRequest (Tick tickTime) = do mUpdateAct <- checkAnimations tickTime case mUpdateAct of Nothing -> return () - Just act -> sendApplicationEvent act + Just act -> sendApplicationStateUpdate act clearStateAction :: AnimationState s n -> EventM n s () clearStateAction a = animationFrameUpdater a .= Nothing From 53abbf376682f92766a5d2b0bbfe239ad8c74fb9 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Tue, 31 Dec 2024 16:57:14 -0800 Subject: [PATCH 121/134] AnimationDemo: decrease manager tick duration --- programs/AnimationDemo.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index f5428fee..c789da2b 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -199,7 +199,7 @@ theApp = main :: IO () main = do chan <- newBChan 10 - mgr <- A.startAnimationManager 100 chan AnimationUpdate + mgr <- A.startAnimationManager 50 chan AnimationUpdate let initialState = St { _stAnimationManager = mgr From b15afcceefe5bbe51da2e26ffb70feea1f91cd55 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Tue, 31 Dec 2024 16:58:40 -0800 Subject: [PATCH 122/134] AnimationDemo: only run mouse click animations at locations without running animations --- programs/AnimationDemo.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index c789da2b..e8c67e8e 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -161,11 +161,15 @@ toggleAnimationFromConfig config = do Just a -> A.stopAnimation mgr a Nothing -> startAnimationFromConfig config --- | Start a new mouse click animation at the specified location. +-- | 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.startAnimation mgr mouseClickClip 100 A.Once (clickAnimations.at l) + 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 From 67df9b419bb8b12879a6b528e48ba1ed2aac1e68 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Tue, 31 Dec 2024 17:01:43 -0800 Subject: [PATCH 123/134] AnimationDemo: vBox nit --- programs/AnimationDemo.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index e8c67e8e..9484895a 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -67,10 +67,11 @@ drawAnimations st = 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 " " : - statusMessages <> [animationDrawings] + 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", "^", " "] From de87dc02b186d869d793bb0d7246581f5f6bc944 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Tue, 31 Dec 2024 17:05:11 -0800 Subject: [PATCH 124/134] AnimationDemo: nit --- programs/AnimationDemo.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/programs/AnimationDemo.hs b/programs/AnimationDemo.hs index 9484895a..7d7235ea 100644 --- a/programs/AnimationDemo.hs +++ b/programs/AnimationDemo.hs @@ -180,7 +180,8 @@ appEvent e = do startMouseClickAnimation (Location (col, row)) -- If we got a character keystroke, see if there is a specific - -- animation mapped to that character. + -- animation mapped to that character and toggle the resulting + -- animation. VtyEvent (V.EvKey (V.KChar c) []) | Just aConfig <- lookup c animations -> toggleAnimationFromConfig aConfig From c9a6488cd5d72d2b0df5d41a943df08ca21a4f2d Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Tue, 31 Dec 2024 17:14:02 -0800 Subject: [PATCH 125/134] Brick.Animation: document tellAnimationManager --- src/Brick/Animation.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 5f18efb8..0366e977 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -529,8 +529,13 @@ stopAnimationManager mgr = killThread $ animationMgrTickThreadId mgr STM.atomically $ STM.writeTVar (animationMgrRunning mgr) False +-- | Send a request to an animation manager. tellAnimationManager :: (MonadIO m) - => AnimationManager s e n -> AnimationManagerRequest s n -> m () + => AnimationManager s e n + -- ^ The manager + -> AnimationManagerRequest s n + -- ^ The request to send + -> m () tellAnimationManager mgr req = liftIO $ STM.atomically $ From 3564285c7f86f960dd40448feda05ad3285dbd9b Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Tue, 31 Dec 2024 17:20:34 -0800 Subject: [PATCH 126/134] Brick.Animation: checkAnimation: checked for finished animations before checking frame times --- src/Brick/Animation.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 0366e977..79171788 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -437,15 +437,15 @@ checkAnimations now = do -- and schedule its frame index to be updated in the application state. checkAnimation :: C.UTCTime -> AnimationState s n -> ManagerM s e n (Maybe (EventM n s ())) checkAnimation now a - | (now < a^.animationNextFrameTime) = - -- This animation is not due for an update, so don't do - -- anything. - return Nothing | isFinished a = do -- This animation has completed, 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 From 3e8b87481215d18787bf891d6458d4c8383deabb Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Tue, 31 Dec 2024 17:21:45 -0800 Subject: [PATCH 127/134] Brick.Animation: checkAnimation: comment edit --- src/Brick/Animation.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 79171788..f9599f47 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -438,8 +438,8 @@ checkAnimations now = do checkAnimation :: C.UTCTime -> AnimationState s n -> ManagerM s e n (Maybe (EventM n s ())) checkAnimation now a | isFinished a = do - -- This animation has completed, so clear it from the manager - -- and the application state. + -- 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) = From bd8d86ab7d549119da404bb6b5c0729404fc67bd Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 2 Jan 2025 14:33:54 -0800 Subject: [PATCH 128/134] Brick.Animation: migrate away from UTCTime to more efficient SystemTime --- brick.cabal | 1 + src/Brick/Animation.hs | 38 ++++++++++--------------- src/Brick/Animation/Clock.hs | 54 ++++++++++++++++++++++++++++++++++++ 3 files changed, 70 insertions(+), 23 deletions(-) create mode 100644 src/Brick/Animation/Clock.hs diff --git a/brick.cabal b/brick.cabal index de875b1f..a44f9587 100644 --- a/brick.cabal +++ b/brick.cabal @@ -99,6 +99,7 @@ library Brick.Widgets.Table Data.IMap other-modules: + Brick.Animation.Clock Brick.Types.Common Brick.Types.TH Brick.Types.EventM diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index f9599f47..84dd9ff1 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -92,13 +92,13 @@ import Data.Hashable (Hashable) import qualified Data.HashMap.Strict as HM import Data.Maybe (fromMaybe) import qualified Data.Vector as V -import qualified Data.Time.Clock as C 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)) @@ -142,7 +142,7 @@ reverseClip :: Clip s n -> Clip s n reverseClip (Clip fs) = Clip $ V.reverse fs data AnimationManagerRequest s n = - Tick C.UTCTime + 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) @@ -200,7 +200,7 @@ data AnimationState s n = , _animationFrameMilliseconds :: Integer , _animationRunMode :: RunMode , animationFrameUpdater :: Traversal' s (Maybe (Animation s n)) - , _animationNextFrameTime :: C.UTCTime + , _animationNextFrameTime :: C.Time } makeLenses ''AnimationState @@ -272,20 +272,12 @@ tickThreadBody :: Int tickThreadBody tickMilliseconds outChan = forever $ do threadDelay $ tickMilliseconds * 1000 - now <- C.getCurrentTime + now <- C.getTime STM.atomically $ STM.writeTChan outChan $ Tick now -setNextFrameTime :: C.UTCTime -> AnimationState s n -> AnimationState s n +setNextFrameTime :: C.Time -> AnimationState s n -> AnimationState s n setNextFrameTime t a = a & animationNextFrameTime .~ t -nominalDiffFromMs :: Integer -> C.NominalDiffTime -nominalDiffFromMs i = realToFrac (fromIntegral i / (1000.0::Float)) - -nominalDiffToMs :: C.NominalDiffTime -> Integer -nominalDiffToMs t = - -- NOTE: probably wrong, but we'll have to find out what this gives us - (round $ C.nominalDiffTimeToSeconds t) - data ManagerState s e n = ManagerState { _managerStateInChan :: STM.TChan (AnimationManagerRequest s n) , _managerStateOutChan :: BChan e @@ -351,9 +343,9 @@ runManager = forever $ do handleManagerRequest :: AnimationManagerRequest s n -> ManagerM s e n () handleManagerRequest (StartAnimation clip frameMs runMode updater) = do aId <- getNextAnimationID - now <- liftIO C.getCurrentTime - let next = C.addUTCTime frameOffset now - frameOffset = nominalDiffFromMs frameMs + now <- liftIO C.getTime + let next = C.addOffset frameOffset now + frameOffset = C.offsetFromMs frameMs a = AnimationState { _animationStateID = aId , _animationNumFrames = clipLength clip , _animationCurrentFrame = 0 @@ -405,19 +397,19 @@ frameUpdateAction a = animationFrameUpdater a._Just %= (\an -> an { animationFrameIndex = a^.animationCurrentFrame }) -updateAnimationState :: C.UTCTime -> AnimationState s n -> AnimationState s n +updateAnimationState :: C.Time -> AnimationState s n -> AnimationState s n updateAnimationState now a = - let differenceMs = nominalDiffToMs $ - C.diffUTCTime now (a^.animationNextFrameTime) + let differenceMs = C.offsetToMs $ + C.subtractTime now (a^.animationNextFrameTime) numFrames = 1 + (differenceMs `div` (a^.animationFrameMilliseconds)) - newNextTime = C.addUTCTime (nominalDiffFromMs $ numFrames * (a^.animationFrameMilliseconds)) - (a^.animationNextFrameTime) + 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.UTCTime -> ManagerM s e n (Maybe (EventM n s ())) +checkAnimations :: C.Time -> ManagerM s e n (Maybe (EventM n s ())) checkAnimations now = do let go a updaters = do result <- checkAnimation now a @@ -435,7 +427,7 @@ checkAnimations now = do -- 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.UTCTime -> AnimationState s n -> ManagerM s e n (Maybe (EventM n s ())) +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 diff --git a/src/Brick/Animation/Clock.hs b/src/Brick/Animation/Clock.hs new file mode 100644 index 00000000..1ae54610 --- /dev/null +++ b/src/Brick/Animation/Clock.hs @@ -0,0 +1,54 @@ +module Brick.Animation.Clock + ( Time + , getTime + , addOffset + , subtractTime + + , Offset + , offsetFromMs + , offsetToMs + ) +where + +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 :: IO Time +getTime = Time <$> 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 From 49c38c6802407a94469fc0e4cf288a5ec56166d4 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 2 Jan 2025 14:37:44 -0800 Subject: [PATCH 129/134] Brick.Animation.Clock: move getTime to MonadIO --- src/Brick/Animation/Clock.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Brick/Animation/Clock.hs b/src/Brick/Animation/Clock.hs index 1ae54610..bd3be74f 100644 --- a/src/Brick/Animation/Clock.hs +++ b/src/Brick/Animation/Clock.hs @@ -10,6 +10,7 @@ module Brick.Animation.Clock ) where +import Control.Monad.IO.Class (MonadIO, liftIO) import qualified Data.Time.Clock.System as C newtype Time = Time C.SystemTime @@ -25,8 +26,8 @@ offsetFromMs = Offset offsetToMs :: Offset -> Integer offsetToMs (Offset ms) = ms -getTime :: IO Time -getTime = Time <$> C.getSystemTime +getTime :: (MonadIO m) => m Time +getTime = Time <$> liftIO C.getSystemTime addOffset :: Offset -> Time -> Time addOffset (Offset ms) (Time (C.MkSystemTime s ns)) = From 959823cc0207a6596af40fc36b869cee3f9de368 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 2 Jan 2025 15:18:39 -0800 Subject: [PATCH 130/134] Brick.Animation: tickThreadBody: send a tick immediately on startup rather than sleeping first --- src/Brick/Animation.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 84dd9ff1..f42a178c 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -271,9 +271,9 @@ tickThreadBody :: Int -> IO () tickThreadBody tickMilliseconds outChan = forever $ do - threadDelay $ tickMilliseconds * 1000 now <- C.getTime STM.atomically $ STM.writeTChan outChan $ Tick now + threadDelay $ tickMilliseconds * 1000 setNextFrameTime :: C.Time -> AnimationState s n -> AnimationState s n setNextFrameTime t a = a & animationNextFrameTime .~ t From 18b487fb7a5da0f5d717ab5bab9dcf9465932d59 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 2 Jan 2025 15:45:16 -0800 Subject: [PATCH 131/134] Brick.Animation: tickThreadBody: use tick schedule to determine sleeping amount to avoid drifting off schedule --- src/Brick/Animation.hs | 28 +++++++++++++++++++++++----- 1 file changed, 23 insertions(+), 5 deletions(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index f42a178c..f78424bc 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -269,11 +269,29 @@ data AnimationManager s e n = tickThreadBody :: Int -> STM.TChan (AnimationManagerRequest s n) -> IO () -tickThreadBody tickMilliseconds outChan = - forever $ do - now <- C.getTime - STM.atomically $ STM.writeTChan outChan $ Tick now - threadDelay $ tickMilliseconds * 1000 +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. + let nextTickTime = nextTick targetTime + sleepMs = fromInteger $ + C.offsetToMs $ + C.subtractTime nextTickTime now + + threadDelay $ sleepMs * 1000 + go nextTickTime + + go =<< C.getTime setNextFrameTime :: C.Time -> AnimationState s n -> AnimationState s n setNextFrameTime t a = a & animationNextFrameTime .~ t From 795687f089094f1da6a2bf051aa65033041f9174 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 2 Jan 2025 15:49:29 -0800 Subject: [PATCH 132/134] Brick.Animation: tickThreadBody: update comment --- src/Brick/Animation.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index f78424bc..91968cd7 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -282,7 +282,11 @@ tickThreadBody tickMilliseconds outChan = do -- 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. + -- 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 $ From c3d2d3dd6add8d54208cb874de06bb409f2db994 Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 2 Jan 2025 15:50:01 -0800 Subject: [PATCH 133/134] Brick.Animation: tickThreadBody: explain multiplication --- src/Brick/Animation.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Brick/Animation.hs b/src/Brick/Animation.hs index 91968cd7..7c324a58 100644 --- a/src/Brick/Animation.hs +++ b/src/Brick/Animation.hs @@ -292,6 +292,7 @@ tickThreadBody tickMilliseconds outChan = do C.offsetToMs $ C.subtractTime nextTickTime now + -- threadDelay works microseconds. threadDelay $ sleepMs * 1000 go nextTickTime From ebf255ed0b47a8fd3ea8584e37384687c4d4d54a Mon Sep 17 00:00:00 2001 From: Jonathan Daugherty Date: Thu, 2 Jan 2025 16:02:21 -0800 Subject: [PATCH 134/134] Brick.Animation.Clock: add module haddock --- src/Brick/Animation/Clock.hs | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/src/Brick/Animation/Clock.hs b/src/Brick/Animation/Clock.hs index bd3be74f..cc836edd 100644 --- a/src/Brick/Animation/Clock.hs +++ b/src/Brick/Animation/Clock.hs @@ -1,3 +1,12 @@ +-- | 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