fjvallarino/monomer
1
1
Fork 0
mirror of https://github.com/fjvallarino/monomer.git synced 2024-11-13 00:11:06 +03:00
Code Issues Projects Releases Wiki Activity

Use user provided sizeReq if available. Several minor code improvements

Browse Source
This commit is contained in:
Francisco Vallarino 2021-02-09 22:52:01 -03:00
parent 831772605b
commit 0d164b9d08
7 changed files with 74 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
src/Monomer/Widgets/Composite.hs
View File

@ -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

34
src/Monomer/Widgets/Container.hs
View File

@ -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

5
src/Monomer/Widgets/ListView.hs
View File

@ -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

31
src/Monomer/Widgets/Single.hs
View File

@ -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

38
src/Monomer/Widgets/Util/Widget.hs
View File

@ -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

4
src/Monomer/Widgets/ZStack.hs
View File

@ -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

14
tasks.md
View File

@ -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