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 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,64 +183,90 @@ buildUI wenv model = widgetTree
[alignMiddle] [alignMiddle]
(hstack (hstack
[ filler [ filler
, vstack , boxShadow $
[ box_ hstack
[onClick (SetPool Orchard)] [ vstack
(remixIcon remixShieldCheckFill `styleBasic` [ tooltip "Unified" $
[ textSize 14 box_
, padding 4 [onClick (SetPool Orchard)]
, styleIf (model ^. selPool == Orchard) (bgColor btnColor) (remixIcon remixShieldCheckFill `styleBasic`
, styleIf (model ^. selPool == Orchard) (textColor white) [ textSize 14
]) , padding 4
, filler , styleIf
, box_ (model ^. selPool == Orchard)
[onClick (SetPool Sapling)] (bgColor btnColor)
(remixIcon remixShieldLine `styleBasic` , styleIf
[ textSize 14 (model ^. selPool == Orchard)
, padding 4 (textColor white)
, styleIf (model ^. selPool == Sapling) (bgColor btnColor) ])
, styleIf (model ^. selPool == Sapling) (textColor white) , filler
]) , tooltip "Legacy Shielded" $
, filler box_
, box_ [onClick (SetPool Sapling)]
[onClick (SetPool Transparent)] (remixIcon remixShieldLine `styleBasic`
(remixIcon remixDislikeLine `styleBasic` [ textSize 14
[ textSize 14 , padding 4
, padding 4 , styleIf
, styleIf (model ^. selPool == Sapling)
(model ^. selPool == Transparent) (bgColor btnColor)
(bgColor btnColor) , styleIf
, styleIf (model ^. selPool == Sapling)
(model ^. selPool == Transparent) (textColor white)
(textColor white) ])
]) , filler
] , tooltip "Transparent" $
, vstack box_
[ label [onClick (SetPool Transparent)]
(case model ^. selPool of (remixIcon remixEyeLine `styleBasic`
Orchard -> "Unified" [ textSize 14
Sapling -> "Legacy Shielded" , padding 4
Transparent -> "Transparent" , styleIf
Sprout -> "Unknown") `styleBasic` (model ^. selPool == Transparent)
[textColor white] (bgColor btnColor)
, box_ , styleIf
[alignMiddle] (model ^. selPool == Transparent)
(case model ^. qrCodeWidget of (textColor white)
Just qr -> ])
imageMem_ ] `styleBasic`
(qrCodeName qr) [bgColor white]
(qrCodeBytes qr) , vstack
(Size [ filler
(fromIntegral $ qrCodeHeight qr) , tooltip "Copy" $
(fromIntegral $ qrCodeWidth qr)) box_
[fitWidth] [onClick $ CopyAddr currentAddress]
Nothing -> image_ "./assets/2620_color.png" [fitEither]) `styleBasic` (hstack
[bgColor white, height 100, width 100] [ 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` ] `styleBasic`
[bgColor btnColor, border 2 btnColor] [radius 3, border 1 btnColor]
, filler , filler
] `styleBasic` ])
[bgColor white])
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"

14
src/Zenith/GUI/Theme.hs
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