mirror of
https://github.com/fjvallarino/monomer.git
synced 2024-09-11 12:05:35 +03:00
Refactor/reformat examples code
This commit is contained in:
parent
94fbb8d507
commit
efa89f0ed3
2
.ghcid
2
.ghcid
@ -1,3 +1,3 @@
|
||||
--command "stack repl --main-is monomer:exe:ticker"
|
||||
--command "stack repl --main-is monomer:exe:generative"
|
||||
--test ":main"
|
||||
--restart=package.yaml
|
||||
|
@ -18,71 +18,78 @@ import Monomer
|
||||
|
||||
import qualified Monomer.Lens as L
|
||||
|
||||
type BooksWenv = WidgetEnv BooksModel BooksEvt
|
||||
type BooksNode = WidgetNode BooksModel BooksEvt
|
||||
|
||||
bookImage :: Maybe Int -> Text -> WidgetNode s BooksEvt
|
||||
bookImage imgId size = maybe filler coverImg imgId where
|
||||
baseUrl = "http://covers.openlibrary.org/b/id/<id>-<size>.jpg"
|
||||
imgUrl i = T.replace "<size>" size $ T.replace "<id>" (showt i) baseUrl
|
||||
coverImg i = image_ (imgUrl i) [fitHeight, alignRight]
|
||||
|
||||
bookRow :: BooksWenv -> Book -> BooksNode
|
||||
bookRow wenv b = row where
|
||||
rowBgColor = wenv ^. L.theme . L.userColorMap . at "rowBgColor" . non def
|
||||
publishYear = maybe "" showt (b ^. year)
|
||||
|
||||
rowContent b = hstack [
|
||||
vstack [
|
||||
label_ (b ^. title) [resizeFactor 1]
|
||||
`style` [textFont "Medium", textSize 16],
|
||||
spacer,
|
||||
label_ (T.intercalate ", " (b ^. authors)) [resizeFactor 1]
|
||||
`style` [textSize 14]
|
||||
],
|
||||
filler,
|
||||
vstack [
|
||||
label publishYear `style` [width 50, textSize 14],
|
||||
spacer
|
||||
],
|
||||
bookImage (b ^. cover) "S" `style` [width 35]
|
||||
]
|
||||
|
||||
row = box_ cfg content `style` [padding 10, paddingT 0] where
|
||||
cfg = [expandContent, onClick (BooksShowDetails b)]
|
||||
content = rowContent b
|
||||
`style` [height 80, padding 20, radius 5]
|
||||
`hover` [bgColor rowBgColor, cursorIcon CursorHand]
|
||||
|
||||
bookDetail :: Book -> WidgetNode s BooksEvt
|
||||
bookDetail b = content `style` [minWidth 500, paddingH 20] where
|
||||
hasCover = isJust (b ^. cover)
|
||||
publishYear = maybe "" showt (b ^. year)
|
||||
|
||||
shortLabel value = label value `style` [textFont "Medium", textTop]
|
||||
longLabel value = label_ value [multiLine, ellipsis, trimSpaces]
|
||||
|
||||
content = hstack . concat $ [[
|
||||
vstack [
|
||||
longLabel (b ^. title)
|
||||
`style` [textSize 20, textFont "Medium"],
|
||||
spacer,
|
||||
longLabel (T.intercalate ", " (b ^. authors))
|
||||
`style` [textSize 16],
|
||||
spacer,
|
||||
label publishYear
|
||||
`style` [textSize 14]
|
||||
]],
|
||||
[filler | hasCover],
|
||||
[bookImage (b ^. cover) "M" `style` [width 200] | hasCover]
|
||||
]
|
||||
|
||||
buildUI
|
||||
:: WidgetEnv BooksModel BooksEvt
|
||||
-> BooksModel
|
||||
-> WidgetNode BooksModel BooksEvt
|
||||
buildUI wenv model = widgetTree where
|
||||
sectionBgColor = wenv ^. L.theme . L.sectionColor
|
||||
rowBgColor = wenv ^. L.theme . L.userColorMap . at "rowBgColor" . non def
|
||||
bookImage imgId size = maybe filler coverImg imgId where
|
||||
baseUrl = "http://covers.openlibrary.org/b/id/<id>-<size>.jpg"
|
||||
imgUrl i = T.replace "<size>" size $ T.replace "<id>" (showt i) baseUrl
|
||||
coverImg i = image_ (imgUrl i) [fitHeight, alignRight]
|
||||
bookRow b = box_ cfg content `style` [padding 10, paddingT 0] where
|
||||
cfg = [expandContent, onClick (BooksShowDetails b)]
|
||||
content = bookRowContent b
|
||||
`style` [bgColor rowBgColor, height 80, padding 20, radius 5]
|
||||
`hover` [bgColor gray, cursorIcon CursorHand]
|
||||
bookRowContent b = hstack [
|
||||
vstack [
|
||||
hstack [
|
||||
label "Title: " `style` [textFont "Bold"],
|
||||
label_ (b ^. title) [resizeFactor 1]
|
||||
],
|
||||
spacer,
|
||||
hstack [
|
||||
label "Authors: " `style` [textFont "Bold"],
|
||||
label_ (T.intercalate ", " (b ^. authors)) [resizeFactor 1]
|
||||
]
|
||||
],
|
||||
filler,
|
||||
vstack [
|
||||
hstack [
|
||||
label "Year: " `style` [textFont "Bold"],
|
||||
label $ maybe "" showt (b ^. year)
|
||||
]
|
||||
] `style` [width 100],
|
||||
bookImage (b ^. cover) "S" `style` [width 35]
|
||||
]
|
||||
bookDetail b = content `style` [minWidth 500, paddingH 20] where
|
||||
hasCover = isJust (b ^. cover)
|
||||
shortLabel value = label value `style` [textFont "Bold", textTop]
|
||||
longLabel value = label_ value [multiLine, ellipsis, trimSpaces]
|
||||
content = hstack . concat $ [[
|
||||
vstack [
|
||||
hstack [
|
||||
shortLabel "Title: ",
|
||||
longLabel (b ^. title)
|
||||
],
|
||||
spacer,
|
||||
hstack [
|
||||
shortLabel "Authors: ",
|
||||
longLabel (T.intercalate ", " (b ^. authors))
|
||||
],
|
||||
spacer,
|
||||
hstack [
|
||||
shortLabel "Year: ",
|
||||
label $ maybe "" showt (b ^. year)
|
||||
]
|
||||
]],
|
||||
[filler | hasCover],
|
||||
[bookImage (b ^. cover) "M" `style` [width 200] | hasCover]
|
||||
]
|
||||
|
||||
bookOverlay = alert BooksCloseDetails content where
|
||||
content = maybe spacer bookDetail (model ^. selected)
|
||||
|
||||
searchOverlay = box content `style` [bgColor (darkGray & L.a .~ 0.8)] where
|
||||
content = label "Searching" `style` [textSize 20, textColor black]
|
||||
|
||||
searchForm = keystroke [("Enter", BooksSearch)] $ vstack [
|
||||
hstack [
|
||||
label "Query:",
|
||||
@ -92,26 +99,20 @@ buildUI wenv model = widgetTree where
|
||||
mainButton "Search" BooksSearch
|
||||
] `style` [bgColor sectionBgColor, padding 25]
|
||||
]
|
||||
|
||||
countLabel = label caption `style` [padding 10] where
|
||||
caption = "Books (" <> showt (length $ model ^. books) <> ")"
|
||||
|
||||
widgetTree = zstack [
|
||||
vstack [
|
||||
searchForm,
|
||||
countLabel,
|
||||
vscroll (vstack (bookRow <$> model ^. books)) `key` "mainScroll"
|
||||
vscroll (vstack (bookRow wenv <$> model ^. books)) `key` "mainScroll"
|
||||
],
|
||||
bookOverlay `visible` isJust (model ^. selected),
|
||||
searchOverlay `visible` model ^. searching
|
||||
]
|
||||
|
||||
{-
|
||||
searchBgColor :: Color
|
||||
searchBgColor = rgbHex "#404040"
|
||||
|
||||
rowBgColor :: Color
|
||||
rowBgColor = rgbHex "#212121"
|
||||
-}
|
||||
|
||||
handleEvent
|
||||
:: WidgetEnv BooksModel BooksEvt
|
||||
-> WidgetNode BooksModel BooksEvt
|
||||
@ -150,14 +151,18 @@ main = do
|
||||
where
|
||||
config = [
|
||||
appWindowTitle "Book search",
|
||||
appTheme lightTheme,
|
||||
appTheme customLightTheme,
|
||||
appFontDef "Regular" "./assets/fonts/Roboto-Regular.ttf",
|
||||
appFontDef "Bold" "./assets/fonts/Roboto-Bold.ttf",
|
||||
appFontDef "Medium" "./assets/fonts/Roboto-Medium.ttf",
|
||||
appInitEvent BooksInit
|
||||
]
|
||||
initBook = Book "This is my book" ["Author1", "Author 2"] (Just 2000) (Just 1234)
|
||||
initModel = BooksModel "pedro paramo" False (Just initBook) [initBook]
|
||||
customLightTheme = lightTheme
|
||||
& L.userColorMap . at "rowBgColor" ?~ rgbHex "#636363"
|
||||
customDarkTheme = darkTheme
|
||||
& L.userColorMap . at "rowBgColor" ?~ rgbHex "#212121"
|
||||
|
||||
customLightTheme :: Theme
|
||||
customLightTheme = lightTheme
|
||||
& L.userColorMap . at "rowBgColor" ?~ rgbHex "#ECECEC"
|
||||
|
||||
customDarkTheme :: Theme
|
||||
customDarkTheme = darkTheme
|
||||
& L.userColorMap . at "rowBgColor" ?~ rgbHex "#656565"
|
||||
|
@ -4,6 +4,7 @@ module Main where
|
||||
|
||||
import Control.Lens
|
||||
import Data.Default
|
||||
import Data.List (intersperse)
|
||||
import Data.Maybe
|
||||
import Data.Text (Text)
|
||||
import TextShow
|
||||
@ -17,53 +18,67 @@ import Widgets.CirclesGrid
|
||||
|
||||
import qualified Monomer.Lens as L
|
||||
|
||||
buildUI
|
||||
:: WidgetEnv GenerativeModel GenerativeEvt
|
||||
-> GenerativeModel
|
||||
-> WidgetNode GenerativeModel GenerativeEvt
|
||||
type GenerativeWenv = WidgetEnv GenerativeModel GenerativeEvt
|
||||
type GenerativeNode = WidgetNode GenerativeModel GenerativeEvt
|
||||
|
||||
buildUI :: GenerativeWenv -> GenerativeModel -> GenerativeNode
|
||||
buildUI wenv model = widgetTree where
|
||||
sectionBg = wenv ^. L.theme . L.sectionColor
|
||||
|
||||
seedDropdown lens = textDropdown_ lens seedList seedDesc []
|
||||
widgetCircleCfg = vstack [
|
||||
|
||||
widgetCircleCfg = vstack $ intersperse spacer [
|
||||
label "Width",
|
||||
dial_ (circlesCfg . itemWidth) 10 50 [dragRate 0.5],
|
||||
label "Random seed",
|
||||
vstack [
|
||||
dial_ (circlesCfg . itemWidth) 20 50 [dragRate 0.5],
|
||||
labelS (model ^. circlesCfg . itemWidth) `style` [textSize 14, textCenter]
|
||||
],
|
||||
label "Seed",
|
||||
seedDropdown (circlesCfg . seed)
|
||||
]
|
||||
widgetBoxCfg = vstack [
|
||||
|
||||
widgetBoxCfg = vstack $ intersperse spacer [
|
||||
label "Width",
|
||||
dial_ (boxesCfg . itemWidth) 10 50 [dragRate 0.5],
|
||||
vstack [
|
||||
dial_ (boxesCfg . itemWidth) 20 50 [dragRate 0.5],
|
||||
labelS (model ^. boxesCfg . itemWidth) `style` [textSize 14, textCenter]
|
||||
],
|
||||
label "Seed",
|
||||
seedDropdown (boxesCfg . seed),
|
||||
separatorLine,
|
||||
label "Palette type",
|
||||
textDropdown (boxesCfg . paletteType) [1..4],
|
||||
label "Palette size",
|
||||
dial_ (boxesCfg . paletteSize) 1 50 [dragRate 0.5],
|
||||
label "Random seed",
|
||||
seedDropdown (boxesCfg . seed)
|
||||
dial_ (boxesCfg . paletteSize) 1 50 [dragRate 0.5]
|
||||
]
|
||||
|
||||
widgetTree = vstack [
|
||||
hstack [
|
||||
label "Type: ",
|
||||
label "Type:",
|
||||
spacer,
|
||||
textDropdown_ activeGen genTypes genTypeDesc [] `key` "activeType",
|
||||
spacer,
|
||||
hstack [
|
||||
label "Show config: ",
|
||||
checkbox showCfg
|
||||
] `style` [width 150]
|
||||
] `style` [padding 3],
|
||||
labeledCheckbox "Show config:" showCfg
|
||||
] `style` [padding 20, bgColor sectionBg],
|
||||
zstack [
|
||||
hstack [
|
||||
circlesGrid (model ^. circlesCfg),
|
||||
widgetCircleCfg `visible` model ^. showCfg `style` [paddingH 3, width 150]
|
||||
circlesGrid (model ^. circlesCfg) `style` [padding 20],
|
||||
widgetCircleCfg
|
||||
`visible` model ^. showCfg
|
||||
`style` [padding 20, width 200, bgColor sectionBg]
|
||||
] `visible` (model ^. activeGen == CirclesGrid),
|
||||
hstack [
|
||||
boxesPalette (model ^. boxesCfg),
|
||||
widgetBoxCfg `visible` model ^. showCfg `style` [paddingH 3, width 150]
|
||||
boxesPalette (model ^. boxesCfg) `style` [padding 20],
|
||||
widgetBoxCfg
|
||||
`visible` model ^. showCfg
|
||||
`style` [padding 20, width 200, bgColor sectionBg]
|
||||
] `visible` (model ^. activeGen == BoxesPalette)
|
||||
]
|
||||
]
|
||||
|
||||
handleEvent
|
||||
:: WidgetEnv GenerativeModel GenerativeEvt
|
||||
-> WidgetNode GenerativeModel GenerativeEvt
|
||||
:: GenerativeWenv
|
||||
-> GenerativeNode
|
||||
-> GenerativeModel
|
||||
-> GenerativeEvt
|
||||
-> [EventResponse GenerativeModel GenerativeEvt GenerativeModel ()]
|
||||
|
@ -85,7 +85,8 @@ makeBoxesPalette cfg state = widget where
|
||||
colors <- makePalette (cfg ^. paletteType) (cfg ^. paletteSize)
|
||||
mapM_ (drawRectangle renderer state colors vp cols rows) [0..cols * rows - 1]
|
||||
where
|
||||
vp = node ^. L.info . L.viewport
|
||||
style = activeStyle wenv node
|
||||
vp = getContentArea style node
|
||||
iw = cfg ^. itemWidth
|
||||
fw = 0.5 + 5 * (state ^. mouseX - vp ^. L.x) / vp ^. L.w
|
||||
fh = 0.5 + 5 * (state ^. mouseY - vp ^. L.y) / vp ^. L.h
|
||||
|
@ -77,7 +77,8 @@ makeCirclesGrid cfg state = widget where
|
||||
|
||||
mapM_ (drawCircle renderer state vp iw cols) [0..cols * rows - 1]
|
||||
where
|
||||
vp = node ^. L.info . L.viewport
|
||||
style = activeStyle wenv node
|
||||
vp = getContentArea style node
|
||||
iw = cfg ^. itemWidth
|
||||
cols = round (vp ^. L.w / iw)
|
||||
rows = round (vp ^. L.h / iw)
|
||||
|
@ -30,65 +30,81 @@ import TickerTypes
|
||||
|
||||
import qualified Monomer.Lens as L
|
||||
|
||||
buildUI
|
||||
:: WidgetEnv TickerModel TickerEvt
|
||||
-> TickerModel
|
||||
-> WidgetNode TickerModel TickerEvt
|
||||
buildUI wenv model = widgetTree where
|
||||
sectionColor = wenv ^. L.theme . L.sectionColor
|
||||
type TickerWenv = WidgetEnv TickerModel TickerEvt
|
||||
type TickerNode = WidgetNode TickerModel TickerEvt
|
||||
|
||||
tickerPct :: Ticker -> TickerNode
|
||||
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 = rgbHex "#428FE0"
|
||||
| pct > 0 = rgbHex "#51A39A"
|
||||
| otherwise = rgbHex "#E25141"
|
||||
|
||||
pctLabel = label pctText `style` [width 100, textRight, textColor pctColor]
|
||||
|
||||
tickerRow :: TickerWenv -> Int -> Ticker -> TickerNode
|
||||
tickerRow wenv idx t = row where
|
||||
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 = pctLabel where
|
||||
diff = toRealFloat $ 100 * (t ^. close - t ^. open)
|
||||
pct = diff / toRealFloat (t ^. open)
|
||||
pctText = formatTickerPct (fromFloatDigits pct) <> "%"
|
||||
pctColor
|
||||
| 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 pair
|
||||
= dropTarget_ (TickerMovePair pair) [dropTargetStyle [bgColor darkGray]]
|
||||
|
||||
tickerInfo = hstack [
|
||||
label (t ^. symbolPair) `style` [width 100],
|
||||
spacer,
|
||||
label (formatTickerValue (t ^. close))
|
||||
`style` [textRight, minWidth 100],
|
||||
spacer,
|
||||
tickerPct t
|
||||
] `style` [cursorHand]
|
||||
|
||||
row = 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
|
||||
] `style` [cursorHand],
|
||||
draggable_ (t ^. symbolPair) [draggableStyle [bgColor dragColor]]
|
||||
tickerInfo,
|
||||
spacer,
|
||||
trashIcon (TickerRemovePairBegin (t ^. symbolPair))
|
||||
] `style` [padding 10, borderB 1 rowSep]
|
||||
`hover` [bgColor rowBg]
|
||||
|
||||
buildUI :: TickerWenv -> TickerModel -> TickerNode
|
||||
buildUI wenv model = widgetTree where
|
||||
sectionBg = wenv ^. L.theme . L.sectionColor
|
||||
|
||||
tickerList = vstack tickerRows where
|
||||
orderedTickers = (\e -> model ^? tickers . ix e) <$> model ^. symbolPairs
|
||||
tickerFade idx t = fadeOut_ [onFinished action] item `key` (t ^. symbolPair) where
|
||||
action = TickerRemovePair (t ^. symbolPair)
|
||||
item = tickerItem idx t
|
||||
item = tickerRow wenv idx t
|
||||
tickerRows = zipWith tickerFade [0..] (catMaybes orderedTickers)
|
||||
|
||||
widgetTree = vstack [
|
||||
hstack [
|
||||
label "New pair: ",
|
||||
label "New pair:",
|
||||
spacer,
|
||||
keystroke [("Enter", TickerAddClick)] $ textField newPair `key` "newPair",
|
||||
spacer,
|
||||
button "Add" TickerAddClick
|
||||
] `style` [padding 20, bgColor sectionColor],
|
||||
scroll_ [scrollOverlay] $ tickerList `style` [padding 20, paddingT 10]
|
||||
] `style` [padding 20, bgColor sectionBg],
|
||||
scroll_ [scrollOverlay] $ tickerList `style` [padding 10]
|
||||
]
|
||||
|
||||
handleEvent
|
||||
:: AppEnv
|
||||
-> WidgetEnv TickerModel TickerEvt
|
||||
-> WidgetNode TickerModel TickerEvt
|
||||
-> TickerWenv
|
||||
-> TickerNode
|
||||
-> TickerModel
|
||||
-> TickerEvt
|
||||
-> [EventResponse TickerModel TickerEvt TickerModel ()]
|
||||
@ -187,7 +203,7 @@ main = do
|
||||
where
|
||||
config = [
|
||||
appWindowTitle "Ticker",
|
||||
appTheme customDarkTheme,
|
||||
appTheme customLightTheme,
|
||||
appFontDef "Regular" "./assets/fonts/Roboto-Regular.ttf",
|
||||
appFontDef "Remix" "./assets/fonts/remixicon.ttf",
|
||||
appInitEvent TickerInit
|
||||
@ -202,8 +218,8 @@ customLightTheme = lightTheme
|
||||
|
||||
customDarkTheme :: Theme
|
||||
customDarkTheme = darkTheme
|
||||
& L.userColorMap . at "rowBg" ?~ rgbHex "#515151"
|
||||
& L.userColorMap . at "trashBg" ?~ rgbHex "#656565"
|
||||
& L.userColorMap . at "rowBg" ?~ rgbHex "#656565"
|
||||
& L.userColorMap . at "trashBg" ?~ rgbHex "#555555"
|
||||
& L.userColorMap . at "trashFg" ?~ rgbHex "#909090"
|
||||
|
||||
formatTickerValue :: Scientific -> Text
|
||||
|
@ -6,15 +6,11 @@
|
||||
|
||||
module TickerTypes where
|
||||
|
||||
import Control.Applicative ((<|>))
|
||||
import Control.Concurrent.STM.TChan
|
||||
import Control.Lens.TH
|
||||
import Data.Aeson
|
||||
import Data.Default
|
||||
import Data.Foldable (asum)
|
||||
import Data.Maybe
|
||||
import Data.Map (Map)
|
||||
import Data.Scientific
|
||||
import Data.Text (Text, pack)
|
||||
|
||||
import qualified Data.Map as M
|
||||
|
@ -17,47 +17,60 @@ import TodoTypes
|
||||
import qualified Monomer.Lens as L
|
||||
import qualified Data.Text as T
|
||||
|
||||
buildUI
|
||||
:: WidgetEnv TodoModel TodoEvt
|
||||
-> TodoModel
|
||||
-> WidgetNode TodoModel TodoEvt
|
||||
buildUI wenv model = widgetTree where
|
||||
sectionBgColor = wenv ^. L.theme . L.sectionColor
|
||||
statusFontColor = wenv ^. L.theme . L.userColorMap . at "statusFont" . non def
|
||||
type TodoWenv = WidgetEnv TodoModel TodoEvt
|
||||
type TodoNode = WidgetNode TodoModel TodoEvt
|
||||
|
||||
todoRowKey :: Todo -> Text
|
||||
todoRowKey todo = "todoRow" <> showt (todo ^. todoId)
|
||||
|
||||
todoRow :: TodoWenv -> TodoModel -> Int -> Todo -> TodoNode
|
||||
todoRow wenv model idx t = slideWidget `key` todoKey where
|
||||
sectionBg = wenv ^. L.theme . L.sectionColor
|
||||
rowButtonColor = wenv ^. L.theme . L.userColorMap . at "rowButton" . non def
|
||||
rowSepColor = gray & L.a .~ 0.5
|
||||
|
||||
todoView idx t = slideWidget `key` todoKey where
|
||||
todoKey = todoRowKey t
|
||||
isLast = idx == length (model ^. todos) - 1
|
||||
todoDone = t ^. status == Done
|
||||
(todoBg, todoFg)
|
||||
| todoDone = (doneBg, doneFg)
|
||||
| otherwise = (pendingBg, pendingFg)
|
||||
todoStatus = labelS (t ^. status)
|
||||
`style` [textFont "Medium", textSize 12, textAscender, textColor todoFg, padding 6, paddingH 8, radius 12, bgColor todoBg]
|
||||
rowButton caption action = button caption action
|
||||
`style` [textFont "Remix", textMiddle, textColor rowButtonColor, bgColor transparent, border 0 transparent]
|
||||
`hover` [bgColor sectionBgColor]
|
||||
todoRow = hstack [
|
||||
vstack [
|
||||
labelS (t ^. todoType) `style` [textSize 12, textColor darkGray],
|
||||
spacer_ [width 5],
|
||||
label (t ^. description) `style` [textThroughline_ todoDone]
|
||||
],
|
||||
filler,
|
||||
box_ [alignRight] todoStatus `style` [width 80],
|
||||
spacer,
|
||||
rowButton remixEdit2Line (TodoEdit idx t),
|
||||
spacer,
|
||||
rowButton remixDeleteBinLine (TodoDeleteBegin idx t)
|
||||
] `style` (paddingV 15 : [borderB 1 rowSepColor | not isLast])
|
||||
slideWidget = fadeOut_ [onFinished (TodoDelete idx t)] todoRow
|
||||
todoKey = todoRowKey t
|
||||
todoDone = t ^. status == Done
|
||||
isLast = idx == length (model ^. todos) - 1
|
||||
|
||||
(todoBg, todoFg)
|
||||
| todoDone = (doneBg, doneFg)
|
||||
| otherwise = (pendingBg, pendingFg)
|
||||
|
||||
todoStatus = labelS (t ^. status)
|
||||
`style` [textFont "Medium", textSize 12, textAscender, textColor todoFg, padding 6, paddingH 8, radius 12, bgColor todoBg]
|
||||
|
||||
rowButton caption action = button caption action
|
||||
`style` [textFont "Remix", textMiddle, textColor rowButtonColor, bgColor transparent, border 0 transparent]
|
||||
`hover` [bgColor sectionBg]
|
||||
|
||||
todoInfo = hstack [
|
||||
vstack [
|
||||
labelS (t ^. todoType) `style` [textSize 12, textColor darkGray],
|
||||
spacer_ [width 5],
|
||||
label (t ^. description) `style` [textThroughline_ todoDone]
|
||||
],
|
||||
filler,
|
||||
box_ [alignRight] todoStatus `style` [width 80],
|
||||
spacer,
|
||||
rowButton remixEdit2Line (TodoEdit idx t),
|
||||
spacer,
|
||||
rowButton remixDeleteBinLine (TodoDeleteBegin idx t)
|
||||
] `style` (paddingV 15 : [borderB 1 rowSepColor | not isLast])
|
||||
|
||||
slideWidget = fadeOut_ [onFinished (TodoDelete idx t)] todoInfo
|
||||
|
||||
|
||||
todoEdit :: TodoWenv -> TodoModel -> TodoNode
|
||||
todoEdit wenv model = editNode where
|
||||
sectionBg = wenv ^. L.theme . L.sectionColor
|
||||
|
||||
saveTodoBtn = case model ^. action of
|
||||
TodoAdding -> mainButton "Add" TodoAdd
|
||||
TodoEditing idx -> mainButton "Save" (TodoSave idx)
|
||||
_ -> spacer
|
||||
todoEdit = vstack [
|
||||
|
||||
editNode = vstack [
|
||||
hstack [
|
||||
label "Task:",
|
||||
spacer,
|
||||
@ -84,30 +97,35 @@ buildUI wenv model = widgetTree where
|
||||
spacer,
|
||||
button "Cancel" TodoCancel
|
||||
]
|
||||
] `style` [bgColor sectionBgColor, padding 20]
|
||||
] `style` [bgColor sectionBg, padding 20]
|
||||
|
||||
buildUI :: TodoWenv -> TodoModel -> TodoNode
|
||||
buildUI wenv model = widgetTree where
|
||||
sectionBg = wenv ^. L.theme . L.sectionColor
|
||||
isEditing = model ^. action /= TodoNone
|
||||
|
||||
countLabel = label caption `style` styles where
|
||||
caption = "Tasks (" <> showt (length $ model ^. todos) <> ")"
|
||||
styles = [textFont "Regular", textSize 16, padding 20, bgColor sectionBgColor]
|
||||
todoList = vstack (zipWith todoView [0..] (model ^. todos))
|
||||
isEditing = model ^. action /= TodoNone
|
||||
styles = [textFont "Regular", textSize 16, padding 20, bgColor sectionBg]
|
||||
|
||||
todoList = vstack (zipWith (todoRow wenv model) [0..] (model ^. todos))
|
||||
|
||||
newButton = mainButton "New" TodoNew `key` "todoNew"
|
||||
`visible` not isEditing
|
||||
|
||||
widgetTree = vstack [
|
||||
keystroke [("Esc", TodoCancel)] todoEdit
|
||||
keystroke [("Esc", TodoCancel)] (todoEdit wenv model)
|
||||
`visible` isEditing,
|
||||
countLabel,
|
||||
scroll_ [] (todoList `style` [padding 20, paddingT 5]),
|
||||
filler,
|
||||
box_ [alignRight] newButton
|
||||
`style` [bgColor sectionBgColor, padding 20]
|
||||
`style` [bgColor sectionBg, padding 20]
|
||||
]
|
||||
|
||||
todoRowKey :: Todo -> Text
|
||||
todoRowKey todo = "todoRow" <> showt (todo ^. todoId)
|
||||
|
||||
handleEvent
|
||||
:: WidgetEnv TodoModel TodoEvt
|
||||
-> WidgetNode TodoModel TodoEvt
|
||||
:: TodoWenv
|
||||
-> TodoNode
|
||||
-> TodoModel
|
||||
-> TodoEvt
|
||||
-> [EventResponse TodoModel TodoEvt TodoModel ()]
|
||||
@ -169,7 +187,7 @@ main = do
|
||||
where
|
||||
config = [
|
||||
appWindowTitle "Todo list",
|
||||
appTheme customDarkTheme,
|
||||
appTheme customLightTheme,
|
||||
appFontDef "Regular" "./assets/fonts/Roboto-Regular.ttf",
|
||||
appFontDef "Medium" "./assets/fonts/Roboto-Medium.ttf",
|
||||
appFontDef "Bold" "./assets/fonts/Roboto-Bold.ttf",
|
||||
@ -187,12 +205,12 @@ grayDarker = rgbHex "#2E2E2E"
|
||||
|
||||
customLightTheme :: Theme
|
||||
customLightTheme = lightTheme
|
||||
& L.userColorMap . at "statusFont" ?~ grayDarker
|
||||
-- & L.userColorMap . at "statusFont" ?~ grayDarker
|
||||
& L.userColorMap . at "rowButton" ?~ grayLight
|
||||
|
||||
customDarkTheme :: Theme
|
||||
customDarkTheme = darkTheme
|
||||
& L.userColorMap . at "statusFont" ?~ grayDarker
|
||||
-- & L.userColorMap . at "statusFont" ?~ grayDarker
|
||||
& L.userColorMap . at "rowButton" ?~ gray
|
||||
|
||||
remove :: Int -> [a] -> [a]
|
||||
|
@ -212,8 +212,8 @@ baseBasic themeMod = def
|
||||
& L.dialStyle . L.fgColor ?~ inputFgBasic themeMod
|
||||
& L.dialStyle . L.sndColor ?~ inputSndBasic themeMod
|
||||
& L.dialogTitleStyle . L.text ?~ (titleFont & L.fontColor ?~ dialogTitleText themeMod)
|
||||
& L.dialogTitleStyle . L.padding ?~ padding 10 <> paddingB 10
|
||||
& L.dialogFrameStyle . L.padding ?~ padding 10
|
||||
& L.dialogTitleStyle . L.padding ?~ padding 10
|
||||
& L.dialogFrameStyle . L.padding ?~ padding 5
|
||||
& L.dialogFrameStyle . L.radius ?~ radius 10
|
||||
& L.dialogFrameStyle . L.bgColor ?~ dialogBg themeMod
|
||||
& L.dialogFrameStyle . L.border ?~ border 1 (dialogBorder themeMod)
|
||||
@ -223,8 +223,8 @@ baseBasic themeMod = def
|
||||
& L.dialogCloseIconStyle . L.radius ?~ radius 8
|
||||
& L.dialogCloseIconStyle . L.sizeReqW ?~ width 16
|
||||
& L.dialogCloseIconStyle . L.sizeReqH ?~ width 16
|
||||
& L.dialogButtonsStyle . L.padding ?~ padding 10
|
||||
& L.dialogMsgBodyStyle . L.padding ?~ paddingH 10
|
||||
& L.dialogButtonsStyle . L.padding ?~ padding 20 <> paddingT 10
|
||||
& L.dialogMsgBodyStyle . L.padding ?~ padding 20
|
||||
& L.dialogMsgBodyStyle . L.text
|
||||
?~ (normalFont & L.fontColor ?~ dialogText themeMod)
|
||||
& L.dialogMsgBodyStyle . L.sizeReqW ?~ maxWidth 600
|
||||
|
@ -46,7 +46,7 @@ lightThemeColors = BaseThemeColors {
|
||||
btnMainBgDisabled = blue04,
|
||||
btnMainText = white,
|
||||
btnMainTextDisabled = white,
|
||||
dialogBg = gray09,
|
||||
dialogBg = white,
|
||||
dialogBorder = white,
|
||||
dialogText = black,
|
||||
dialogTitleText = black,
|
||||
@ -56,7 +56,7 @@ lightThemeColors = BaseThemeColors {
|
||||
externalLinkFocus = blue07,
|
||||
externalLinkActive = blue06,
|
||||
externalLinkDisabled = gray06,
|
||||
iconBg = gray08,
|
||||
iconBg = gray07,
|
||||
iconFg = gray01,
|
||||
inputIconFg = black,
|
||||
inputBorder = gray06,
|
||||
@ -109,8 +109,8 @@ darkTheme = baseTheme darkThemeColors
|
||||
|
||||
darkThemeColors :: BaseThemeColors
|
||||
darkThemeColors = BaseThemeColors {
|
||||
clearColor = gray02,
|
||||
sectionColor = gray03,
|
||||
clearColor = gray03,
|
||||
sectionColor = gray02,
|
||||
btnFocusBorder = blue09,
|
||||
btnBgBasic = gray07,
|
||||
btnBgHover = gray09,
|
||||
|
@ -95,7 +95,7 @@ import qualified Monomer.Core.Lens as L
|
||||
-- | Type of the parent's model
|
||||
type ParentModel sp = Typeable sp
|
||||
-- | Type of the composite's model
|
||||
type CompositeModel s = (Eq s, Typeable s, WidgetModel s)
|
||||
type CompositeModel s = (Eq s, WidgetModel s)
|
||||
-- | Type of the composite's event
|
||||
type CompositeEvent e = WidgetEvent e
|
||||
|
||||
@ -115,7 +115,7 @@ type TaskHandler e = IO e
|
||||
type ProducerHandler e = (e -> IO ()) -> IO ()
|
||||
|
||||
data CompMsgUpdate
|
||||
= forall s . Typeable s => CompMsgUpdate (s -> s)
|
||||
= forall s . CompositeModel s => CompMsgUpdate (s -> s)
|
||||
|
||||
-- | Response options for an event handler.
|
||||
data EventResponse s e sp ep
|
||||
@ -736,7 +736,7 @@ toParentResult comp state wenv widgetComp result = newResult where
|
||||
newResult = WidgetResult newNode newReqs
|
||||
|
||||
evtResponseToRequest
|
||||
:: (Typeable s, Typeable sp, WidgetEvent e, WidgetEvent ep)
|
||||
:: (CompositeModel s, CompositeEvent e, CompositeEvent ep, ParentModel sp)
|
||||
=> WidgetNode sp ep
|
||||
-> WidgetKeyMap s e
|
||||
-> EventResponse s e sp ep
|
||||
@ -790,7 +790,7 @@ getModel
|
||||
getModel comp wenv = widgetDataGet (_weModel wenv) (_cmpWidgetData comp)
|
||||
|
||||
toParentReq
|
||||
:: (Typeable s, Typeable sp)
|
||||
:: (CompositeModel s, ParentModel sp)
|
||||
=> WidgetId
|
||||
-> WidgetRequest s e
|
||||
-> Maybe (WidgetRequest sp ep)
|
||||
|
5
tasks.md
5
tasks.md
@ -779,13 +779,16 @@
|
||||
- Simple click receives focus, shift+click allows changing values without getting focus
|
||||
- Avoid building examples when used as a library.
|
||||
- Tried using flags and it works, but it ends up being annoying for testing examples with stack run.
|
||||
- Add hsl function https://stackoverflow.com/questions/2353211/hsl-to-rgb-color-conversion
|
||||
|
||||
Next
|
||||
- Document themes and how widgets use them.
|
||||
- Add ignoreStyle to widgets that may need it.
|
||||
- Maybe spacer should be 8 pixels wide.
|
||||
- Rethink activeStyle, activeTheme, active style related function names.
|
||||
- Add hsl function https://stackoverflow.com/questions/2353211/hsl-to-rgb-color-conversion
|
||||
- Order of arguments?
|
||||
- CmbMergeRequired in box?
|
||||
- Generalize fade/slide messages. Add anim suffix.
|
||||
- Remove dpr calculations from NanoVGRenderer.
|
||||
- Same with FontManager.
|
||||
- When testing Windows/Linux, check if scroll rate needs to be adjusted.
|
||||
|
Loading…
Reference in New Issue
Block a user