Default container sizeReq/resize does the right thing for single child widget (it is the most common container case)

This commit is contained in:
Francisco Vallarino 2021-03-04 11:05:55 -03:00
parent e8285d4ca2
commit f93f41b3c7
5 changed files with 13 additions and 57 deletions

View File

@ -787,7 +787,10 @@ handleMessageWrapper container wenv target arg node
-- | Preferred size
defaultGetSizeReq :: ContainerGetSizeReqHandler s e a
defaultGetSizeReq wenv node children = def
defaultGetSizeReq wenv state node children = (newReqW, newReqH) where
(newReqW, newReqH) = case Seq.lookup 0 children of
Just child -> (child ^. L.info . L.sizeReqW, child ^. L.info . L.sizeReqH)
_ -> def
updateSizeReq
:: WidgetModel a
@ -834,9 +837,11 @@ handleSizeReqChange container wenv node evt mResult = result where
-- | Resize
defaultResize :: ContainerResizeHandler s e
defaultResize wenv viewport children node = newSize where
childrenSizes = Seq.replicate (Seq.length children) def
newSize = (resultWidget node, childrenSizes)
defaultResize wenv viewport children node = resized where
style = activeStyle wenv node
contentArea = fromMaybe def (removeOuterBounds style viewport)
childrenSizes = Seq.replicate (Seq.length children) contentArea
resized = (resultWidget node, childrenSizes)
resizeWrapper
:: WidgetModel a

View File

@ -64,9 +64,7 @@ makeDropTarget :: DragMsg a => (a -> e) -> DropTargetCfg -> Widget s e
makeDropTarget dropEvt config = widget where
widget = createContainer () def {
containerGetActiveStyle = getActiveStyle,
containerHandleEvent = handleEvent,
containerGetSizeReq = getSizeReq,
containerResize = resize
containerHandleEvent = handleEvent
}
getActiveStyle wenv node
@ -85,18 +83,6 @@ makeDropTarget dropEvt config = widget where
result = resultEvts node evts
_ -> Nothing
getSizeReq :: ContainerGetSizeReqHandler s e a
getSizeReq wenv currState node children = (newReqW, newReqH) where
child = Seq.index children 0
newReqW = child ^. L.info . L.sizeReqW
newReqH = child ^. L.info . L.sizeReqH
resize :: ContainerResizeHandler s e
resize wenv viewport children node = resized where
style = activeStyle wenv node
contentArea = fromMaybe def (removeOuterBounds style viewport)
resized = (resultWidget node, Seq.singleton contentArea)
isDropTarget wenv node = case wenv ^. L.dragStatus of
Just (path, msg) -> not (isNodeParentOfPath path node) && isValidMsg msg
_ -> False

View File

@ -90,9 +90,7 @@ makeNode widget managedWidget = defaultWidgetNode "keystroke" widget
makeKeystroke :: [(KeyStroke, e)] -> KeystrokeCfg -> Widget s e
makeKeystroke bindings config = widget where
widget = createContainer () def {
containerHandleEvent = handleEvent,
containerGetSizeReq = getSizeReq,
containerResize = resize
containerHandleEvent = handleEvent
}
handleEvent wenv target evt node = case evt of
@ -106,18 +104,6 @@ makeKeystroke bindings config = widget where
result = resultReqsEvts node reqs evts
_ -> Nothing
getSizeReq :: ContainerGetSizeReqHandler s e a
getSizeReq wenv currState node children = (newReqW, newReqH) where
child = Seq.index children 0
newReqW = child ^. L.info . L.sizeReqW
newReqH = child ^. L.info . L.sizeReqH
resize :: ContainerResizeHandler s e
resize wenv viewport children node = resized where
style = activeStyle wenv node
contentArea = fromMaybe def (removeOuterBounds style viewport)
resized = (resultWidget node, Seq.singleton contentArea)
keyStrokeActive :: WidgetEnv s e -> KeyCode -> KeyStroke -> Bool
keyStrokeActive wenv code ks = currValid && allPressed && validMods where
status = wenv ^. L.inputStatus

View File

@ -26,22 +26,8 @@ makeNode widget managedWidget = defaultWidgetNode "themeSwitch" widget
makeTheme :: Theme -> Widget s e
makeTheme theme = widget where
widget = createContainer () def {
containerUpdateCWenv = updateCWenv,
containerGetSizeReq = getSizeReq,
containerResize = resize
containerUpdateCWenv = updateCWenv
}
updateCWenv wenv cidx cnode node = newWenv where
newWenv = wenv & L.theme .~ theme
getSizeReq :: ContainerGetSizeReqHandler s e a
getSizeReq wenv currState node children = (newReqW, newReqH) where
child = Seq.index children 0
newReqW = child ^. L.info . L.sizeReqW
newReqH = child ^. L.info . L.sizeReqH
resize :: ContainerResizeHandler s e
resize wenv viewport children node = resized where
style = activeStyle wenv node
contentArea = fromMaybe def (removeOuterBounds style viewport)
resized = (resultWidget node, Seq.singleton contentArea)

View File

@ -100,7 +100,6 @@ makeTooltip caption config state = widget where
containerGetBaseStyle = getBaseStyle,
containerRestore = restore,
containerHandleEvent = handleEvent,
containerGetSizeReq = getSizeReq,
containerResize = resize
}
widget = baseWidget {
@ -143,13 +142,7 @@ makeTooltip caption config state = widget where
| otherwise = resultWidget node
_ -> Nothing
getSizeReq :: ContainerGetSizeReqHandler s e a
getSizeReq wenv currState node children = (newReqW, newReqH) where
child = Seq.index children 0
newReqW = child ^. L.info . L.sizeReqW
newReqH = child ^. L.info . L.sizeReqH
resize :: ContainerResizeHandler s e
-- Padding/border is not removed. Styles are only considerer for the overlay
resize wenv viewport children node = resized where
resized = (resultWidget node, Seq.singleton viewport)