Milestone 2: Graphic User Interface #93
2 changed files with 110 additions and 5 deletions
|
@ -14,6 +14,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
|
|||
- Transaction list
|
||||
- Balance display
|
||||
- Account selector
|
||||
- Menu for new addresses, accounts, wallets
|
||||
|
||||
|
||||
## [0.5.3.0-beta]
|
||||
|
|
|
@ -43,13 +43,20 @@ data AppEvent
|
|||
| CloseMsg
|
||||
| WalletClicked
|
||||
| AccountClicked
|
||||
| MenuClicked
|
||||
| NewClicked
|
||||
| NewAddress
|
||||
| NewAccount
|
||||
| NewWallet
|
||||
| SetPool !ZcashPool
|
||||
| SwitchQr !(Maybe QrCode)
|
||||
| SwitchAddr !Int
|
||||
| SwitchAcc !Int
|
||||
| SwitchWal !Int
|
||||
| CopyAddr !(Maybe (Entity WalletAddress))
|
||||
| LoadTxs ![Entity UserTx]
|
||||
| LoadAddrs ![Entity WalletAddress]
|
||||
| LoadAccs ![Entity ZcashAccount]
|
||||
deriving (Eq, Show)
|
||||
|
||||
data AppModel = AppModel
|
||||
|
@ -70,6 +77,9 @@ data AppModel = AppModel
|
|||
, _selPool :: !ZcashPool
|
||||
, _qrCodeWidget :: !(Maybe QrCode)
|
||||
, _accPopup :: !Bool
|
||||
, _walPopup :: !Bool
|
||||
, _menuPopup :: !Bool
|
||||
, _newPopup :: !Bool
|
||||
} deriving (Eq, Show)
|
||||
|
||||
makeLenses ''AppModel
|
||||
|
@ -115,9 +125,21 @@ buildUI wenv model = widgetTree
|
|||
]
|
||||
windowHeader =
|
||||
hstack
|
||||
[ vstack
|
||||
[ box_
|
||||
[onClick MenuClicked, alignMiddle]
|
||||
(remixIcon remixMenuFill `styleBasic`
|
||||
[textSize 16, textColor white]) `styleBasic`
|
||||
[cursorHand, height 25, padding 3] `styleHover`
|
||||
[bgColor btnHiLite]
|
||||
, popup menuPopup menuBox
|
||||
]
|
||||
, vstack
|
||||
[ box_ [onClick WalletClicked, alignMiddle] walletButton `styleBasic`
|
||||
[cursorHand, height 25, padding 3] `styleHover`
|
||||
[bgColor btnHiLite]
|
||||
, popup walPopup walListPopup
|
||||
]
|
||||
, vstack
|
||||
[ box_ [onClick AccountClicked, alignMiddle] accountButton `styleBasic`
|
||||
[cursorHand, height 25, padding 3] `styleHover`
|
||||
|
@ -130,6 +152,47 @@ buildUI wenv model = widgetTree
|
|||
(model ^. network == TestNet)
|
||||
] `styleBasic`
|
||||
[bgColor btnColor]
|
||||
menuBox =
|
||||
box_
|
||||
[alignMiddle]
|
||||
(vstack
|
||||
[ box_
|
||||
[alignLeft]
|
||||
(vstack
|
||||
[ box_
|
||||
[alignLeft, onClick NewClicked]
|
||||
(hstack
|
||||
[ label "New"
|
||||
, filler
|
||||
, widgetIf (not $ model ^. newPopup) $
|
||||
remixIcon remixMenuUnfoldFill
|
||||
, widgetIf (model ^. newPopup) $
|
||||
remixIcon remixMenuFoldFill
|
||||
])
|
||||
, widgetIf (model ^. newPopup) $ animSlideIn newBox
|
||||
]) `styleBasic`
|
||||
[bgColor white, borderB 1 gray, padding 3]
|
||||
, box_ [alignLeft] (label "Backup Wallet") `styleBasic`
|
||||
[bgColor white, borderB 1 gray, padding 3]
|
||||
]) `styleBasic`
|
||||
[bgColor btnColor, padding 3]
|
||||
newBox =
|
||||
box_
|
||||
[alignMiddle]
|
||||
(vstack
|
||||
[ box_
|
||||
[alignLeft, onClick NewAddress]
|
||||
(hstack [label "Address", filler]) `styleBasic`
|
||||
[bgColor white, borderB 1 gray, padding 3]
|
||||
, box_
|
||||
[alignLeft, onClick NewAccount]
|
||||
(hstack [label "Account", filler]) `styleBasic`
|
||||
[bgColor white, borderB 1 gray, padding 3]
|
||||
, box_
|
||||
[alignLeft, onClick NewWallet]
|
||||
(hstack [label "Wallet", filler]) `styleBasic`
|
||||
[bgColor white, borderB 1 gray, padding 3]
|
||||
])
|
||||
walletButton =
|
||||
hstack
|
||||
[ label "Wallet: " `styleBasic` [textFont "Bold", textColor white]
|
||||
|
@ -137,6 +200,21 @@ buildUI wenv model = widgetTree
|
|||
[textFont "Regular", textColor white]
|
||||
, remixIcon remixArrowRightWideLine `styleBasic` [textColor white]
|
||||
]
|
||||
walListPopup =
|
||||
box_ [alignMiddle] dispWalList `styleBasic` [bgColor btnColor, padding 3]
|
||||
dispWalList = vstack (zipWith walRow [0 ..] (model ^. wallets))
|
||||
walRow :: Int -> Entity ZcashWallet -> WidgetNode AppModel AppEvent
|
||||
walRow idx wal =
|
||||
box_
|
||||
[onClick $ SwitchWal idx, alignCenter]
|
||||
(label (zcashWalletName (entityVal wal))) `styleBasic`
|
||||
[ padding 1
|
||||
, borderB 1 gray
|
||||
, bgColor white
|
||||
, width 80
|
||||
, styleIf (model ^. selWallet == idx) (borderL 2 btnHiLite)
|
||||
, styleIf (model ^. selWallet == idx) (borderR 2 btnHiLite)
|
||||
]
|
||||
accountButton =
|
||||
hstack
|
||||
[ label "Account: " `styleBasic` [textFont "Bold", textColor white]
|
||||
|
@ -155,6 +233,7 @@ buildUI wenv model = widgetTree
|
|||
[ padding 1
|
||||
, borderB 1 gray
|
||||
, bgColor white
|
||||
, width 80
|
||||
, styleIf (model ^. selAcc == idx) (borderL 2 btnHiLite)
|
||||
, styleIf (model ^. selAcc == idx) (borderR 2 btnHiLite)
|
||||
]
|
||||
|
@ -433,9 +512,14 @@ handleEvent ::
|
|||
handleEvent wenv node model evt =
|
||||
case evt of
|
||||
AppInit -> []
|
||||
ShowMsg t -> [Model $ model & msg ?~ t]
|
||||
WalletClicked -> [Model $ model & msg ?~ "You clicked Wallet!"]
|
||||
ShowMsg t -> [Model $ model & msg ?~ t & menuPopup .~ False]
|
||||
WalletClicked -> [Model $ model & walPopup .~ True]
|
||||
AccountClicked -> [Model $ model & accPopup .~ True]
|
||||
MenuClicked -> [Model $ model & menuPopup .~ True]
|
||||
NewClicked -> [Model $ model & newPopup .~ not (model ^. newPopup)]
|
||||
NewAddress -> [Event $ ShowMsg "You clicked new address"]
|
||||
NewAccount -> [Event $ ShowMsg "You clicked new account"]
|
||||
NewWallet -> [Event $ ShowMsg "You clicked new wallet"]
|
||||
SetPool p ->
|
||||
[ Model $ model & selPool .~ p
|
||||
, Task $
|
||||
|
@ -463,6 +547,15 @@ handleEvent wenv node model evt =
|
|||
Just acc -> runNoLoggingT $ getAddresses dbPool $ entityKey acc
|
||||
, Event $ SetPool Orchard
|
||||
]
|
||||
SwitchWal i ->
|
||||
[ Model $ model & selWallet .~ i & selAcc .~ 0 & selAddr .~ 0
|
||||
, Task $
|
||||
LoadAccs <$> do
|
||||
dbPool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
|
||||
case selectWallet i of
|
||||
Nothing -> return []
|
||||
Just wal -> runNoLoggingT $ getAccounts dbPool $ entityKey wal
|
||||
]
|
||||
CopyAddr a ->
|
||||
[ setClipboardData $
|
||||
ClipboardText $
|
||||
|
@ -484,12 +577,17 @@ handleEvent wenv node model evt =
|
|||
]
|
||||
LoadTxs t -> [Model $ model & transactions .~ t]
|
||||
LoadAddrs a -> [Model $ model & addresses .~ a, Event $ SetPool Orchard]
|
||||
LoadAccs a -> [Model $ model & accounts .~ a, Event $ SwitchAcc 0]
|
||||
CloseMsg -> [Model $ model & msg .~ Nothing]
|
||||
where
|
||||
currentWallet =
|
||||
if null (model ^. wallets)
|
||||
then Nothing
|
||||
else Just ((model ^. wallets) !! (model ^. selWallet))
|
||||
selectWallet i =
|
||||
if null (model ^. wallets)
|
||||
then Nothing
|
||||
else Just ((model ^. wallets) !! i)
|
||||
currentAccount =
|
||||
if null (model ^. accounts)
|
||||
then Nothing
|
||||
|
@ -556,6 +654,9 @@ runZenithGUI config = do
|
|||
Orchard
|
||||
qr
|
||||
False
|
||||
False
|
||||
False
|
||||
False
|
||||
startApp model handleEvent buildUI params
|
||||
Left e -> do
|
||||
initDb dbFilePath
|
||||
|
@ -580,6 +681,9 @@ runZenithGUI config = do
|
|||
Orchard
|
||||
Nothing
|
||||
False
|
||||
False
|
||||
False
|
||||
False
|
||||
startApp model handleEvent buildUI params
|
||||
where
|
||||
params =
|
||||
|
|
Loading…
Reference in a new issue