Milestone 2: Graphic User Interface #93

Merged
pitmutt merged 38 commits from milestone2 into master 2024-07-17 14:28:52 +00:00
2 changed files with 128 additions and 59 deletions
Showing only changes of commit e14ae0febd - Show all commits

View file

@ -21,6 +21,7 @@ import Lens.Micro ((&), (+~), (.~), (?~), (^.), set)
import Lens.Micro.TH import Lens.Micro.TH
import Monomer import Monomer
import qualified Monomer.Lens as L import qualified Monomer.Lens as L
import System.Hclip
import TextShow import TextShow
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress) import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
import ZcashHaskell.Transparent (encodeTransparentReceiver) import ZcashHaskell.Transparent (encodeTransparentReceiver)
@ -45,6 +46,8 @@ data AppEvent
| SetPool !ZcashPool | SetPool !ZcashPool
| SwitchQr !(Maybe QrCode) | SwitchQr !(Maybe QrCode)
| SwitchAddr !Int | SwitchAddr !Int
| CopyAddr !(Maybe (Entity WalletAddress))
| LoadTxs ![Entity UserTx]
deriving (Eq, Show) deriving (Eq, Show)
data AppModel = AppModel data AppModel = AppModel
@ -161,9 +164,9 @@ buildUI wenv model = widgetTree
, filler , filler
] ]
addressBox = addressBox =
boxShadow $
vstack vstack
[ box_ [ boxShadow $
box_
[alignMiddle] [alignMiddle]
(vstack (vstack
[ label "Addresses" `styleBasic` [ label "Addresses" `styleBasic`
@ -180,28 +183,41 @@ buildUI wenv model = widgetTree
[alignMiddle] [alignMiddle]
(hstack (hstack
[ filler [ filler
, vstack , boxShadow $
[ box_ hstack
[ vstack
[ tooltip "Unified" $
box_
[onClick (SetPool Orchard)] [onClick (SetPool Orchard)]
(remixIcon remixShieldCheckFill `styleBasic` (remixIcon remixShieldCheckFill `styleBasic`
[ textSize 14 [ textSize 14
, padding 4 , padding 4
, styleIf (model ^. selPool == Orchard) (bgColor btnColor) , styleIf
, styleIf (model ^. selPool == Orchard) (textColor white) (model ^. selPool == Orchard)
(bgColor btnColor)
, styleIf
(model ^. selPool == Orchard)
(textColor white)
]) ])
, filler , filler
, box_ , tooltip "Legacy Shielded" $
box_
[onClick (SetPool Sapling)] [onClick (SetPool Sapling)]
(remixIcon remixShieldLine `styleBasic` (remixIcon remixShieldLine `styleBasic`
[ textSize 14 [ textSize 14
, padding 4 , padding 4
, styleIf (model ^. selPool == Sapling) (bgColor btnColor) , styleIf
, styleIf (model ^. selPool == Sapling) (textColor white) (model ^. selPool == Sapling)
(bgColor btnColor)
, styleIf
(model ^. selPool == Sapling)
(textColor white)
]) ])
, filler , filler
, box_ , tooltip "Transparent" $
box_
[onClick (SetPool Transparent)] [onClick (SetPool Transparent)]
(remixIcon remixDislikeLine `styleBasic` (remixIcon remixEyeLine `styleBasic`
[ textSize 14 [ textSize 14
, padding 4 , padding 4
, styleIf , styleIf
@ -211,8 +227,14 @@ buildUI wenv model = widgetTree
(model ^. selPool == Transparent) (model ^. selPool == Transparent)
(textColor white) (textColor white)
]) ])
] ] `styleBasic`
[bgColor white]
, vstack , vstack
[ filler
, tooltip "Copy" $
box_
[onClick $ CopyAddr currentAddress]
(hstack
[ label [ label
(case model ^. selPool of (case model ^. selPool of
Orchard -> "Unified" Orchard -> "Unified"
@ -220,6 +242,10 @@ buildUI wenv model = widgetTree
Transparent -> "Transparent" Transparent -> "Transparent"
Sprout -> "Unknown") `styleBasic` Sprout -> "Unknown") `styleBasic`
[textColor white] [textColor white]
, remixIcon remixFileCopyFill `styleBasic`
[textSize 14, padding 4, textColor white]
]) `styleBasic`
[cursorHand]
, box_ , box_
[alignMiddle] [alignMiddle]
(case model ^. qrCodeWidget of (case model ^. qrCodeWidget of
@ -231,13 +257,16 @@ buildUI wenv model = widgetTree
(fromIntegral $ qrCodeHeight qr) (fromIntegral $ qrCodeHeight qr)
(fromIntegral $ qrCodeWidth qr)) (fromIntegral $ qrCodeWidth qr))
[fitWidth] [fitWidth]
Nothing -> image_ "./assets/2620_color.png" [fitEither]) `styleBasic` Nothing ->
image_ "./assets/2620_color.png" [fitEither]) `styleBasic`
[bgColor white, height 100, width 100] [bgColor white, height 100, width 100]
] `styleBasic`
[bgColor btnColor, border 2 btnColor]
, filler , filler
] `styleBasic` ] `styleBasic`
[bgColor white]) [bgColor btnColor, border 2 btnColor]
] `styleBasic`
[radius 3, border 1 btnColor]
, filler
])
addrRow :: Int -> Entity WalletAddress -> WidgetNode AppModel AppEvent addrRow :: Int -> Entity WalletAddress -> WidgetNode AppModel AppEvent
addrRow idx wAddr = addrRow idx wAddr =
box_ box_
@ -395,9 +424,35 @@ handleEvent wenv node model evt =
case currentAddress of case currentAddress of
Nothing -> return Nothing Nothing -> return Nothing
Just wAddr -> getQrCode dbPool p $ entityKey wAddr 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] SwitchQr q -> [Model $ model & qrCodeWidget .~ q]
SwitchAddr i -> [Model $ model & selAddr .~ i, Event $ SetPool Orchard] 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] CloseMsg -> [Model $ model & msg .~ Nothing]
where where
currentWallet = currentWallet =
@ -492,7 +547,7 @@ runZenithGUI config = do
where where
params = params =
[ appWindowTitle "Zenith - Zcash Full Node Wallet" [ appWindowTitle "Zenith - Zcash Full Node Wallet"
, appWindowState $ MainWindowNormal (1000, 600) , appWindowState $ MainWindowNormal (1000, 700)
, appTheme zenithTheme , appTheme zenithTheme
, appFontDef "Regular" "./assets/Atkinson-Hyperlegible-Regular-102.ttf" --"./assets/DejaVuSansMono.ttf" , appFontDef "Regular" "./assets/Atkinson-Hyperlegible-Regular-102.ttf" --"./assets/DejaVuSansMono.ttf"
, appFontDef "Bold" "./assets/Atkinson-Hyperlegible-Bold-102.ttf" , appFontDef "Bold" "./assets/Atkinson-Hyperlegible-Bold-102.ttf"

View file

@ -28,6 +28,20 @@ zenithTheme =
Nothing Nothing
Nothing & Nothing &
L.hover . 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 ?~ L.labelStyle . L.text ?~
TextStyle TextStyle
Nothing Nothing