1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
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
|
