Milestone 2: Graphic User Interface #93
2 changed files with 128 additions and 59 deletions
|
|
@ -21,6 +21,7 @@ import Lens.Micro ((&), (+~), (.~), (?~), (^.), set)
|
|||
import Lens.Micro.TH
|
||||
import Monomer
|
||||
import qualified Monomer.Lens as L
|
||||
import System.Hclip
|
||||
import TextShow
|
||||
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
|
||||
import ZcashHaskell.Transparent (encodeTransparentReceiver)
|
||||
|
|
@ -45,6 +46,8 @@ data AppEvent
|
|||
| SetPool !ZcashPool
|
||||
| SwitchQr !(Maybe QrCode)
|
||||
| SwitchAddr !Int
|
||||
| CopyAddr !(Maybe (Entity WalletAddress))
|
||||
| LoadTxs ![Entity UserTx]
|
||||
deriving (Eq, Show)
|
||||
|
||||
data AppModel = AppModel
|
||||
|
|
@ -161,9 +164,9 @@ buildUI wenv model = widgetTree
|
|||
, filler
|
||||
]
|
||||
addressBox =
|
||||
boxShadow $
|
||||
vstack
|
||||
[ box_
|
||||
[ boxShadow $
|
||||
box_
|
||||
[alignMiddle]
|
||||
(vstack
|
||||
[ label "Addresses" `styleBasic`
|
||||
|
|
@ -180,64 +183,90 @@ buildUI wenv model = widgetTree
|
|||
[alignMiddle]
|
||||
(hstack
|
||||
[ filler
|
||||
, vstack
|
||||
[ box_
|
||||
[onClick (SetPool Orchard)]
|
||||
(remixIcon remixShieldCheckFill `styleBasic`
|
||||
[ textSize 14
|
||||
, padding 4
|
||||
, styleIf (model ^. selPool == Orchard) (bgColor btnColor)
|
||||
, styleIf (model ^. selPool == Orchard) (textColor white)
|
||||
])
|
||||
, filler
|
||||
, box_
|
||||
[onClick (SetPool Sapling)]
|
||||
(remixIcon remixShieldLine `styleBasic`
|
||||
[ textSize 14
|
||||
, padding 4
|
||||
, styleIf (model ^. selPool == Sapling) (bgColor btnColor)
|
||||
, styleIf (model ^. selPool == Sapling) (textColor white)
|
||||
])
|
||||
, filler
|
||||
, box_
|
||||
[onClick (SetPool Transparent)]
|
||||
(remixIcon remixDislikeLine `styleBasic`
|
||||
[ textSize 14
|
||||
, padding 4
|
||||
, styleIf
|
||||
(model ^. selPool == Transparent)
|
||||
(bgColor btnColor)
|
||||
, styleIf
|
||||
(model ^. selPool == Transparent)
|
||||
(textColor white)
|
||||
])
|
||||
]
|
||||
, vstack
|
||||
[ label
|
||||
(case model ^. selPool of
|
||||
Orchard -> "Unified"
|
||||
Sapling -> "Legacy Shielded"
|
||||
Transparent -> "Transparent"
|
||||
Sprout -> "Unknown") `styleBasic`
|
||||
[textColor white]
|
||||
, box_
|
||||
[alignMiddle]
|
||||
(case model ^. qrCodeWidget of
|
||||
Just qr ->
|
||||
imageMem_
|
||||
(qrCodeName qr)
|
||||
(qrCodeBytes qr)
|
||||
(Size
|
||||
(fromIntegral $ qrCodeHeight qr)
|
||||
(fromIntegral $ qrCodeWidth qr))
|
||||
[fitWidth]
|
||||
Nothing -> image_ "./assets/2620_color.png" [fitEither]) `styleBasic`
|
||||
[bgColor white, height 100, width 100]
|
||||
, boxShadow $
|
||||
hstack
|
||||
[ vstack
|
||||
[ tooltip "Unified" $
|
||||
box_
|
||||
[onClick (SetPool Orchard)]
|
||||
(remixIcon remixShieldCheckFill `styleBasic`
|
||||
[ textSize 14
|
||||
, padding 4
|
||||
, styleIf
|
||||
(model ^. selPool == Orchard)
|
||||
(bgColor btnColor)
|
||||
, styleIf
|
||||
(model ^. selPool == Orchard)
|
||||
(textColor white)
|
||||
])
|
||||
, filler
|
||||
, tooltip "Legacy Shielded" $
|
||||
box_
|
||||
[onClick (SetPool Sapling)]
|
||||
(remixIcon remixShieldLine `styleBasic`
|
||||
[ textSize 14
|
||||
, padding 4
|
||||
, styleIf
|
||||
(model ^. selPool == Sapling)
|
||||
(bgColor btnColor)
|
||||
, styleIf
|
||||
(model ^. selPool == Sapling)
|
||||
(textColor white)
|
||||
])
|
||||
, filler
|
||||
, tooltip "Transparent" $
|
||||
box_
|
||||
[onClick (SetPool Transparent)]
|
||||
(remixIcon remixEyeLine `styleBasic`
|
||||
[ textSize 14
|
||||
, padding 4
|
||||
, styleIf
|
||||
(model ^. selPool == Transparent)
|
||||
(bgColor btnColor)
|
||||
, styleIf
|
||||
(model ^. selPool == Transparent)
|
||||
(textColor white)
|
||||
])
|
||||
] `styleBasic`
|
||||
[bgColor white]
|
||||
, vstack
|
||||
[ filler
|
||||
, tooltip "Copy" $
|
||||
box_
|
||||
[onClick $ CopyAddr currentAddress]
|
||||
(hstack
|
||||
[ label
|
||||
(case model ^. selPool of
|
||||
Orchard -> "Unified"
|
||||
Sapling -> "Legacy Shielded"
|
||||
Transparent -> "Transparent"
|
||||
Sprout -> "Unknown") `styleBasic`
|
||||
[textColor white]
|
||||
, remixIcon remixFileCopyFill `styleBasic`
|
||||
[textSize 14, padding 4, textColor white]
|
||||
]) `styleBasic`
|
||||
[cursorHand]
|
||||
, box_
|
||||
[alignMiddle]
|
||||
(case model ^. qrCodeWidget of
|
||||
Just qr ->
|
||||
imageMem_
|
||||
(qrCodeName qr)
|
||||
(qrCodeBytes qr)
|
||||
(Size
|
||||
(fromIntegral $ qrCodeHeight qr)
|
||||
(fromIntegral $ qrCodeWidth qr))
|
||||
[fitWidth]
|
||||
Nothing ->
|
||||
image_ "./assets/2620_color.png" [fitEither]) `styleBasic`
|
||||
[bgColor white, height 100, width 100]
|
||||
, filler
|
||||
] `styleBasic`
|
||||
[bgColor btnColor, border 2 btnColor]
|
||||
] `styleBasic`
|
||||
[bgColor btnColor, border 2 btnColor]
|
||||
[radius 3, border 1 btnColor]
|
||||
, filler
|
||||
] `styleBasic`
|
||||
[bgColor white])
|
||||
])
|
||||
addrRow :: Int -> Entity WalletAddress -> WidgetNode AppModel AppEvent
|
||||
addrRow idx wAddr =
|
||||
box_
|
||||
|
|
@ -395,9 +424,35 @@ handleEvent wenv node model evt =
|
|||
case currentAddress of
|
||||
Nothing -> return Nothing
|
||||
Just wAddr -> getQrCode dbPool p $ entityKey wAddr
|
||||
, Task $
|
||||
LoadTxs <$> do
|
||||
dbPool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
|
||||
case currentAddress of
|
||||
Nothing -> return []
|
||||
Just wAddr -> getUserTx dbPool $ entityKey wAddr
|
||||
]
|
||||
SwitchQr q -> [Model $ model & qrCodeWidget .~ q]
|
||||
SwitchAddr i -> [Model $ model & selAddr .~ i, Event $ SetPool Orchard]
|
||||
CopyAddr a ->
|
||||
[ setClipboardData $
|
||||
ClipboardText $
|
||||
case model ^. selPool of
|
||||
Orchard -> maybe "None" (getUA . walletAddressUAddress . entityVal) a
|
||||
Sapling ->
|
||||
fromMaybe "None" $
|
||||
(getSaplingFromUA .
|
||||
E.encodeUtf8 . getUA . walletAddressUAddress . entityVal) =<<
|
||||
a
|
||||
Sprout -> "None"
|
||||
Transparent ->
|
||||
maybe "None" (encodeTransparentReceiver (model ^. network)) $
|
||||
t_rec =<<
|
||||
(isValidUnifiedAddress .
|
||||
E.encodeUtf8 . getUA . walletAddressUAddress . entityVal) =<<
|
||||
a
|
||||
, Event $ ShowMsg "Copied address!"
|
||||
]
|
||||
LoadTxs t -> [Model $ model & transactions .~ t]
|
||||
CloseMsg -> [Model $ model & msg .~ Nothing]
|
||||
where
|
||||
currentWallet =
|
||||
|
|
@ -492,7 +547,7 @@ runZenithGUI config = do
|
|||
where
|
||||
params =
|
||||
[ appWindowTitle "Zenith - Zcash Full Node Wallet"
|
||||
, appWindowState $ MainWindowNormal (1000, 600)
|
||||
, appWindowState $ MainWindowNormal (1000, 700)
|
||||
, appTheme zenithTheme
|
||||
, appFontDef "Regular" "./assets/Atkinson-Hyperlegible-Regular-102.ttf" --"./assets/DejaVuSansMono.ttf"
|
||||
, appFontDef "Bold" "./assets/Atkinson-Hyperlegible-Bold-102.ttf"
|
||||
|
|
|
|||
|
|
@ -28,6 +28,20 @@ zenithTheme =
|
|||
Nothing
|
||||
Nothing &
|
||||
L.hover .
|
||||
L.tooltipStyle . L.text ?~
|
||||
TextStyle
|
||||
Nothing
|
||||
(Just . FontSize $ 10)
|
||||
Nothing
|
||||
Nothing
|
||||
(Just black)
|
||||
Nothing
|
||||
Nothing
|
||||
Nothing
|
||||
Nothing
|
||||
Nothing
|
||||
Nothing &
|
||||
L.hover .
|
||||
L.labelStyle . L.text ?~
|
||||
TextStyle
|
||||
Nothing
|
||||
|
|
|
|||
Loading…
Reference in a new issue