mirror of
https://github.com/fjvallarino/monomer.git
synced 2024-09-11 12:05:35 +03:00
Improve Ticker example styling
This commit is contained in:
parent
5e88da0323
commit
94fbb8d507
2
.ghcid
2
.ghcid
@ -1,3 +1,3 @@
|
||||
--command "stack repl --main-is monomer:exe:todo"
|
||||
--command "stack repl --main-is monomer:exe:ticker"
|
||||
--test ":main"
|
||||
--restart=package.yaml
|
||||
|
@ -12,12 +12,10 @@ import Control.Monad (forever, forM_, void, when)
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Monad.STM
|
||||
import Data.Aeson
|
||||
import Data.Aeson.Types (parseMaybe)
|
||||
import Data.Default
|
||||
import Data.Maybe
|
||||
import Data.Scientific
|
||||
import Data.Text (Text)
|
||||
import TextShow
|
||||
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Text as T
|
||||
@ -37,45 +35,54 @@ buildUI
|
||||
-> TickerModel
|
||||
-> WidgetNode TickerModel TickerEvt
|
||||
buildUI wenv model = widgetTree where
|
||||
dragColor = lightGray & L.a .~ 0.5
|
||||
closeIcon = icon_ IconClose [width 4] `style` [width 12, height 12, fgColor crimson, cursorHand]
|
||||
sectionColor = wenv ^. L.theme . L.sectionColor
|
||||
dragColor = rgbaHex "#D3D3D3" 0.5
|
||||
rowSep = rgbaHex "#A9A9A9" 0.5
|
||||
rowBg = wenv ^. L.theme . L.userColorMap . at "rowBg" . non def
|
||||
trashBg = wenv ^. L.theme . L.userColorMap . at "trashBg" . non def
|
||||
trashFg = wenv ^. L.theme . L.userColorMap . at "trashFg" . non def
|
||||
trashIcon action = button remixDeleteBinLine action
|
||||
`style` [textFont "Remix", textMiddle, textColor trashFg, bgColor transparent, border 0 transparent]
|
||||
`hover` [bgColor trashBg]
|
||||
dropTicker pair widget = dropTarget_ (TickerMovePair pair) [dropTargetStyle [bgColor darkGray]] widget
|
||||
tickerPct t = label pctText `style` [width 100, textRight, textColor pctColor] where
|
||||
tickerPct t = pctLabel where
|
||||
diff = toRealFloat $ 100 * (t ^. close - t ^. open)
|
||||
pct = diff / toRealFloat (t ^. open)
|
||||
pctText = formatTickerPct (fromFloatDigits pct) <> "%"
|
||||
pctColor
|
||||
| abs pct < 0.01 = white
|
||||
| pct > 0 = green
|
||||
| otherwise = red
|
||||
tickerItem t = vstack [
|
||||
spacer,
|
||||
| abs pct < 0.01 = rgbHex "#428FE0"
|
||||
| pct > 0 = rgbHex "#51A39A"
|
||||
| otherwise = rgbHex "#E25141"
|
||||
pctLabel = label pctText `style` [width 100, textRight, textColor pctColor]
|
||||
tickerItem idx t = hstack [
|
||||
dropTicker (t ^. symbolPair) $
|
||||
draggable_ (t ^. symbolPair) [draggableStyle [bgColor dragColor]] $ hstack [
|
||||
label (t ^. symbolPair) `style` [width 100],
|
||||
spacer,
|
||||
label (formatTickerValue (t ^. close)) `style` [textRight, minWidth 100],
|
||||
spacer,
|
||||
tickerPct t,
|
||||
spacer,
|
||||
box_ [onClick (TickerRemovePairBegin (t ^. symbolPair))] closeIcon
|
||||
] `style` [cursorHand]
|
||||
]
|
||||
draggable_ (t ^. symbolPair) [draggableStyle [bgColor dragColor]] $
|
||||
hstack [
|
||||
label (t ^. symbolPair) `style` [width 100],
|
||||
spacer,
|
||||
label (formatTickerValue (t ^. close))
|
||||
`style` [textRight, minWidth 100],
|
||||
spacer,
|
||||
tickerPct t
|
||||
] `style` [cursorHand],
|
||||
spacer,
|
||||
trashIcon (TickerRemovePairBegin (t ^. symbolPair))
|
||||
] `style` [padding 10, borderB 1 rowSep]
|
||||
`hover` [bgColor rowBg]
|
||||
tickerList = vstack tickerRows where
|
||||
orderedTickers = (\e -> model ^? tickers . ix e) <$> model ^. symbolPairs
|
||||
tickerFade t = fadeOut_ [onFinished action] item `key` (t ^. symbolPair) where
|
||||
tickerFade idx t = fadeOut_ [onFinished action] item `key` (t ^. symbolPair) where
|
||||
action = TickerRemovePair (t ^. symbolPair)
|
||||
item = tickerItem t
|
||||
tickerRows = tickerFade <$> catMaybes orderedTickers
|
||||
item = tickerItem idx t
|
||||
tickerRows = zipWith tickerFade [0..] (catMaybes orderedTickers)
|
||||
widgetTree = vstack [
|
||||
hstack [
|
||||
label "New pair: ",
|
||||
keystroke [("Enter", TickerAddClick)] $ textField newPair `key` "newPair",
|
||||
spacer,
|
||||
button "Add" TickerAddClick
|
||||
] `style` [padding 5, paddingB 0],
|
||||
spacer,
|
||||
scroll $ tickerList `style` [padding 5, paddingT 0]
|
||||
] `style` [padding 20, bgColor sectionColor],
|
||||
scroll_ [scrollOverlay] $ tickerList `style` [padding 20, paddingT 10]
|
||||
]
|
||||
|
||||
handleEvent
|
||||
@ -93,12 +100,11 @@ handleEvent env wenv node model evt = case evt of
|
||||
Task (subscribeInitial env initialList),
|
||||
setFocusOnKey wenv "newPair"
|
||||
]
|
||||
TickerAddClick -> [Event $ TickerAddPair (model ^. newPair)]
|
||||
TickerAddPair pair -> [
|
||||
TickerAddClick -> [
|
||||
Model $ model
|
||||
& symbolPairs %~ (pair <|)
|
||||
& symbolPairs %~ (model ^. newPair <|)
|
||||
& newPair .~ "",
|
||||
Task $ subscribe env [pair],
|
||||
Task $ subscribe env [model ^. newPair],
|
||||
setFocusOnKey wenv "newPair"
|
||||
]
|
||||
TickerRemovePairBegin pair -> [
|
||||
@ -181,13 +187,25 @@ main = do
|
||||
where
|
||||
config = [
|
||||
appWindowTitle "Ticker",
|
||||
appTheme darkTheme,
|
||||
appTheme customDarkTheme,
|
||||
appFontDef "Regular" "./assets/fonts/Roboto-Regular.ttf",
|
||||
appFontDef "Bold" "./assets/fonts/Roboto-Bold.ttf",
|
||||
appFontDef "Remix" "./assets/fonts/remixicon.ttf",
|
||||
appInitEvent TickerInit
|
||||
]
|
||||
initModel = def
|
||||
|
||||
customLightTheme :: Theme
|
||||
customLightTheme = lightTheme
|
||||
& L.userColorMap . at "rowBg" ?~ rgbHex "#ECECEC"
|
||||
& L.userColorMap . at "trashBg" ?~ rgbHex "#D3D3D3"
|
||||
& L.userColorMap . at "trashFg" ?~ rgbHex "#808080"
|
||||
|
||||
customDarkTheme :: Theme
|
||||
customDarkTheme = darkTheme
|
||||
& L.userColorMap . at "rowBg" ?~ rgbHex "#515151"
|
||||
& L.userColorMap . at "trashBg" ?~ rgbHex "#656565"
|
||||
& L.userColorMap . at "trashFg" ?~ rgbHex "#909090"
|
||||
|
||||
formatTickerValue :: Scientific -> Text
|
||||
formatTickerValue = T.pack . formatScientific Fixed (Just 8)
|
||||
|
||||
|
@ -42,7 +42,6 @@ data TickerEvt
|
||||
= TickerInit
|
||||
| TickerIgnore
|
||||
| TickerAddClick
|
||||
| TickerAddPair Text
|
||||
| TickerRemovePairBegin Text
|
||||
| TickerRemovePair Text
|
||||
| TickerMovePair Text Text
|
||||
|
@ -46,10 +46,10 @@ lightThemeColors = BaseThemeColors {
|
||||
btnMainBgDisabled = blue04,
|
||||
btnMainText = white,
|
||||
btnMainTextDisabled = white,
|
||||
dialogBg = gray01,
|
||||
dialogBorder = gray01,
|
||||
dialogText = white,
|
||||
dialogTitleText = white,
|
||||
dialogBg = gray09,
|
||||
dialogBorder = white,
|
||||
dialogText = black,
|
||||
dialogTitleText = black,
|
||||
emptyOverlay = gray07 & L.a .~ 0.8,
|
||||
externalLinkBasic = blue07,
|
||||
externalLinkHover = blue08,
|
||||
@ -109,8 +109,8 @@ darkTheme = baseTheme darkThemeColors
|
||||
|
||||
darkThemeColors :: BaseThemeColors
|
||||
darkThemeColors = BaseThemeColors {
|
||||
clearColor = gray03,
|
||||
sectionColor = gray02,
|
||||
clearColor = gray02,
|
||||
sectionColor = gray03,
|
||||
btnFocusBorder = blue09,
|
||||
btnBgBasic = gray07,
|
||||
btnBgHover = gray09,
|
||||
|
Loading…
Reference in New Issue
Block a user