brick-2.7: programs/AnimationDemo.hs

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