From e14ae0febd6cccd9dd5f2f1ff22ede2ba4b83e4e Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Fri, 7 Jun 2024 14:44:15 -0500 Subject: [PATCH] Formatting changes for QR display --- src/Zenith/GUI.hs | 173 ++++++++++++++++++++++++++-------------- src/Zenith/GUI/Theme.hs | 14 ++++ 2 files changed, 128 insertions(+), 59 deletions(-) diff --git a/src/Zenith/GUI.hs b/src/Zenith/GUI.hs index a304321..9fbe01f 100644 --- a/src/Zenith/GUI.hs +++ b/src/Zenith/GUI.hs @@ -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" diff --git a/src/Zenith/GUI/Theme.hs b/src/Zenith/GUI/Theme.hs index 893fda4..b67e227 100644 --- a/src/Zenith/GUI/Theme.hs +++ b/src/Zenith/GUI/Theme.hs @@ -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