Formatting changes for QR display
This commit is contained in:
parent
eb925c21f7
commit
e14ae0febd
GPG key ID:
65122AD495A7F5B2
2 changed files with 128 additions and 59 deletions
|
|
@ -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"
|
||||||
|
|
|
||||||
|
|
@ -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
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue