From 0d164b9d08cecc2a370bc6eadc2bc51d94439aa2 Mon Sep 17 00:00:00 2001 From: Francisco Vallarino Date: Tue, 9 Feb 2021 22:52:01 -0300 Subject: [PATCH] Use user provided sizeReq if available. Several minor code improvements --- src/Monomer/Widgets/Composite.hs | 5 +++- src/Monomer/Widgets/Container.hs | 34 +++++++------------------- src/Monomer/Widgets/ListView.hs | 5 ++-- src/Monomer/Widgets/Single.hs | 31 +++++++++++++----------- src/Monomer/Widgets/Util/Widget.hs | 38 +++++++++++++++++++++++++----- src/Monomer/Widgets/ZStack.hs | 4 ++-- tasks.md | 14 ++++++----- 7 files changed, 74 insertions(+), 57 deletions(-) diff --git a/src/Monomer/Widgets/Composite.hs b/src/Monomer/Widgets/Composite.hs index c42f8f1b..11d483a6 100644 --- a/src/Monomer/Widgets/Composite.hs +++ b/src/Monomer/Widgets/Composite.hs @@ -588,7 +588,10 @@ updateSizeReq state wenv widgetComp = newComp where widget = _cpsRoot ^. L.widget currReqW = _cpsRoot ^. L.info . L.sizeReqW currReqH = _cpsRoot ^. L.info . L.sizeReqH - (newReqW, newReqH) = sizeReqAddStyle style (currReqW, currReqH) + (tmpReqW, tmpReqH) = sizeReqAddStyle style (currReqW, currReqH) + -- User settings take precedence + newReqW = fromMaybe tmpReqW (style ^. L.sizeReqW) + newReqH = fromMaybe tmpReqH (style ^. L.sizeReqH) newComp = widgetComp & L.info . L.sizeReqW .~ newReqW & L.info . L.sizeReqH .~ newReqH diff --git a/src/Monomer/Widgets/Container.hs b/src/Monomer/Widgets/Container.hs index ec687f6d..fba82090 100644 --- a/src/Monomer/Widgets/Container.hs +++ b/src/Monomer/Widgets/Container.hs @@ -127,12 +127,6 @@ type ContainerFindByPointHandler s e -> WidgetNode s e -> Maybe Int -type ContainerUpdateEventHandler s e - = WidgetEnv s e - -> SystemEvent - -> WidgetNode s e - -> SystemEvent - type ContainerEventHandler s e = WidgetEnv s e -> Path @@ -324,17 +318,7 @@ initWrapper container wenv node = result where & L.children .~ newChildren result = WidgetResult newNode (reqs <> newReqs) (events <> newEvents) -defaultGetState - :: WidgetModel a - => a - -> WidgetEnv s e - -> Maybe WidgetState -defaultGetState state wenv = Just (WidgetState state) - -- | Merging -defaultMerge :: ContainerMergeHandler s e a -defaultMerge wenv oldState oldNode newNode = resultWidget newNode - defaultMergeRequired :: ContainerMergeChildrenReqHandler s e a defaultMergeRequired wenv oldState oldNode newNode = True @@ -357,19 +341,16 @@ mergeWrapper container wenv oldNode newNode = newResult where Just handler -> handler Nothing -> mergeWithRestore (containerRestore container) mergePostHandler = containerMergePost container - mergeRequired = case useState oldState of Just state -> mergeRequiredHandler wenv state oldNode newNode Nothing -> True - oldFlags = [oldNode ^. L.info . L.visible, oldNode ^. L.info . L.enabled] - newFlags = [newNode ^. L.info . L.visible, newNode ^. L.info . L.enabled] oldState = widgetGetState (oldNode ^. L.widget) wenv styledNode = initNodeStyle getBaseStyle wenv newNode pResult = mergeParent mergeHandler wenv oldState oldNode styledNode cResult = mergeChildren cWenvHelper wenv oldNode newNode pResult vResult = mergeChildrenCheckVisible oldNode cResult mResult - | mergeRequired || oldFlags /= newFlags = vResult + | mergeRequired || nodeFlagsChanged oldNode newNode = vResult | otherwise = pResult & L.node . L.children .~ oldNode ^. L.children postRes = case useState oldState of Just state -> mergePostHandler wenv mResult state oldNode (mResult^.L.node) @@ -471,7 +452,7 @@ mergeChildrenCheckVisible -> WidgetResult s e mergeChildrenCheckVisible oldNode result = newResult where newNode = result ^. L.node - resizeRequired = visibleChildrenChanged oldNode newNode + resizeRequired = childrenVisibleChanged oldNode newNode newResult | resizeRequired = result & L.requests %~ (|> ResizeWidgets) | otherwise = result @@ -803,9 +784,12 @@ updateSizeReq container wenv node = newNode where reqs = case useState currState of Just state -> handler wenv state node children _ -> def - (newReqW, newReqH) + (tmpReqW, tmpReqH) | addStyleReq = sizeReqAddStyle style reqs | otherwise = reqs + -- User settings take precedence + newReqW = fromMaybe tmpReqW (style ^. L.sizeReqW) + newReqH = fromMaybe tmpReqH (style ^. L.sizeReqH) newNode = node & L.info . L.sizeReqW .~ newReqW & L.info . L.sizeReqH .~ newReqH @@ -820,12 +804,12 @@ handleSizeReqChange -> Maybe (WidgetResult s e) handleSizeReqChange container wenv node evt mResult = result where baseResult = fromMaybe (resultWidget node) mResult - newNode = baseResult ^. L.node + baseNode = baseResult ^. L.node resizeReq = isResizeResult mResult - styleChanged = isJust evt && styleStateChanged wenv newNode (fromJust evt) + styleChanged = isJust evt && styleStateChanged wenv baseNode (fromJust evt) result | styleChanged || resizeReq = Just $ baseResult - & L.node .~ updateSizeReq container wenv newNode + & L.node .~ updateSizeReq container wenv baseNode | otherwise = mResult -- | Resize diff --git a/src/Monomer/Widgets/ListView.hs b/src/Monomer/Widgets/ListView.hs index ab1dc96a..26410e0d 100644 --- a/src/Monomer/Widgets/ListView.hs +++ b/src/Monomer/Widgets/ListView.hs @@ -287,9 +287,8 @@ makeListView widgetData items makeRow config state = widget where merge wenv oldState oldNode node = result where oldItems = _prevItems oldState mergeRequiredFn = fromMaybe (/=) (_lvcMergeRequired config) - visibleChg = visibleChildrenChanged oldNode node - enabledChg = enabledChildrenChanged oldNode node - mergeRequired = mergeRequiredFn oldItems items || visibleChg || enabledChg + flagsChanged = childrenFlagsChanged oldNode node + mergeRequired = mergeRequiredFn oldItems items || flagsChanged children | mergeRequired = createListViewChildren wenv node | otherwise = oldNode ^. L.children diff --git a/src/Monomer/Widgets/Single.hs b/src/Monomer/Widgets/Single.hs index 3ffdec2b..e5ad3d38 100644 --- a/src/Monomer/Widgets/Single.hs +++ b/src/Monomer/Widgets/Single.hs @@ -208,10 +208,10 @@ mergeWrapper single wenv oldNode newNode = newResult where _ -> mergeWithRestore (singleRestore single) oldState = widgetGetState (oldNode ^. L.widget) wenv oldInfo = oldNode ^. L.info - nodeHandler styledNode = case useState oldState of + nodeHandler wenv styledNode = case useState oldState of Just state -> mergeHandler wenv state oldNode styledNode _ -> resultWidget styledNode - tmpResult = loadStateHandler single wenv oldInfo newNode nodeHandler + tmpResult = runNodeHandler single wenv oldInfo newNode nodeHandler newResult = handleWidgetIdChange oldNode tmpResult mergeWithRestore @@ -252,24 +252,24 @@ restoreWrapper restoreWrapper single wenv win newNode = newResult where restoreHandler = singleRestore single oldInfo = win ^. L.info - nodeHandler styledNode = case loadState (win ^. L.state) of + nodeHandler wenv styledNode = case loadState (win ^. L.state) of Just state -> restoreHandler wenv state oldInfo styledNode _ -> resultWidget styledNode valid = infoMatches (win ^. L.info) (newNode ^. L.info) message = matchFailedMsg (win ^. L.info) (newNode ^. L.info) newResult - | valid = loadStateHandler single wenv oldInfo newNode nodeHandler + | valid = runNodeHandler single wenv oldInfo newNode nodeHandler | otherwise = throw (AssertionFailed $ "Restore failed. " ++ message) -loadStateHandler +runNodeHandler :: WidgetModel a => Single s e a -> WidgetEnv s e -> WidgetNodeInfo -> WidgetNode s e - -> (WidgetNode s e -> WidgetResult s e) + -> (WidgetEnv s e -> WidgetNode s e -> WidgetResult s e) -> WidgetResult s e -loadStateHandler single wenv oldInfo newNode nodeHandler = newResult where +runNodeHandler single wenv oldInfo newNode nodeHandler = newResult where getBaseStyle = singleGetBaseStyle single tempNode = newNode & L.info . L.widgetId .~ oldInfo ^. L.widgetId @@ -277,7 +277,7 @@ loadStateHandler single wenv oldInfo newNode nodeHandler = newResult where & L.info . L.sizeReqW .~ oldInfo ^. L.sizeReqW & L.info . L.sizeReqH .~ oldInfo ^. L.sizeReqH styledNode = initNodeStyle getBaseStyle wenv tempNode - tmpResult = nodeHandler styledNode + tmpResult = nodeHandler wenv styledNode newResult | isResizeResult (Just tmpResult) = tmpResult & L.node .~ updateSizeReq single wenv (tmpResult ^. L.node) @@ -331,11 +331,10 @@ handleEventWrapper single wenv target evt node styleCfg = singleStyleChangeCfg single focusOnPressed = singleFocusOnPressedBtn single handler = singleHandleEvent single - sizeResult = handleSizeReqChange single wenv node (Just evt) - $ handler wenv target evt node - newNode = maybe node (^. L.node) sizeResult + handlerRes = handler wenv target evt node + sizeResult = handleSizeReqChange single wenv node (Just evt) handlerRes result - | focusOnPressed = handleFocusRequest wenv evt newNode sizeResult + | focusOnPressed = handleFocusRequest wenv evt node sizeResult | otherwise = sizeResult handleFocusRequest @@ -344,7 +343,8 @@ handleFocusRequest -> WidgetNode s e -> Maybe (WidgetResult s e) -> Maybe (WidgetResult s e) -handleFocusRequest wenv evt node mResult = newResult where +handleFocusRequest wenv evt oldNode mResult = newResult where + node = maybe oldNode (^. L.node) mResult prevReqs = maybe Empty (^. L.requests) mResult isFocusable = node ^. L.info . L.focusable btnPressed = case evt of @@ -393,9 +393,12 @@ updateSizeReq single wenv node = newNode where reqs = case useState currState of Just state -> handler wenv state node _ -> def - (newReqW, newReqH) + (tmpReqW, tmpReqH) | addStyleReq = sizeReqAddStyle style reqs | otherwise = reqs + -- User settings take precedence + newReqW = fromMaybe tmpReqW (style ^. L.sizeReqW) + newReqH = fromMaybe tmpReqH (style ^. L.sizeReqH) newNode = node & L.info . L.sizeReqW .~ newReqW & L.info . L.sizeReqH .~ newReqH diff --git a/src/Monomer/Widgets/Util/Widget.hs b/src/Monomer/Widgets/Util/Widget.hs index 5067971d..1498b2dd 100644 --- a/src/Monomer/Widgets/Util/Widget.hs +++ b/src/Monomer/Widgets/Util/Widget.hs @@ -4,8 +4,12 @@ module Monomer.Widgets.Util.Widget ( defaultWidgetNode, isWidgetVisible, - visibleChildrenChanged, - enabledChildrenChanged, + nodeVisibleChanged, + nodeEnabledChanged, + nodeFlagsChanged, + childrenVisibleChanged, + childrenEnabledChanged, + childrenFlagsChanged, widgetDataGet, widgetDataSet, resultWidget, @@ -54,16 +58,38 @@ isWidgetVisible wenv node = isVisible && isOverlapped where viewport = wenv ^. L.viewport isOverlapped = rectsOverlap viewport (info ^. L.viewport) -visibleChildrenChanged :: WidgetNode s e -> WidgetNode s e -> Bool -visibleChildrenChanged oldNode newNode = oldVisible /= newVisible where +nodeVisibleChanged :: WidgetNode s e -> WidgetNode s e -> Bool +nodeVisibleChanged oldNode newNode = oldVisible /= newVisible where + oldVisible = oldNode ^. L.info . L.visible + newVisible = newNode ^. L.info . L.visible + +nodeEnabledChanged :: WidgetNode s e -> WidgetNode s e -> Bool +nodeEnabledChanged oldNode newNode = oldEnabled /= newEnabled where + oldEnabled = oldNode ^. L.info . L.enabled + newEnabled = newNode ^. L.info . L.enabled + +nodeFlagsChanged :: WidgetNode s e -> WidgetNode s e -> Bool +nodeFlagsChanged oldNode newNode = visibleChanged || enabledChanged where + visibleChanged = nodeVisibleChanged oldNode newNode + enabledChanged = nodeEnabledChanged oldNode newNode + +childrenVisibleChanged :: WidgetNode s e -> WidgetNode s e -> Bool +childrenVisibleChanged oldNode newNode = oldVisible /= newVisible where oldVisible = fmap (^. L.info . L.visible) (oldNode ^. L.children) newVisible = fmap (^. L.info . L.visible) (newNode ^. L.children) -enabledChildrenChanged :: WidgetNode s e -> WidgetNode s e -> Bool -enabledChildrenChanged oldNode newNode = oldVisible /= newVisible where +childrenEnabledChanged :: WidgetNode s e -> WidgetNode s e -> Bool +childrenEnabledChanged oldNode newNode = oldVisible /= newVisible where oldVisible = fmap (^. L.info . L.enabled) (oldNode ^. L.children) newVisible = fmap (^. L.info . L.enabled) (newNode ^. L.children) +childrenFlagsChanged :: WidgetNode s e -> WidgetNode s e -> Bool +childrenFlagsChanged oldNode newNode = lenChanged || flagsChanged where + oldChildren = oldNode ^. L.children + newChildren = newNode ^. L.children + flagsChanged = or (Seq.zipWith nodeFlagsChanged oldChildren newChildren) + lenChanged = length oldChildren /= length newChildren + widgetDataGet :: s -> WidgetData s a -> a widgetDataGet _ (WidgetValue value) = value widgetDataGet model (WidgetLens lens) = model ^# lens diff --git a/src/Monomer/Widgets/ZStack.hs b/src/Monomer/Widgets/ZStack.hs index f470e81b..67a8eed9 100644 --- a/src/Monomer/Widgets/ZStack.hs +++ b/src/Monomer/Widgets/ZStack.hs @@ -100,10 +100,10 @@ makeZStack config state = widget where focusedPath = wenv ^. L.focusedPath isFocusParent = isNodeParentOfPath focusedPath node topLevel = isNodeTopLevel wenv node - childrenChanged = visibleChildrenChanged oldNode node + flagsChanged = childrenFlagsChanged oldNode node newTopIdx = fromMaybe 0 (Seq.findIndexL (^.L.info . L.visible) children) focusReq = isJust $ Seq.findIndexL isFocusRequest (result ^. L.requests) - needsFocus = isFocusParent && topLevel && childrenChanged && not focusReq + needsFocus = isFocusParent && topLevel && flagsChanged && not focusReq oldFocus = fromJust oldTopPath oldTopPath = M.lookup newTopIdx oldFocusMap fstTopPath = Just $ node ^. L.info . L.path |> newTopIdx diff --git a/tasks.md b/tasks.md index eb122853..96dafb96 100644 --- a/tasks.md +++ b/tasks.md @@ -480,14 +480,17 @@ - Add scroll focus following - Resize called multiple times after window resize? - Not a bug (there were two dropdowns besides the main scroll, hence the three logged resizes) + - Add examples + - Todo List + - Use scroll + - Scroll should auto-scroll to focus + - Add combinator to affect size factor only + - Discarded. A combinator (CmbResizeFactorDim) already exists - Pending - Add header in all files, indicating license and documenting what the module does - Add license for used fonts, etc - Add examples - - Todo List - - Use scroll - - Scroll should auto-scroll to focus - Validate nested structures update correctly when disabling/enabling parent - Fetch content from url, show rows of data with embedded images - Composite example @@ -497,11 +500,10 @@ - https://stackoverflow.com/questions/51275681/how-to-include-a-dependency-c-library-in-haskell-stack Next - - Add combinator to affect size factor only - - Should cascadeCtx be part of widget interface? Maybe it can be handled on init? - - This could avoid rebuilding listView items when hidden/shown - Check resize requests on Todo when entering text in description - Review how sizeReq is updated. Custom user value may be ignored on further resizes + - Should cascadeCtx be part of widget interface? Maybe it can be handled on init? + - This could avoid rebuilding listView items when hidden/shown - Improve test utilities - Some way to combine them, avoid this noInit thing, losing of focus, etc - Test image updating WidgetId/Path