Merge pull request 'Implement message window' (#61) from rav001 into dev041
Reviewed-on: #61
This commit is contained in:
commit
980a7c8901
1 changed files with 24 additions and 8 deletions
|
@ -3,11 +3,10 @@
|
||||||
module Zenith.CLI where
|
module Zenith.CLI where
|
||||||
|
|
||||||
import Control.Monad (void)
|
import Control.Monad (void)
|
||||||
import Control.Monad.State (modify)
|
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Graphics.Vty as V
|
import qualified Graphics.Vty as V
|
||||||
import Lens.Micro ((^.))
|
import Lens.Micro ((&), (.~), (^.), set)
|
||||||
import Lens.Micro.Mtl
|
import Lens.Micro.Mtl
|
||||||
import Lens.Micro.TH
|
import Lens.Micro.TH
|
||||||
|
|
||||||
|
@ -20,9 +19,12 @@ import qualified Brick.Widgets.Border as B
|
||||||
import Brick.Widgets.Border.Style (unicode)
|
import Brick.Widgets.Border.Style (unicode)
|
||||||
import qualified Brick.Widgets.Center as C
|
import qualified Brick.Widgets.Center as C
|
||||||
import Brick.Widgets.Core
|
import Brick.Widgets.Core
|
||||||
( (<+>)
|
( Padding(..)
|
||||||
|
, (<+>)
|
||||||
|
, (<=>)
|
||||||
, hLimit
|
, hLimit
|
||||||
, joinBorders
|
, joinBorders
|
||||||
|
, padRight
|
||||||
, str
|
, str
|
||||||
, vBox
|
, vBox
|
||||||
, vLimit
|
, vLimit
|
||||||
|
@ -40,10 +42,11 @@ data Name
|
||||||
deriving (Eq, Show, Ord)
|
deriving (Eq, Show, Ord)
|
||||||
|
|
||||||
data State = State
|
data State = State
|
||||||
{ _network :: String
|
{ _network :: !String
|
||||||
, _wallets :: L.List Name String
|
, _wallets :: !(L.List Name String)
|
||||||
, _addresses :: L.List Name String
|
, _addresses :: !(L.List Name String)
|
||||||
, _transactions :: L.List Name String
|
, _transactions :: !(L.List Name String)
|
||||||
|
, _msg :: !String
|
||||||
} deriving (Show)
|
} deriving (Show)
|
||||||
|
|
||||||
makeLenses ''State
|
makeLenses ''State
|
||||||
|
@ -57,7 +60,8 @@ drawUI s = [ui s]
|
||||||
withBorderStyle unicode $
|
withBorderStyle unicode $
|
||||||
B.borderWithLabel (str $ "Zenith - " <> s ^. network) $
|
B.borderWithLabel (str $ "Zenith - " <> s ^. network) $
|
||||||
(C.center (listBox "Addresses" (s ^. addresses)) <+>
|
(C.center (listBox "Addresses" (s ^. addresses)) <+>
|
||||||
B.vBorder <+> C.center (listBox "Transactions" (s ^. transactions)))
|
B.vBorder <+> C.center (listBox "Transactions" (s ^. transactions))) <=>
|
||||||
|
msgBox (s ^. msg)
|
||||||
listBox :: String -> L.List Name String -> Widget Name
|
listBox :: String -> L.List Name String -> Widget Name
|
||||||
listBox titleLabel l =
|
listBox titleLabel l =
|
||||||
C.vCenter $
|
C.vCenter $
|
||||||
|
@ -68,6 +72,10 @@ drawUI s = [ui s]
|
||||||
, str " "
|
, str " "
|
||||||
, C.hCenter $ str "Select "
|
, C.hCenter $ str "Select "
|
||||||
]
|
]
|
||||||
|
msgBox :: String -> Widget Name
|
||||||
|
msgBox m =
|
||||||
|
vBox
|
||||||
|
[B.hBorderWithLabel (str "Messages"), hLimit 70 $ padRight Max $ str m]
|
||||||
|
|
||||||
listDrawElement :: (Show a) => Bool -> a -> Widget Name
|
listDrawElement :: (Show a) => Bool -> a -> Widget Name
|
||||||
listDrawElement sel a =
|
listDrawElement sel a =
|
||||||
|
@ -84,6 +92,7 @@ initialState =
|
||||||
(L.list WList (Vec.fromList ["wall1"]) 1)
|
(L.list WList (Vec.fromList ["wall1"]) 1)
|
||||||
(L.list AList (Vec.fromList ["addr1", "addr2"]) 1)
|
(L.list AList (Vec.fromList ["addr1", "addr2"]) 1)
|
||||||
(L.list TList (Vec.fromList ["tx1", "tx2", "tx3"]) 1)
|
(L.list TList (Vec.fromList ["tx1", "tx2", "tx3"]) 1)
|
||||||
|
"Start up Ok!"
|
||||||
|
|
||||||
customAttr :: A.AttrName
|
customAttr :: A.AttrName
|
||||||
customAttr = L.listSelectedAttr <> A.attrName "custom"
|
customAttr = L.listSelectedAttr <> A.attrName "custom"
|
||||||
|
@ -92,7 +101,14 @@ appEvent :: BT.BrickEvent Name e -> BT.EventM Name State ()
|
||||||
appEvent (BT.VtyEvent e) =
|
appEvent (BT.VtyEvent e) =
|
||||||
case e of
|
case e of
|
||||||
V.EvKey V.KEsc [] -> M.halt
|
V.EvKey V.KEsc [] -> M.halt
|
||||||
|
V.EvKey (V.KChar 'c') [] -> printMsg "You pressed C!"
|
||||||
|
V.EvKey (V.KChar 's') [] -> printMsg "You pressed S!"
|
||||||
ev -> BT.zoom addresses $ L.handleListEvent ev
|
ev -> BT.zoom addresses $ L.handleListEvent ev
|
||||||
|
where
|
||||||
|
printMsg :: String -> BT.EventM Name State ()
|
||||||
|
printMsg s = BT.modify $ updateMsg s
|
||||||
|
updateMsg :: String -> State -> State
|
||||||
|
updateMsg = set msg
|
||||||
|
|
||||||
theMap :: A.AttrMap
|
theMap :: A.AttrMap
|
||||||
theMap =
|
theMap =
|
||||||
|
|
Loading…
Reference in a new issue