diff --git a/app/Main.hs b/app/Main.hs index e9ac2603..abb5678d 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -132,7 +132,7 @@ handleAppEvent wenv node model evt = case evt of _ -> [] buildUI :: WidgetEnv App AppEvent -> App -> WidgetNode App AppEvent -buildUI wenv model = traceShow "Creating UI" widgetDial where +buildUI wenv model = traceShow "Creating UI" widgetTree where widgetScroll = vscroll (hgrid [ vstack [ scroll (image "assets/images/pecans.jpg") `style` [height 200], @@ -381,8 +381,8 @@ buildUI wenv model = traceShow "Creating UI" widgetDial where longMessage word = "Are you sure?\n\n\n\n" <> T.replicate 100 (word <> " ") widgetTree = zstack [ widgetTreeFull, - alert_ (longMessage "Alert") CloseAlert [titleCaption "Hey!"] `visible` model ^. showAlert, - confirm_ (longMessage "Confirm") AcceptConfirm CancelConfirm [titleCaption "Hey!"] `visible` model ^. showConfirm + alertMsg_ (longMessage "Alert") CloseAlert [titleCaption "Hey!"] `visible` model ^. showAlert, + confirmMsg_ (longMessage "Confirm") AcceptConfirm CancelConfirm [titleCaption "Hey!"] `visible` model ^. showConfirm ] widgetTreeFull = vstack [ hstack [ diff --git a/examples/books/Main.hs b/examples/books/Main.hs index bdf42f5d..d6064c74 100644 --- a/examples/books/Main.hs +++ b/examples/books/Main.hs @@ -26,7 +26,10 @@ buildUI wenv model = widgetTree where baseUrl = "http://covers.openlibrary.org/b/id/-.jpg" imgUrl i = T.replace "" size $ T.replace "" (showt i) baseUrl coverImg i = image_ (imgUrl i) [fitHeight] - bookRow b = box_ [expandContent, onClick (BooksShowDetails b)] $ hstack [ + bookRow b = box_ [expandContent, onClick (BooksShowDetails b)] + (bookRowContent b) + `hover` [bgColor gray, cursorIcon CursorHand] + bookRowContent b = hstack [ vstack [ hstack [ label_ "Title: " [resizeFactor 0] `style` [textFont "Bold"], @@ -34,7 +37,7 @@ buildUI wenv model = widgetTree where ], hstack [ label_ "Authors: " [resizeFactor 0] `style` [textFont "Bold"], - label (T.intercalate ", " (b ^. authors)) + label_ (T.intercalate ", " (b ^. authors)) [resizeFactor 1] ] ], filler, @@ -45,35 +48,29 @@ buildUI wenv model = widgetTree where ] ] `style` [width 100], bookImage (b ^. cover) "S" `style` [width 50] - ] `style` [height 50, padding 5] `hover` [bgColor gray, cursorIcon CursorHand] + ] `style` [height 50, padding 5] bookDetail b = hstack [ vstack [ hstack [ - label_ "Title: " [resizeFactor 0] `style` [textFont "Bold"], - label (b ^. title) + label_ "Title: " [resizeFactor 0] `style` [textFont "Bold", textTop], + label_ (b ^. title) [textMultiLine] `style` [width 300] ], hstack [ - label_ "Authors: " [resizeFactor 0] `style` [textFont "Bold"], - label (T.intercalate ", " (b ^. authors)) + label_ "Authors: " [resizeFactor 0] `style` [textFont "Bold", textTop], + label_ (T.intercalate ", " (b ^. authors)) [textMultiLine] `style` [width 300] ], hstack [ label_ "Year: " [resizeFactor 0] `style` [textFont "Bold"], label $ maybe "" showt (b ^. year) ] - ] `style` [width 300], + ], filler, bookImage (b ^. cover) "M" `style` [width 200] ] - bookOverlay = keystroke [("Esc", BooksCloseDetails)] overlay where - content = vstack [ - maybe spacer bookDetail (model ^. selected), - spacer, - hstack [button "Close" BooksCloseDetails, filler] - ] `style` [bgColor gray, border 2 dimGray, padding 5] - overlay = box_ [onClick BooksCloseDetails] content - `style` [bgColor (darkGray & L.a .~ 0.8)] - searchOverlay = box (label "Searching" `style` [textSize 20, textColor black]) - `style` [bgColor (darkGray & L.a .~ 0.8)] + bookOverlay = alert content BooksCloseDetails 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: ", diff --git a/src/Monomer/Core/ThemeTypes.hs b/src/Monomer/Core/ThemeTypes.hs index afefc1c3..5d433e15 100644 --- a/src/Monomer/Core/ThemeTypes.hs +++ b/src/Monomer/Core/ThemeTypes.hs @@ -49,8 +49,8 @@ data ThemeState = ThemeState { _thsDialogFrameStyle :: StyleState, _thsDialogTitleStyle :: StyleState, _thsDialogCloseIconStyle :: StyleState, - _thsDialogBodyStyle :: StyleState, _thsDialogButtonsStyle :: StyleState, + _thsDialogMsgBodyStyle :: StyleState, _thsDropdownMaxHeight :: Double, _thsDropdownStyle :: StyleState, _thsDropdownListStyle :: StyleState, @@ -91,8 +91,8 @@ instance Default ThemeState where _thsDialogFrameStyle = def, _thsDialogTitleStyle = def, _thsDialogCloseIconStyle = def, - _thsDialogBodyStyle = def, _thsDialogButtonsStyle = def, + _thsDialogMsgBodyStyle = def, _thsDropdownMaxHeight = def, _thsDropdownStyle = def, _thsDropdownListStyle = def, @@ -133,7 +133,7 @@ instance Semigroup ThemeState where _thsDialogFrameStyle = _thsDialogFrameStyle t1 <> _thsDialogFrameStyle t2, _thsDialogTitleStyle = _thsDialogTitleStyle t1 <> _thsDialogTitleStyle t2, _thsDialogCloseIconStyle = _thsDialogCloseIconStyle t1 <> _thsDialogCloseIconStyle t2, - _thsDialogBodyStyle = _thsDialogBodyStyle t1 <> _thsDialogBodyStyle t2, + _thsDialogMsgBodyStyle = _thsDialogMsgBodyStyle t1 <> _thsDialogMsgBodyStyle t2, _thsDialogButtonsStyle = _thsDialogButtonsStyle t1 <> _thsDialogButtonsStyle t2, _thsDropdownMaxHeight = _thsDropdownMaxHeight t2, _thsDropdownStyle = _thsDropdownStyle t1 <> _thsDropdownStyle t2, diff --git a/src/Monomer/Core/Themes/BaseTheme.hs b/src/Monomer/Core/Themes/BaseTheme.hs index a83ec500..9202b00f 100644 --- a/src/Monomer/Core/Themes/BaseTheme.hs +++ b/src/Monomer/Core/Themes/BaseTheme.hs @@ -165,11 +165,11 @@ baseBasic themeMod = def & L.dialogCloseIconStyle . L.fgColor ?~ iconFg themeMod & L.dialogCloseIconStyle . L.sizeReqW ?~ width 16 & L.dialogCloseIconStyle . L.sizeReqH ?~ width 16 - & L.dialogBodyStyle . L.text - ?~ (normalFont & L.fontColor ?~ dialogText themeMod) - & L.dialogBodyStyle . L.sizeReqW ?~ minWidth 400 - & L.dialogBodyStyle . L.sizeReqH ?~ minHeight 250 & L.dialogButtonsStyle . L.padding ?~ paddingT 5 + & L.dialogMsgBodyStyle . L.text + ?~ (normalFont & L.fontColor ?~ dialogText themeMod) + & L.dialogMsgBodyStyle . L.sizeReqW ?~ minWidth 400 + & L.dialogMsgBodyStyle . L.sizeReqH ?~ minHeight 250 & L.dropdownStyle .~ inputStyle themeMod & L.dropdownStyle . L.fgColor ?~ iconFg themeMod & L.dropdownStyle . L.padding ?~ paddingH 5 diff --git a/src/Monomer/Widgets/Alert.hs b/src/Monomer/Widgets/Alert.hs index f92e2856..14a3095d 100644 --- a/src/Monomer/Widgets/Alert.hs +++ b/src/Monomer/Widgets/Alert.hs @@ -1,6 +1,8 @@ module Monomer.Widgets.Alert ( alert, - alert_ + alert_, + alertMsg, + alertMsg_ ) where import Control.Applicative ((<|>)) @@ -53,31 +55,51 @@ instance CmbCloseCaption AlertCfg where } alert + :: (WidgetModel sp, WidgetEvent ep) + => WidgetNode () ep + -> ep + -> WidgetNode sp ep +alert dialogBody evt = alert_ dialogBody evt def + +alert_ + :: (WidgetModel sp, WidgetEvent ep) + => WidgetNode () ep + -> ep + -> [AlertCfg] + -> WidgetNode sp ep +alert_ dialogBody evt configs = newNode where + config = mconcat configs + createUI = buildUI (const dialogBody) evt config + newNode = compositeExt "alert" () createUI handleEvent + +alertMsg :: (WidgetModel sp, WidgetEvent ep) => Text -> ep -> WidgetNode sp ep -alert message evt = alert_ message evt def +alertMsg message evt = alertMsg_ message evt def -alert_ +alertMsg_ :: (WidgetModel sp, WidgetEvent ep) => Text -> ep -> [AlertCfg] -> WidgetNode sp ep -alert_ message evt configs = newNode where +alertMsg_ message evt configs = newNode where config = mconcat configs - createUI = buildUI message evt config + dialogBody wenv = label_ message [textMultiLine] + & L.info . L.style .~ themeDialogMsgBody wenv + createUI = buildUI dialogBody evt config newNode = compositeExt "alert" () createUI handleEvent buildUI - :: Text + :: (WidgetEnv s ep -> WidgetNode s ep) -> ep -> AlertCfg -> WidgetEnv s ep -> s -> WidgetNode s ep -buildUI message cancelEvt config wenv model = mainTree where +buildUI dialogBody cancelEvt config wenv model = mainTree where title = fromMaybe "" (_alcTitle config) close = fromMaybe "Close" (_alcClose config) emptyOverlayColor = themeEmptyOverlayColor wenv @@ -88,8 +110,7 @@ buildUI message cancelEvt config wenv model = mainTree where label title & L.info . L.style .~ themeDialogTitle wenv, box_ [onClick cancelEvt] closeIcon ], - label_ message [textMultiLine] - & L.info . L.style .~ themeDialogBody wenv, + dialogBody wenv, box_ [alignLeft] dismissButton & L.info . L.style .~ themeDialogButtons wenv ] & L.info . L.style .~ themeDialogFrame wenv diff --git a/src/Monomer/Widgets/Box.hs b/src/Monomer/Widgets/Box.hs index df323afa..3ca9ba82 100644 --- a/src/Monomer/Widgets/Box.hs +++ b/src/Monomer/Widgets/Box.hs @@ -147,9 +147,8 @@ makeBox config = widget where + length (_boxOnClickEmptyReq config) getActiveStyle = activeStyle_ activeStyleConfig where - activeStyleConfig = def { - _ascIsActive = isNodeTreeActive - } + activeStyleConfig = def + & L.isActive .~ isNodeTreeActive handleEvent wenv target evt node = case evt of Click point btn -> result where diff --git a/src/Monomer/Widgets/Confirm.hs b/src/Monomer/Widgets/Confirm.hs index 9c0fce3a..731f9ead 100644 --- a/src/Monomer/Widgets/Confirm.hs +++ b/src/Monomer/Widgets/Confirm.hs @@ -1,8 +1,11 @@ {-# LANGUAGE RankNTypes #-} module Monomer.Widgets.Confirm ( + ConfirmEvt(..), confirm, - confirm_ + confirm_, + confirmMsg, + confirmMsg_ ) where import Control.Applicative ((<|>)) @@ -64,42 +67,66 @@ instance CmbCancelCaption ConfirmCfg where } data ConfirmEvt e - = ParentEvt e - | VisibleChanged + = ConfirmParentEvt e + | ConfirmVisibleChanged deriving (Eq, Show) confirm + :: (WidgetModel sp, WidgetEvent ep) + => WidgetNode () (ConfirmEvt ep) + -> ep + -> ep + -> WidgetNode sp ep +confirm dialogBody acceptEvt cancelEvt = newNode where + newNode = confirm_ dialogBody acceptEvt cancelEvt def + +confirm_ + :: (WidgetModel sp, WidgetEvent ep) + => WidgetNode () (ConfirmEvt ep) + -> ep + -> ep + -> [ConfirmCfg] + -> WidgetNode sp ep +confirm_ dialogBody acceptEvt cancelEvt configs = newNode where + config = mconcat configs + createUI = buildUI (const dialogBody) acceptEvt cancelEvt config + evts = [onVisibleChange ConfirmVisibleChanged] + newNode = compositeExt_ "confirm" () createUI handleEvent evts + +confirmMsg :: (WidgetModel sp, WidgetEvent ep) => Text -> ep -> ep -> WidgetNode sp ep -confirm message acceptEvt cancelEvt = confirm_ message acceptEvt cancelEvt def +confirmMsg msg acceptEvt cancelEvt = confirmMsg_ msg acceptEvt cancelEvt def -confirm_ +confirmMsg_ :: (WidgetModel sp, WidgetEvent ep) => Text -> ep -> ep -> [ConfirmCfg] -> WidgetNode sp ep -confirm_ message acceptEvt cancelEvt configs = newNode where +confirmMsg_ message acceptEvt cancelEvt configs = newNode where config = mconcat configs - createUI = buildUI message acceptEvt cancelEvt config - evts = [onVisibleChange VisibleChanged] + dialogBody wenv = label_ message [textMultiLine] + & L.info . L.style .~ themeDialogMsgBody wenv + createUI = buildUI dialogBody acceptEvt cancelEvt config + evts = [onVisibleChange ConfirmVisibleChanged] newNode = compositeExt_ "confirm" () createUI handleEvent evts buildUI - :: Text + :: (WidgetEnv s (ConfirmEvt ep) -> WidgetNode s (ConfirmEvt ep)) -> ep -> ep -> ConfirmCfg -> WidgetEnv s (ConfirmEvt ep) -> s -> WidgetNode s (ConfirmEvt ep) -buildUI message pAcceptEvt pCancelEvt config wenv model = mainTree where - acceptEvt = ParentEvt pAcceptEvt - cancelEvt = ParentEvt pCancelEvt +buildUI dialogBody pAcceptEvt pCancelEvt config wenv model = mainTree where + acceptEvt = ConfirmParentEvt pAcceptEvt + cancelEvt = ConfirmParentEvt pCancelEvt title = fromMaybe "" (_cfcTitle config) accept = fromMaybe "Accept" (_cfcAccept config) cancel = fromMaybe "Cancel" (_cfcCancel config) @@ -113,8 +140,7 @@ buildUI message pAcceptEvt pCancelEvt config wenv model = mainTree where label title & L.info . L.style .~ themeDialogTitle wenv, box_ [onClick cancelEvt] closeIcon ], - label_ message [textMultiLine] - & L.info . L.style .~ themeDialogBody wenv, + dialogBody wenv, box_ [alignLeft] buttons & L.info . L.style <>~ themeDialogButtons wenv ] & L.info . L.style .~ themeDialogFrame wenv @@ -129,8 +155,8 @@ handleEvent -> ConfirmEvt ep -> [EventResponse s (ConfirmEvt ep) ep] handleEvent wenv node model evt = case evt of - ParentEvt pevt -> [Report pevt] - VisibleChanged -> catMaybes [acceptPath | nodeVisible] + ConfirmParentEvt pevt -> [Report pevt] + ConfirmVisibleChanged -> catMaybes [acceptPath | nodeVisible] where acceptPath = Request . SetFocus <$> globalKeyPath wenv "acceptBtn" ownsFocus = isNodeParentOfFocused wenv node diff --git a/src/Monomer/Widgets/Stack.hs b/src/Monomer/Widgets/Stack.hs index fd34317a..7b6055ec 100644 --- a/src/Monomer/Widgets/Stack.hs +++ b/src/Monomer/Widgets/Stack.hs @@ -157,6 +157,7 @@ resizeChild horizontal contentArea flexCoeff extraCoeff offset child = result wh | horizontal = hRect | otherwise = vRect +mainReqSelector :: Bool -> WidgetNode s e -> SizeReq mainReqSelector isHorizontal | isHorizontal = _wniSizeReqW . _wnInfo | otherwise = _wniSizeReqH . _wnInfo diff --git a/src/Monomer/Widgets/Util/Theme.hs b/src/Monomer/Widgets/Util/Theme.hs index 44106ed6..7dabcb14 100644 --- a/src/Monomer/Widgets/Util/Theme.hs +++ b/src/Monomer/Widgets/Util/Theme.hs @@ -31,8 +31,8 @@ themeDialogTitle wenv = collectTheme wenv L.dialogTitleStyle themeDialogCloseIcon :: WidgetEnv s e -> Style themeDialogCloseIcon wenv = collectTheme wenv L.dialogCloseIconStyle -themeDialogBody :: WidgetEnv s e -> Style -themeDialogBody wenv = collectTheme wenv L.dialogBodyStyle +themeDialogMsgBody :: WidgetEnv s e -> Style +themeDialogMsgBody wenv = collectTheme wenv L.dialogMsgBodyStyle themeDialogButtons :: WidgetEnv s e -> Style themeDialogButtons wenv = collectTheme wenv L.dialogButtonsStyle diff --git a/tasks.md b/tasks.md index 4aefedab..f516c09d 100644 --- a/tasks.md +++ b/tasks.md @@ -513,6 +513,7 @@ - Check why border was not shown in some cases (may be ok) - Improve cursor handling (if children do not have cursor settings they should not change it) - Re-import Color Table and keep it in original order + - Maybe internally handle focus as widgetId? (use findWidgetByPath) - Pending - Add header in all files, indicating license and documenting what the module does @@ -525,12 +526,15 @@ Next - Add examples - Fetch content from url, show rows of data with embedded images - Does it make sense to have Alert/Dialog accept a widget? - - Maybe internally handle focus as widgetId? (use findWidgetByPath) + - Think about using stack resize logic in box + - Maybe whats needed are custom min/max options for box content - Add cursor icon unit tests - Composite example - Validate nested structures update correctly when disabling/enabling parent - Something of generative art (OpenGL example) - Auto scroll affects dropdown when listView is displayed + - Maybe label resizeFactor should default to zero? What about button/others? + - Maybe do not resize Single if size did not change? First step towards resize improvements - Add underline and strikethrough - Add externalLink component - https://stackoverflow.com/questions/3037088/how-to-open-the-default-web-browser-in-windows-in-c/54334181 diff --git a/test/unit/Monomer/Widgets/AlertSpec.hs b/test/unit/Monomer/Widgets/AlertSpec.hs index 5719e70d..3818e70d 100644 --- a/test/unit/Monomer/Widgets/AlertSpec.hs +++ b/test/unit/Monomer/Widgets/AlertSpec.hs @@ -35,5 +35,5 @@ handleEvent = describe "handleEvent" $ do where wenv = mockWenv () & L.theme .~ darkTheme - alertNode = alert "Alert!" CloseClick + alertNode = alertMsg "Alert!" CloseClick events p = nodeHandleEventEvts wenv [Click p LeftBtn] alertNode diff --git a/test/unit/Monomer/Widgets/ConfirmSpec.hs b/test/unit/Monomer/Widgets/ConfirmSpec.hs index 10fbe037..efb63ee6 100644 --- a/test/unit/Monomer/Widgets/ConfirmSpec.hs +++ b/test/unit/Monomer/Widgets/ConfirmSpec.hs @@ -39,5 +39,5 @@ handleEvent = describe "handleEvent" $ do where wenv = mockWenv () & L.theme .~ darkTheme - confirmNode = confirm "Confirm!" AcceptClick CancelClick + confirmNode = confirmMsg "Confirm!" AcceptClick CancelClick events p = nodeHandleEventEvts wenv [Click p LeftBtn] confirmNode diff --git a/test/unit/Monomer/Widgets/ZStackSpec.hs b/test/unit/Monomer/Widgets/ZStackSpec.hs index 7ef1e945..57e24125 100644 --- a/test/unit/Monomer/Widgets/ZStackSpec.hs +++ b/test/unit/Monomer/Widgets/ZStackSpec.hs @@ -164,7 +164,7 @@ handleEventFocusKeep = describe "handleEventFocusKeep" $ handleEvent wenv _ model (BtnClick idx) = [Report (BtnClick idx), Model idx] buildUI wenv model = zstack [ hstack [ - confirm "Message" (BtnClick 3) (BtnClick 4) + confirmMsg "Message" (BtnClick 3) (BtnClick 4) ] `visible` (model <= 2), hstack [ button "1" (BtnClick 1),