File: ProgressBarDemo.hs

package info (click to toggle)
haskell-brick 2.9-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 1,344 kB
  • sloc: haskell: 9,168; makefile: 3
file content (153 lines) | stat: -rw-r--r-- 5,267 bytes parent folder | download
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
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
module Main where

import Control.Monad (void)
#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid
#endif
import qualified Graphics.Vty as V
import Lens.Micro.Mtl
import Lens.Micro.TH

import qualified Brick.AttrMap as A
import qualified Brick.Main as M
import qualified Brick.Types as T
import qualified Brick.Widgets.ProgressBar as P
import Brick.Types
  ( Widget
  )
import Brick.Widgets.Core
  ( (<+>), (<=>)
  , str
  , strWrap
  , updateAttrMap
  , overrideAttr
  )
import Brick.Util (fg, bg, on, clamp)

data MyAppState n = MyAppState { _x, _y, _z :: Float, _showLabel :: Bool }

makeLenses ''MyAppState

drawUI :: MyAppState () -> [Widget ()]
drawUI p = [ui]
    where
      -- use mapAttrNames
      xBar = updateAttrMap
             (A.mapAttrNames [ (xDoneAttr, P.progressCompleteAttr)
                             , (xToDoAttr, P.progressIncompleteAttr)
                             ]
             ) $ bar $ _x p
      -- or use individual mapAttrName calls
      yBar = updateAttrMap
             (A.mapAttrName yDoneAttr P.progressCompleteAttr .
              A.mapAttrName yToDoAttr P.progressIncompleteAttr) $
             bar $ _y p
      -- or use overrideAttr calls
      zBar = overrideAttr P.progressCompleteAttr zDoneAttr $
             overrideAttr P.progressIncompleteAttr zToDoAttr $
             bar $ _z p
      -- custom bars
      cBar1 = overrideAttr P.progressCompleteAttr cDoneAttr1 $
              overrideAttr P.progressIncompleteAttr cToDoAttr1
              $ bar' '▰' '▱' $ _x p
      cBar2 = overrideAttr P.progressCompleteAttr cDoneAttr2 $
              overrideAttr P.progressIncompleteAttr cToDoAttr2
              $ bar' '|' '─' $ _y p
      cBar3 = overrideAttr P.progressCompleteAttr cDoneAttr $
              overrideAttr P.progressIncompleteAttr cToDoAttr
              $ bar' '⣿' '⠶' $ _z p
      lbl c = if _showLabel p
              then Just $ " " ++ (show $ fromEnum $ c * 100) ++ " "
              else Nothing
      bar v = P.progressBar (lbl v) v
      bar' cc ic v = P.customProgressBar cc ic (lbl v) v
      ui = (str "X: " <+> xBar) <=>
           (str "Y: " <+> yBar) <=>
           (str "Z: " <+> zBar) <=>
           (str "X: " <+> cBar1) <=>
           (str "Y: " <+> cBar2) <=>
           (str "Z: " <+> cBar3) <=>
           str "" <=>
           (strWrap $ concat [ "Hit 'x', 'y', or 'z' to advance progress,"
                             , "'t' to toggle labels, 'r' to revert values, "
                             , "'Ctrl + r' to reset values or 'q' to quit"
                             ])

appEvent :: T.BrickEvent () e -> T.EventM () (MyAppState ()) ()
appEvent (T.VtyEvent e) =
    let valid = clamp (0.0 :: Float) 1.0
    in case e of
         V.EvKey (V.KChar 'x') [] -> x %= valid . (+ 0.05)
         V.EvKey (V.KChar 'y') [] -> y %= valid . (+ 0.03)
         V.EvKey (V.KChar 'z') [] -> z %= valid . (+ 0.02)
         V.EvKey (V.KChar 't') [] -> showLabel %= not
         V.EvKey (V.KChar 'r') [V.MCtrl] -> do
           x .= 0
           y .= 0
           z .= 0
         V.EvKey (V.KChar 'r') [] -> T.put initialState
         V.EvKey (V.KChar 'q') [] -> M.halt
         _ -> return ()
appEvent _ = return ()

initialState :: MyAppState ()
initialState = MyAppState 0.25 0.18 0.63 True

theBaseAttr :: A.AttrName
theBaseAttr = A.attrName "theBase"

xDoneAttr, xToDoAttr :: A.AttrName
xDoneAttr = theBaseAttr <> A.attrName "X:done"
xToDoAttr = theBaseAttr <> A.attrName "X:remaining"

yDoneAttr, yToDoAttr :: A.AttrName
yDoneAttr = theBaseAttr <> A.attrName "Y:done"
yToDoAttr = theBaseAttr <> A.attrName "Y:remaining"

zDoneAttr, zToDoAttr :: A.AttrName
zDoneAttr = theBaseAttr <> A.attrName "Z:done"
zToDoAttr = theBaseAttr <> A.attrName "Z:remaining"

cDoneAttr, cToDoAttr :: A.AttrName
cDoneAttr = A.attrName "C:done"
cToDoAttr = A.attrName "C:remaining"

cDoneAttr1, cToDoAttr1 :: A.AttrName
cDoneAttr1 = A.attrName "C1:done"
cToDoAttr1 = A.attrName "C1:remaining"

cDoneAttr2, cToDoAttr2 :: A.AttrName
cDoneAttr2 = A.attrName "C2:done"
cToDoAttr2 = A.attrName "C2:remaining"

theMap :: A.AttrMap
theMap = A.attrMap V.defAttr
         [ (theBaseAttr,               bg V.brightBlack)
         , (xDoneAttr,                 V.black `on` V.white)
         , (xToDoAttr,                 V.white `on` V.black)
         , (yDoneAttr,                 V.magenta `on` V.yellow)
         , (zDoneAttr,                 V.blue `on` V.green)
         , (zToDoAttr,                 V.blue `on` V.red)
         , (cDoneAttr,                 fg V.blue)
         , (cToDoAttr,                 fg V.blue)
         , (cDoneAttr1,                fg V.red)
         , (cToDoAttr1,                fg V.brightWhite)
         , (cDoneAttr2,                fg V.green)
         , (cToDoAttr2,                fg V.brightGreen)
         , (P.progressIncompleteAttr,  fg V.yellow)
         ]

theApp :: M.App (MyAppState ()) e ()
theApp =
    M.App { M.appDraw = drawUI
          , M.appChooseCursor = M.showFirstCursor
          , M.appHandleEvent = appEvent
          , M.appStartEvent = return ()
          , M.appAttrMap = const theMap
          }

main :: IO ()
main = void $ M.defaultMain theApp initialState