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