Vergara_Tech/zenith
Vergara_Tech/zenith
2
0
Fork 0
Code Issues 21 Pull requests Projects Releases 7 Packages Wiki Activity

Milestone 2: Graphic User Interface #93

Merged
pitmutt merged 38 commits from milestone2 into master 2024-07-17 14:28:52 +00:00
Conversation 0 Commits 38 Files changed 31 +128 -59
2 changed files with 128 additions and 59 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files
Showing only changes of commit e14ae0febd - Show all commits

173
src/Zenith/GUI.hs
View file

@ -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"

14
src/Zenith/GUI/Theme.hs
View file

@ -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