{-# 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