mirror of
https://github.com/fjvallarino/monomer.git
synced 2024-09-20 00:09:02 +03:00
Handle scrolling based on offset instead of resize of children nodes
This commit is contained in:
parent
5a23225670
commit
99d6856ac3
10
app/Main.hs
10
app/Main.hs
@ -133,7 +133,7 @@ handleAppEvent wenv node model evt = case evt of
|
||||
_ -> []
|
||||
|
||||
buildUI :: WidgetEnv App AppEvent -> App -> WidgetNode App AppEvent
|
||||
buildUI wenv model = traceShow "Creating UI" widgetLV where
|
||||
buildUI wenv model = traceShow "Creating UI" widgetTree where
|
||||
widgetThemeSwitch = hstack [
|
||||
label "Test",
|
||||
themeSwitch (darkTheme & L.basic . L.labelStyle . L.bgColor ?~ red) (label "Test")
|
||||
@ -234,8 +234,8 @@ buildUI wenv model = traceShow "Creating UI" widgetLV where
|
||||
widgetLV = vstack [
|
||||
-- scroll $ vstack $ (\i -> box $ label ("Label: " <> showt i)) <$> [0..1000::Int]
|
||||
label "aaa"
|
||||
-- , listView dropdown1 items label
|
||||
, scroll $ image "assets/images/pecans.jpg"
|
||||
, listView dropdown1 items label `style` [height 300]
|
||||
-- , scroll $ image "assets/images/pecans.jpg"
|
||||
-- , dropdown_ dropdown1 items label label [maxHeight 200]
|
||||
]
|
||||
widgetWindow = vstack [
|
||||
@ -377,12 +377,12 @@ buildUI wenv model = traceShow "Creating UI" widgetLV where
|
||||
label "Label 1234" `style` [bgColor darkGray]
|
||||
] `style` [bgColor blue]
|
||||
] `style` [bgColor green],
|
||||
label (model ^. dropdown1) `style` [bgColor lightBlue, textLeft],
|
||||
textField textField1 `style` [bgColor lightBlue, textLeft],
|
||||
hgrid [
|
||||
label_ "This is a really long label used to check what I did works fine" [textMultiLine, textEllipsis],
|
||||
label "Jj label" `hover` [textSize 40]
|
||||
] `hover` [bgColor red],
|
||||
label (model ^. dropdown1) `style` [bgColor lightBlue, textLeft],
|
||||
textField textField1 `style` [bgColor lightBlue, textLeft],
|
||||
hstack [
|
||||
scroll_ [] $ image_ "assets/images/pecans.jpg" [fitFill],
|
||||
scroll_ [] $ image_ "assets/images/pecans.jpg" [fitFill],
|
||||
|
@ -97,7 +97,7 @@ data AppEvent
|
||||
| InitApp
|
||||
| DisposeApp
|
||||
| ExitApp
|
||||
| ResizeApp (Rect, Rect)
|
||||
| ResizeApp Rect
|
||||
| CancelExitApp
|
||||
| MaxWindow
|
||||
| MinWindow
|
||||
|
@ -29,7 +29,6 @@ nodeDesc level node = infoDesc (_wnInfo node) where
|
||||
infoDesc info =
|
||||
spaces ++ "type: " ++ unWidgetType (_wniWidgetType info) ++ "\n" ++
|
||||
spaces ++ "path: " ++ show (_wniPath info) ++ "\n" ++
|
||||
spaces ++ "vp: " ++ rectDesc (_wniViewport info) ++ "\n" ++
|
||||
spaces ++ "ra: " ++ rectDesc (_wniRenderArea info) ++ "\n" ++
|
||||
spaces ++ "req: " ++ show (_wniSizeReqW info, _wniSizeReqH info) ++ "\n"
|
||||
rectDesc r = show (_rX r, _rY r, _rW r, _rH r)
|
||||
@ -45,7 +44,6 @@ nodeInstDesc level node = infoDesc (_winInfo node) where
|
||||
infoDesc info =
|
||||
spaces ++ "type: " ++ unWidgetType (_wniWidgetType info) ++ "\n" ++
|
||||
spaces ++ "path: " ++ show (_wniPath info) ++ "\n" ++
|
||||
spaces ++ "vp: " ++ rectDesc (_wniViewport info) ++ "\n" ++
|
||||
spaces ++ "ra: " ++ rectDesc (_wniRenderArea info) ++ "\n" ++
|
||||
spaces ++ "req: " ++ show (_wniSizeReqW info, _wniSizeReqH info) ++ "\n"
|
||||
rectDesc r = show (_rX r, _rY r, _rW r, _rH r)
|
||||
|
@ -200,11 +200,7 @@ data WidgetNodeInfo =
|
||||
_wniVisible :: !Bool,
|
||||
-- | Indicates whether the widget can receive focus
|
||||
_wniFocusable :: !Bool,
|
||||
-- | The visible area of the screen assigned to the widget
|
||||
_wniViewport :: !Rect,
|
||||
-- | The area of the screen where the widget can draw
|
||||
-- | Usually equal to _wniViewport, but may be larger if the widget is
|
||||
-- | wrapped in a scrollable container
|
||||
_wniRenderArea :: !Rect,
|
||||
-- | Style attributes of the widget instance
|
||||
_wniStyle :: Style
|
||||
@ -221,7 +217,6 @@ instance Default WidgetNodeInfo where
|
||||
_wniEnabled = True,
|
||||
_wniVisible = True,
|
||||
_wniFocusable = False,
|
||||
_wniViewport = def,
|
||||
_wniRenderArea = def,
|
||||
_wniStyle = def
|
||||
}
|
||||
@ -336,7 +331,6 @@ data Widget s e =
|
||||
widgetResize
|
||||
:: WidgetEnv s e
|
||||
-> Rect
|
||||
-> Rect
|
||||
-> WidgetNode s e
|
||||
-> WidgetResult s e,
|
||||
-- | Renders the widget
|
||||
|
@ -115,7 +115,7 @@ data AppConfig e = AppConfig {
|
||||
_apcInitEvent :: [e],
|
||||
_apcDisposeEvent :: [e],
|
||||
_apcExitEvent :: [e],
|
||||
_apcResizeEvent :: [(Rect, Rect) -> e],
|
||||
_apcResizeEvent :: [Rect -> e],
|
||||
_apcMainButton :: Maybe Button,
|
||||
_apcStateFileMain :: Maybe String
|
||||
}
|
||||
@ -214,7 +214,7 @@ appExitEvent evt = def {
|
||||
_apcExitEvent = [evt]
|
||||
}
|
||||
|
||||
appResizeEvent :: ((Rect, Rect) -> e) -> AppConfig e
|
||||
appResizeEvent :: (Rect -> e) -> AppConfig e
|
||||
appResizeEvent evt = def {
|
||||
_apcResizeEvent = [evt]
|
||||
}
|
||||
|
@ -69,7 +69,7 @@ resizeRoot wenv windowSize widgetRoot = result where
|
||||
Size w h = windowSize
|
||||
assigned = Rect 0 0 w h
|
||||
widget = widgetRoot ^. L.widget
|
||||
result = widgetResize widget wenv assigned assigned widgetRoot
|
||||
result = widgetResize widget wenv assigned widgetRoot
|
||||
|
||||
setWidgetIdPath :: (MonomerM s m) => WidgetId -> Path -> m ()
|
||||
setWidgetIdPath widgetId path =
|
||||
|
@ -167,7 +167,7 @@ makeBox config = widget where
|
||||
newReqH = child ^. L.info . L.sizeReqH
|
||||
|
||||
resize :: ContainerResizeHandler s e
|
||||
resize wenv viewport renderArea children node = resized where
|
||||
resize wenv renderArea children node = resized where
|
||||
style = activeStyle wenv node
|
||||
contentArea = fromMaybe def (removeOuterBounds style renderArea)
|
||||
Rect cx cy cw ch = contentArea
|
||||
@ -177,13 +177,11 @@ makeBox config = widget where
|
||||
raChild = Rect cx cy (min cw contentW) (min ch contentH)
|
||||
ah = fromMaybe ACenter (_boxAlignH config)
|
||||
av = fromMaybe AMiddle (_boxAlignV config)
|
||||
vpContent = fromMaybe def (intersectRects viewport contentArea)
|
||||
raAligned = alignInRect ah av contentArea raChild
|
||||
vpAligned = fromMaybe def (intersectRects viewport raAligned)
|
||||
expand = fromMaybe False (_boxExpandContent config)
|
||||
resized
|
||||
| expand = (resultWidget node, Seq.singleton (vpContent, contentArea))
|
||||
| otherwise = (resultWidget node, Seq.singleton (vpAligned, raAligned))
|
||||
| expand = (resultWidget node, Seq.singleton contentArea)
|
||||
| otherwise = (resultWidget node, Seq.singleton raAligned)
|
||||
|
||||
alignInRect :: AlignH -> AlignV -> Rect -> Rect -> Rect
|
||||
alignInRect ah av parent child = newRect where
|
||||
|
@ -243,7 +243,7 @@ makeButton config state = widget where
|
||||
| abs factorH < 0.01 = FixedSize h
|
||||
| otherwise = FlexSize h factorH
|
||||
|
||||
resize wenv viewport renderArea node = resultWidget newNode where
|
||||
resize wenv renderArea node = resultWidget newNode where
|
||||
style = activeStyle wenv node
|
||||
rect = fromMaybe def (removeOuterBounds style renderArea)
|
||||
newTextStyle = style ^. L.text
|
||||
|
@ -70,7 +70,7 @@ data CompositeCfg s e sp ep = CompositeCfg {
|
||||
_cmcMergeRequired :: Maybe (MergeRequired s),
|
||||
_cmcOnInit :: [e],
|
||||
_cmcOnDispose :: [e],
|
||||
_cmcOnResize :: [(Rect, Rect) -> e],
|
||||
_cmcOnResize :: [Rect -> e],
|
||||
_cmcOnChange :: [s -> ep],
|
||||
_cmcOnChangeReq :: [WidgetRequest sp],
|
||||
_cmcOnEnabledChange :: [e],
|
||||
@ -119,7 +119,7 @@ instance CmbOnDispose (CompositeCfg s e sp ep) e where
|
||||
_cmcOnDispose = [fn]
|
||||
}
|
||||
|
||||
instance CmbOnResize (CompositeCfg s e sp ep) (Rect, Rect) e where
|
||||
instance CmbOnResize (CompositeCfg s e sp ep) Rect e where
|
||||
onResize fn = def {
|
||||
_cmcOnResize = [fn]
|
||||
}
|
||||
@ -151,7 +151,7 @@ data Composite s e sp ep = Composite {
|
||||
_cmpMergeRequired :: MergeRequired s,
|
||||
_cmpOnInit :: [e],
|
||||
_cmpOnDispose :: [e],
|
||||
_cmpOnResize :: [(Rect, Rect) -> e],
|
||||
_cmpOnResize :: [Rect -> e],
|
||||
_cmpOnChange :: [s -> ep],
|
||||
_cmpOnChangeReq :: [WidgetRequest sp],
|
||||
_cmpOnEnabledChange :: [e],
|
||||
@ -370,7 +370,6 @@ compositeMerge comp state wenv oldComp newComp = newResult where
|
||||
getBaseStyle wenv node = Nothing
|
||||
styledComp = initNodeStyle getBaseStyle wenv newComp
|
||||
& L.info . L.widgetId .~ oldComp ^. L.info . L.widgetId
|
||||
& L.info . L.viewport .~ oldComp ^. L.info . L.viewport
|
||||
& L.info . L.renderArea .~ oldComp ^. L.info . L.renderArea
|
||||
& L.info . L.sizeReqW .~ oldComp ^. L.info . L.sizeReqW
|
||||
& L.info . L.sizeReqH .~ oldComp ^. L.info . L.sizeReqH
|
||||
@ -454,7 +453,6 @@ compositeRestore comp state wenv win newComp = result where
|
||||
result
|
||||
| valid = reducedResult
|
||||
& L.node . L.info . L.widgetId .~ oldInfo ^. L.widgetId
|
||||
& L.node . L.info . L.viewport .~ oldInfo ^. L.viewport
|
||||
& L.node . L.info . L.renderArea .~ oldInfo ^. L.renderArea
|
||||
& L.node . L.info . L.sizeReqW .~ oldInfo ^. L.sizeReqW
|
||||
& L.node . L.info . L.sizeReqH .~ oldInfo ^. L.sizeReqH
|
||||
@ -572,30 +570,26 @@ compositeResize
|
||||
-> CompositeState s e
|
||||
-> WidgetEnv sp ep
|
||||
-> Rect
|
||||
-> Rect
|
||||
-> WidgetNode sp ep
|
||||
-> WidgetResult sp ep
|
||||
compositeResize comp state wenv viewport renderArea widgetComp = resized where
|
||||
compositeResize comp state wenv renderArea widgetComp = resized where
|
||||
CompositeState{..} = state
|
||||
style = activeStyle wenv widgetComp
|
||||
contentArea = fromMaybe def (removeOuterBounds style renderArea)
|
||||
widget = _cpsRoot ^. L.widget
|
||||
model = getModel comp wenv
|
||||
cwenv = convertWidgetEnv wenv _cpsGlobalKeys model
|
||||
tmpRes = widgetResize widget cwenv viewport contentArea _cpsRoot
|
||||
oldVp = widgetComp ^. L.info . L.viewport
|
||||
tmpRes = widgetResize widget cwenv contentArea _cpsRoot
|
||||
oldRa = widgetComp ^. L.info . L.renderArea
|
||||
sizeChanged = viewport /= oldVp || renderArea /= oldRa
|
||||
resizeEvts = fmap ($ (viewport, renderArea)) (_cmpOnResize comp)
|
||||
sizeChanged = renderArea /= oldRa
|
||||
resizeEvts = fmap ($ renderArea) (_cmpOnResize comp)
|
||||
newEvts
|
||||
| sizeChanged = Seq.fromList resizeEvts
|
||||
| otherwise = Empty
|
||||
newRes = reduceResult comp state wenv widgetComp $ tmpRes
|
||||
& L.node . L.info . L.viewport .~ viewport
|
||||
& L.node . L.info . L.renderArea .~ contentArea
|
||||
& L.events .~ tmpRes ^. L.events <> newEvts
|
||||
resized = newRes
|
||||
& L.node . L.info . L.viewport .~ viewport
|
||||
& L.node . L.info . L.renderArea .~ renderArea
|
||||
|
||||
-- Render
|
||||
|
@ -156,10 +156,9 @@ type ContainerGetSizeReqHandler s e a
|
||||
type ContainerResizeHandler s e
|
||||
= WidgetEnv s e
|
||||
-> Rect
|
||||
-> Rect
|
||||
-> Seq (WidgetNode s e)
|
||||
-> WidgetNode s e
|
||||
-> (WidgetResult s e, Seq (Rect, Rect))
|
||||
-> (WidgetResult s e, Seq Rect)
|
||||
|
||||
type ContainerRenderHandler s e
|
||||
= Renderer
|
||||
@ -168,6 +167,7 @@ type ContainerRenderHandler s e
|
||||
-> IO ()
|
||||
|
||||
data Container s e a = Container {
|
||||
containerChildrenOffset :: Maybe Point,
|
||||
containerIgnoreEmptyArea :: Bool,
|
||||
containerResizeRequired :: Bool,
|
||||
containerStyleChangeCfg :: StyleChangeCfg,
|
||||
@ -186,7 +186,6 @@ data Container s e a = Container {
|
||||
containerDispose :: ContainerDisposeHandler s e,
|
||||
containerFindNextFocus :: ContainerFindNextFocusHandler s e,
|
||||
containerFindByPoint :: ContainerFindByPointHandler s e,
|
||||
containerUpdateEvent :: ContainerUpdateEventHandler s e,
|
||||
containerHandleEvent :: ContainerEventHandler s e,
|
||||
containerHandleMessage :: ContainerMessageHandler s e,
|
||||
containerGetSizeReq :: ContainerGetSizeReqHandler s e a,
|
||||
@ -197,6 +196,7 @@ data Container s e a = Container {
|
||||
|
||||
instance Default (Container s e a) where
|
||||
def = Container {
|
||||
containerChildrenOffset = Nothing,
|
||||
containerIgnoreEmptyArea = False,
|
||||
containerResizeRequired = True,
|
||||
containerStyleChangeCfg = def,
|
||||
@ -215,7 +215,6 @@ instance Default (Container s e a) where
|
||||
containerDispose = defaultDispose,
|
||||
containerFindNextFocus = defaultFindNextFocus,
|
||||
containerFindByPoint = defaultFindByPoint,
|
||||
containerUpdateEvent = defaultUpdateEvent,
|
||||
containerHandleEvent = defaultHandleEvent,
|
||||
containerHandleMessage = defaultHandleMessage,
|
||||
containerGetSizeReq = defaultGetSizeReq,
|
||||
@ -254,6 +253,28 @@ defaultGetActiveStyle wenv node = activeStyle wenv node
|
||||
defaultUpdateCWenv :: ContainerUpdateCWenvHandler s e
|
||||
defaultUpdateCWenv wenv cidx cnode node = wenv
|
||||
|
||||
getUpdateCWenv
|
||||
:: Container s e a
|
||||
-> WidgetEnv s e
|
||||
-> Int
|
||||
-> WidgetNode s e
|
||||
-> WidgetNode s e
|
||||
-> WidgetEnv s e
|
||||
getUpdateCWenv container wenv cidx cnode node = newWenv where
|
||||
cOffset = containerChildrenOffset container
|
||||
updateCWenv = containerUpdateCWenv container
|
||||
offset = fromMaybe def cOffset
|
||||
accumOffset = wenv ^. L.offset
|
||||
renderArea = node ^. L.info . L.renderArea
|
||||
tmpWenv = wenv
|
||||
& L.viewport .~ moveRect (negPoint accumOffset) renderArea
|
||||
& L.inputStatus . L.mousePos %~ addPoint (negPoint offset)
|
||||
& L.inputStatus . L.mousePosPrev %~ addPoint (negPoint offset)
|
||||
& L.offset %~ addPoint offset
|
||||
newWenv
|
||||
| isJust cOffset = updateCWenv tmpWenv cidx cnode node
|
||||
| otherwise = updateCWenv wenv cidx cnode node
|
||||
|
||||
-- | Init handler
|
||||
defaultInit :: ContainerInitHandler s e
|
||||
defaultInit wenv node = resultWidget node
|
||||
@ -267,7 +288,7 @@ initWrapper
|
||||
initWrapper container wenv node = result where
|
||||
initHandler = containerInit container
|
||||
getBaseStyle = containerGetBaseStyle container
|
||||
updateCWenv = containerUpdateCWenv container
|
||||
updateCWenv = getUpdateCWenv container
|
||||
styledNode = initNodeStyle getBaseStyle wenv node
|
||||
WidgetResult tempNode reqs events = initHandler wenv styledNode
|
||||
children = tempNode ^. L.children
|
||||
@ -309,7 +330,7 @@ mergeWrapper
|
||||
-> WidgetResult s e
|
||||
mergeWrapper container wenv oldNode newNode = newResult where
|
||||
getBaseStyle = containerGetBaseStyle container
|
||||
updateCWenv = containerUpdateCWenv container
|
||||
updateCWenv = getUpdateCWenv container
|
||||
cWenvHelper idx child = updateCWenv wenv idx child newNode
|
||||
mergeRequiredHandler = containerMergeChildrenReq container
|
||||
mergeHandler = case containerMerge container of
|
||||
@ -351,7 +372,6 @@ mergeParent mergeHandler wenv oldState oldNode newNode = result where
|
||||
oldInfo = oldNode ^. L.info
|
||||
tempNode = newNode
|
||||
& L.info . L.widgetId .~ oldInfo ^. L.widgetId
|
||||
& L.info . L.viewport .~ oldInfo ^. L.viewport
|
||||
& L.info . L.renderArea .~ oldInfo ^. L.renderArea
|
||||
& L.info . L.sizeReqW .~ oldInfo ^. L.sizeReqW
|
||||
& L.info . L.sizeReqH .~ oldInfo ^. L.sizeReqH
|
||||
@ -454,7 +474,7 @@ saveWrapper
|
||||
-> WidgetNode s e
|
||||
-> WidgetInstanceNode
|
||||
saveWrapper container wenv node = instNode where
|
||||
updateCWenv = containerUpdateCWenv container
|
||||
updateCWenv = getUpdateCWenv container
|
||||
instNode = WidgetInstanceNode {
|
||||
_winInfo = node ^. L.info,
|
||||
_winState = widgetGetState (node ^. L.widget) wenv,
|
||||
@ -478,13 +498,12 @@ restoreWrapper
|
||||
-> WidgetResult s e
|
||||
restoreWrapper container wenv win newNode = newResult where
|
||||
getBaseStyle = containerGetBaseStyle container
|
||||
updateCWenv = containerUpdateCWenv container
|
||||
updateCWenv = getUpdateCWenv container
|
||||
restoreHandler = containerRestore container
|
||||
restorePostHandler = containerRestorePost container
|
||||
oldInfo = win ^. L.info
|
||||
tempNode = newNode
|
||||
& L.info . L.widgetId .~ oldInfo ^. L.widgetId
|
||||
& L.info . L.viewport .~ oldInfo ^. L.viewport
|
||||
& L.info . L.renderArea .~ oldInfo ^. L.renderArea
|
||||
& L.info . L.sizeReqW .~ oldInfo ^. L.sizeReqW
|
||||
& L.info . L.sizeReqH .~ oldInfo ^. L.sizeReqH
|
||||
@ -527,7 +546,7 @@ disposeWrapper
|
||||
-> WidgetNode s e
|
||||
-> WidgetResult s e
|
||||
disposeWrapper container wenv node = result where
|
||||
updateCWenv = containerUpdateCWenv container
|
||||
updateCWenv = getUpdateCWenv container
|
||||
disposeHandler = containerDispose container
|
||||
WidgetResult tempNode reqs events = disposeHandler wenv node
|
||||
children = tempNode ^. L.children
|
||||
@ -572,7 +591,7 @@ findFocusCandidate
|
||||
-> Maybe Path
|
||||
findFocusCandidate _ _ _ _ _ Empty = Nothing
|
||||
findFocusCandidate container wenv dir start node (ch :<| chs) = result where
|
||||
updateCWenv = containerUpdateCWenv container
|
||||
updateCWenv = getUpdateCWenv container
|
||||
path = node ^. L.info . L.path
|
||||
idx = fromMaybe 0 (Seq.lookup (length path - 1) path)
|
||||
cwenv = updateCWenv wenv idx ch node
|
||||
@ -588,7 +607,7 @@ findFocusCandidate container wenv dir start node (ch :<| chs) = result where
|
||||
defaultFindByPoint :: ContainerFindByPointHandler s e
|
||||
defaultFindByPoint wenv startPath point node = result where
|
||||
children = node ^. L.children
|
||||
pointInWidget wi = wi ^. L.visible && pointInRect point (wi ^. L.viewport)
|
||||
pointInWidget wi = wi ^. L.visible && pointInRect point (wi ^. L.renderArea)
|
||||
result = Seq.findIndexL (pointInWidget . _wnInfo) children
|
||||
|
||||
findByPointWrapper
|
||||
@ -599,16 +618,18 @@ findByPointWrapper
|
||||
-> WidgetNode s e
|
||||
-> Maybe Path
|
||||
findByPointWrapper container wenv start point node = result where
|
||||
updateCWenv = containerUpdateCWenv container
|
||||
offset = fromMaybe def (containerChildrenOffset container)
|
||||
updateCWenv = getUpdateCWenv container
|
||||
ignoreEmpty = containerIgnoreEmptyArea container
|
||||
handler = containerFindByPoint container
|
||||
isVisible = node ^. L.info . L.visible
|
||||
inVp = isPointInNodeVp point node
|
||||
cpoint = addPoint (negPoint offset) point
|
||||
path = node ^. L.info . L.path
|
||||
children = node ^. L.children
|
||||
newStartPath = Seq.drop 1 start
|
||||
childIdx = case newStartPath of
|
||||
Empty -> handler wenv start point node
|
||||
Empty -> handler wenv start cpoint node
|
||||
p :<| ps -> Just p
|
||||
validateIdx p
|
||||
| Seq.length children > p = Just p
|
||||
@ -616,7 +637,7 @@ findByPointWrapper container wenv start point node = result where
|
||||
resultPath = case childIdx >>= validateIdx of
|
||||
Just idx -> childPath where
|
||||
cwenv = updateCWenv wenv idx child node
|
||||
childPath = widgetFindByPoint childWidget cwenv newStartPath point child
|
||||
childPath = widgetFindByPoint childWidget cwenv newStartPath cpoint child
|
||||
child = Seq.index children idx
|
||||
childWidget = child ^. L.widget
|
||||
Nothing
|
||||
@ -627,9 +648,6 @@ findByPointWrapper container wenv start point node = result where
|
||||
| otherwise = Nothing
|
||||
|
||||
-- | Event Handling
|
||||
defaultUpdateEvent :: ContainerUpdateEventHandler s e
|
||||
defaultUpdateEvent wenv evt node = evt
|
||||
|
||||
defaultHandleEvent :: ContainerEventHandler s e
|
||||
defaultHandleEvent wenv target evt node = Nothing
|
||||
|
||||
@ -650,10 +668,10 @@ handleEventWrapper container wenv target evt node
|
||||
-- _wiChildren, but may still be valid in the receiving widget
|
||||
-- For example, Composite has its own tree of child widgets with (possibly)
|
||||
-- different types for Model and Events, and is candidate for the next step
|
||||
offset = fromMaybe def (containerChildrenOffset container)
|
||||
style = containerGetActiveStyle container wenv node
|
||||
styleCfg = containerStyleChangeCfg container
|
||||
updateCWenv = containerUpdateCWenv container
|
||||
updateEvt = containerUpdateEvent container
|
||||
updateCWenv = getUpdateCWenv container
|
||||
handler = containerHandleEvent container
|
||||
targetReached = isTargetReached target node
|
||||
targetValid = isTargetValid target node
|
||||
@ -662,7 +680,7 @@ handleEventWrapper container wenv target evt node
|
||||
child = Seq.index children childIdx
|
||||
childWidget = child ^. L.widget
|
||||
cwenv = updateCWenv wenv childIdx child node
|
||||
cevt = updateEvt wenv evt node
|
||||
cevt = translateEvent (negPoint offset) evt
|
||||
-- Event targeted at parent
|
||||
pResponse = handler wenv target evt node
|
||||
pResultStyled = handleStyleChange wenv target style styleCfg node evt
|
||||
@ -673,8 +691,8 @@ handleEventWrapper container wenv target evt node
|
||||
| childrenIgnored || not (child ^. L.info . L.enabled) = Nothing
|
||||
| otherwise = widgetHandleEvent childWidget cwenv target cevt child
|
||||
cResult = mergeParentChildEvts node pResponse cResponse childIdx
|
||||
cResultStyled = handleStyleChange wenv target style styleCfg node cevt
|
||||
$ handleSizeReqChange container wenv node (Just cevt) cResult
|
||||
cResultStyled = handleStyleChange cwenv target style styleCfg node cevt
|
||||
$ handleSizeReqChange container cwenv node (Just cevt) cResult
|
||||
|
||||
mergeParentChildEvts
|
||||
:: WidgetNode s e
|
||||
@ -717,7 +735,7 @@ handleMessageWrapper container wenv target arg node
|
||||
| not targetReached && not targetValid = Nothing
|
||||
| otherwise = handleSizeReqChange container wenv node Nothing result
|
||||
where
|
||||
updateCWenv = containerUpdateCWenv container
|
||||
updateCWenv = getUpdateCWenv container
|
||||
handler = containerHandleMessage container
|
||||
targetReached = isTargetReached target node
|
||||
targetValid = isTargetValid target node
|
||||
@ -777,7 +795,7 @@ handleSizeReqChange container wenv node evt mResult = result where
|
||||
|
||||
-- | Resize
|
||||
defaultResize :: ContainerResizeHandler s e
|
||||
defaultResize wenv viewport renderArea children node = newSize where
|
||||
defaultResize wenv renderArea children node = newSize where
|
||||
childrenSizes = Seq.replicate (Seq.length children) def
|
||||
newSize = (resultWidget node, childrenSizes)
|
||||
|
||||
@ -785,44 +803,34 @@ resizeWrapper
|
||||
:: Container s e a
|
||||
-> WidgetEnv s e
|
||||
-> Rect
|
||||
-> Rect
|
||||
-> WidgetNode s e
|
||||
-> WidgetResult s e
|
||||
resizeWrapper container wenv viewport renderArea node = result where
|
||||
updateCWenv = containerUpdateCWenv container
|
||||
resizeWrapper container wenv renderArea node = result where
|
||||
updateCWenv = getUpdateCWenv container
|
||||
resizeRequired = containerResizeRequired container
|
||||
useCustomSize = containerUseCustomSize container
|
||||
useChildSize = containerUseChildrenSizes container
|
||||
handler = containerResize container
|
||||
lensVp = L.info . L.viewport
|
||||
lensRa = L.info . L.renderArea
|
||||
vpChanged = viewport /= node ^. lensVp
|
||||
raChanged = renderArea /= node ^. lensRa
|
||||
children = node ^. L.children
|
||||
(tempRes, assigned) = handler wenv viewport renderArea children node
|
||||
resize idx (child, (vp, ra)) = newChildRes where
|
||||
(tempRes, assigned) = handler wenv renderArea children node
|
||||
resize idx (child, ra) = newChildRes where
|
||||
cwenv = updateCWenv wenv idx child node
|
||||
tempChildRes = widgetResize (child ^. L.widget) cwenv vp ra child
|
||||
cvp = tempChildRes ^. L.node . L.info . L.viewport
|
||||
tempChildRes = widgetResize (child ^. L.widget) cwenv ra child
|
||||
cra = tempChildRes ^. L.node . L.info . L.renderArea
|
||||
icvp = fromMaybe vp (intersectRects vp cvp)
|
||||
icra = fromMaybe ra (intersectRects ra cra)
|
||||
newChildRes = tempChildRes
|
||||
& L.node . L.info . L.viewport .~ (if useChildSize then icvp else vp)
|
||||
& L.node . L.info . L.renderArea .~ (if useChildSize then icra else ra)
|
||||
newChildrenRes = Seq.mapWithIndex resize (Seq.zip children assigned)
|
||||
newChildren = fmap _wrNode newChildrenRes
|
||||
newChildrenReqs = foldMap _wrRequests newChildrenRes
|
||||
newChildrenEvts = foldMap _wrEvents newChildrenRes
|
||||
newVp
|
||||
| useCustomSize = tempRes ^. L.node . lensVp
|
||||
| otherwise = viewport
|
||||
newRa
|
||||
| useCustomSize = tempRes ^. L.node . lensRa
|
||||
| otherwise = renderArea
|
||||
result
|
||||
| resizeRequired || vpChanged || raChanged = tempRes
|
||||
& L.node . L.info . L.viewport .~ newVp
|
||||
| resizeRequired || raChanged = tempRes
|
||||
& L.node . L.info . L.renderArea .~ newRa
|
||||
& L.node . L.children .~ newChildren
|
||||
& L.requests <>~ newChildrenReqs
|
||||
@ -840,22 +848,30 @@ renderWrapper
|
||||
-> WidgetNode s e
|
||||
-> IO ()
|
||||
renderWrapper container renderer wenv node =
|
||||
drawInScissor renderer useScissor viewport $
|
||||
drawInScissor renderer useScissor renderArea $
|
||||
drawStyledAction renderer renderArea style $ \_ -> do
|
||||
renderBefore renderer wenv node
|
||||
|
||||
forM_ pairs $ \(idx, child) -> when (isWidgetVisible child viewport) $
|
||||
when (isJust offset) $ do
|
||||
saveContext renderer
|
||||
setTranslation renderer (fromJust offset)
|
||||
|
||||
forM_ pairs $ \(idx, child) ->
|
||||
when (isWidgetVisible (cwenv idx child) child) $
|
||||
widgetRender (child ^. L.widget) renderer (cwenv idx child) child
|
||||
|
||||
when (isJust offset) $
|
||||
restoreContext renderer
|
||||
|
||||
renderAfter renderer wenv node
|
||||
where
|
||||
style = containerGetActiveStyle container wenv node
|
||||
updateCWenv = containerUpdateCWenv container
|
||||
updateCWenv = getUpdateCWenv container
|
||||
useScissor = containerUseScissor container
|
||||
offset = containerChildrenOffset container
|
||||
renderBefore = containerRender container
|
||||
renderAfter = containerRenderAfter container
|
||||
children = node ^. L.children
|
||||
viewport = node ^. L.info . L.viewport
|
||||
renderArea = node ^. L.info . L.renderArea
|
||||
pairs = Seq.mapWithIndex (,) children
|
||||
cwenv idx child = updateCWenv wenv idx child node
|
||||
|
@ -114,10 +114,10 @@ makeDraggable msg config = widget where
|
||||
newReqH = child ^. L.info . L.sizeReqH
|
||||
|
||||
resize :: ContainerResizeHandler s e
|
||||
resize wenv viewport renderArea children node = resized where
|
||||
resize wenv renderArea children node = resized where
|
||||
style = activeStyle wenv node
|
||||
contentArea = fromMaybe def (removeOuterBounds style renderArea)
|
||||
resized = (resultWidget node, Seq.singleton (contentArea, contentArea))
|
||||
resized = (resultWidget node, Seq.singleton contentArea)
|
||||
|
||||
defaultRender renderer wenv node =
|
||||
drawStyledAction renderer draggedRect style $ \_ -> do
|
||||
@ -131,7 +131,7 @@ makeDraggable msg config = widget where
|
||||
style = fromMaybe def (_dgcDragStyle config)
|
||||
transparency = fromMaybe 1 (_dgcTransparency config)
|
||||
cnode = Seq.index (_wnChildren node) 0
|
||||
Rect cx cy cw ch = cnode ^. L.info . L.viewport
|
||||
Rect cx cy cw ch = cnode ^. L.info . L.renderArea
|
||||
Point mx my = wenv ^. L.inputStatus . L.mousePos
|
||||
Point px py = wenv ^?! L.mainBtnPress . _Just . _2
|
||||
dim = fromMaybe (max cw ch) (_dgcMaxDim config)
|
||||
|
@ -92,10 +92,10 @@ makeDropTarget dropEvt config = widget where
|
||||
newReqH = child ^. L.info . L.sizeReqH
|
||||
|
||||
resize :: ContainerResizeHandler s e
|
||||
resize wenv viewport renderArea children node = resized where
|
||||
resize wenv renderArea children node = resized where
|
||||
style = activeStyle wenv node
|
||||
contentArea = fromMaybe def (removeOuterBounds style renderArea)
|
||||
resized = (resultWidget node, Seq.singleton (contentArea, contentArea))
|
||||
resized = (resultWidget node, Seq.singleton contentArea)
|
||||
|
||||
isDropTarget wenv node = case wenv ^. L.dragStatus of
|
||||
Just (path, msg) -> not (isNodeParentOfPath path node) && isValidMsg msg
|
||||
|
@ -309,12 +309,12 @@ makeDropdown widgetData items makeMain makeRow config state = widget where
|
||||
path = node ^. L.info . L.path
|
||||
focusedPath = wenv ^. L.focusedPath
|
||||
|
||||
openRequired point node = not isOpen && inViewport where
|
||||
inViewport = pointInRect point (node ^. L.info . L.viewport)
|
||||
openRequired point node = not isOpen && inRenderArea where
|
||||
inRenderArea = pointInRect point (node ^. L.info . L.renderArea)
|
||||
|
||||
closeRequired point node = isOpen && not inOverlay where
|
||||
inOverlay = case Seq.lookup listIdx (node ^. L.children) of
|
||||
Just node -> pointInRect point (node ^. L.info . L.viewport)
|
||||
Just node -> pointInRect point (node ^. L.info . L.renderArea)
|
||||
Nothing -> False
|
||||
|
||||
openDropdown wenv node = resultReqs newNode requests where
|
||||
@ -367,7 +367,7 @@ makeDropdown widgetData items makeMain makeRow config state = widget where
|
||||
newReqW = sizeReqMergeMax mainReqW listReqW
|
||||
newReqH = mainReqH
|
||||
|
||||
resize wenv viewport renderArea children node = resized where
|
||||
resize wenv renderArea children node = resized where
|
||||
Size winW winH = _weWindowSize wenv
|
||||
Rect rx ry rw rh = renderArea
|
||||
theme = activeTheme wenv node
|
||||
@ -376,7 +376,7 @@ makeDropdown widgetData items makeMain makeRow config state = widget where
|
||||
| ry - dh >= 0 = ry - dh
|
||||
| otherwise = 0
|
||||
!listArea = case Seq.lookup 1 children of
|
||||
Just child -> (oViewport, oRenderArea) where
|
||||
Just child -> oRenderArea where
|
||||
maxHeightTheme = theme ^. L.dropdownMaxHeight
|
||||
cfgMaxHeight = _ddcMaxHeight config
|
||||
-- Avoid having an invisible list if style/theme as not set
|
||||
@ -385,21 +385,17 @@ makeDropdown widgetData items makeMain makeRow config state = widget where
|
||||
maxHeight = min winH (min reqHeight maxHeightStyle)
|
||||
dy = dropdownY maxHeight
|
||||
dh = maxHeight
|
||||
!oViewport = viewport {
|
||||
_rY = dy,
|
||||
_rH = dh
|
||||
}
|
||||
!oRenderArea = renderArea {
|
||||
_rY = dy,
|
||||
_rH = dh
|
||||
}
|
||||
Nothing -> (viewport, renderArea)
|
||||
!mainArea = (viewport, renderArea)
|
||||
Nothing -> renderArea
|
||||
!mainArea = renderArea
|
||||
assignedAreas = Seq.fromList [mainArea, listArea]
|
||||
resized = (resultWidget node, assignedAreas)
|
||||
|
||||
render renderer wenv node = do
|
||||
drawInScissor renderer True viewport $
|
||||
drawInScissor renderer True renderArea $
|
||||
drawStyledAction renderer renderArea style $ \contentArea -> do
|
||||
widgetRender (mainNode ^. L.widget) renderer wenv mainNode
|
||||
renderArrow renderer style contentArea
|
||||
@ -409,7 +405,6 @@ makeDropdown widgetData items makeMain makeRow config state = widget where
|
||||
renderOverlay renderer wenv (fromJust listViewOverlay)
|
||||
where
|
||||
style = activeStyle wenv node
|
||||
viewport = node ^. L.info . L.viewport
|
||||
renderArea = node ^. L.info . L.renderArea
|
||||
mainNode = Seq.index (node ^. L.children) mainIdx
|
||||
listViewOverlay = Seq.lookup listIdx (node ^. L.children)
|
||||
|
@ -48,7 +48,7 @@ makeFixedGrid isHorizontal = widget where
|
||||
nreqs = Seq.length vreqs
|
||||
maxSize = foldl1 sizeReqMergeMax vreqs
|
||||
|
||||
resize wenv viewport renderArea children node = resized where
|
||||
resize wenv renderArea children node = resized where
|
||||
style = activeStyle wenv node
|
||||
contentArea = fromMaybe def (removeOuterBounds style renderArea)
|
||||
Rect l t w h = contentArea
|
||||
@ -64,11 +64,11 @@ makeFixedGrid isHorizontal = widget where
|
||||
| cols > 0 = t + fromIntegral (i `div` cols) * ch
|
||||
| otherwise = 0
|
||||
foldHelper (currAreas, index) child = (newAreas, newIndex) where
|
||||
(newIndex, newViewport)
|
||||
| child ^. L.info . L.visible = (index + 1, calcViewport index)
|
||||
(newIndex, newRenderArea)
|
||||
| child ^. L.info . L.visible = (index + 1, calcRenderArea index)
|
||||
| otherwise = (index, def)
|
||||
newArea = (newViewport, newViewport)
|
||||
newArea = newRenderArea
|
||||
newAreas = currAreas |> newArea
|
||||
calcViewport i = Rect (cx i) (cy i) cw ch
|
||||
calcRenderArea i = Rect (cx i) (cy i) cw ch
|
||||
assignedAreas = fst $ foldl' foldHelper (Seq.empty, 0) children
|
||||
resized = (resultWidget node, assignedAreas)
|
||||
|
@ -82,9 +82,9 @@ centeredSquare (Rect x y w h) = Rect newX newY dim dim where
|
||||
newY = y + (h - dim) / 2
|
||||
|
||||
drawIcon :: Renderer -> StyleState -> IconType -> Rect -> Double -> IO ()
|
||||
drawIcon renderer style iconType viewport lw = case iconType of
|
||||
drawIcon renderer style iconType renderArea lw = case iconType of
|
||||
IconClose ->
|
||||
drawTimesX renderer viewport lw (Just fgColor)
|
||||
drawTimesX renderer renderArea lw (Just fgColor)
|
||||
IconPlus -> do
|
||||
beginPath renderer
|
||||
setFillColor renderer fgColor
|
||||
@ -97,7 +97,7 @@ drawIcon renderer style iconType viewport lw = case iconType of
|
||||
renderRect renderer (Rect x (cy - hw) w lw)
|
||||
fill renderer
|
||||
where
|
||||
Rect x y w h = viewport
|
||||
Rect x y w h = renderArea
|
||||
fgColor = fromMaybe (rgb 0 0 0) (style ^. L.fgColor)
|
||||
hw = lw / 2
|
||||
cx = x + w / 2
|
||||
|
@ -420,7 +420,7 @@ makeInputField config state = widget where
|
||||
newState = tmpState { _ifsDragSelActive = True }
|
||||
newNode = node
|
||||
& L.widget .~ makeInputField config newState
|
||||
reqs = [RenderEvery widgetId caretMs Nothing, StartTextInput viewport]
|
||||
reqs = [RenderEvery widgetId caretMs Nothing, StartTextInput renderArea]
|
||||
newResult = resultReqs newNode reqs
|
||||
focusResult = handleFocusChange _ifcOnFocus _ifcOnFocusReq config newNode
|
||||
result = maybe newResult (newResult <>) focusResult
|
||||
@ -438,7 +438,7 @@ makeInputField config state = widget where
|
||||
where
|
||||
path = node ^. L.info . L.path
|
||||
widgetId = node ^. L.info . L.widgetId
|
||||
viewport = node ^. L.info . L.viewport
|
||||
renderArea = node ^. L.info . L.renderArea
|
||||
focused = isNodeFocused wenv node
|
||||
dragSelectText btn
|
||||
= wenv ^. L.mainButton == btn
|
||||
@ -509,10 +509,9 @@ makeInputField config state = widget where
|
||||
factor = 1
|
||||
sizeReq = (FlexSize targetW factor, FixedSize h)
|
||||
|
||||
resize wenv viewport renderArea node = resultWidget newNode where
|
||||
-- newTextState depends on having correct viewport/renderArea in the node
|
||||
resize wenv renderArea node = resultWidget newNode where
|
||||
-- newTextState depends on having correct renderArea in the node
|
||||
tempNode = node
|
||||
& L.info . L.viewport .~ viewport
|
||||
& L.info . L.renderArea .~ renderArea
|
||||
newState = newTextState wenv tempNode state currVal currText currPos currSel
|
||||
newNode = tempNode
|
||||
|
@ -113,10 +113,10 @@ makeKeystroke bindings config = widget where
|
||||
newReqH = child ^. L.info . L.sizeReqH
|
||||
|
||||
resize :: ContainerResizeHandler s e
|
||||
resize wenv viewport renderArea children node = resized where
|
||||
resize wenv renderArea children node = resized where
|
||||
style = activeStyle wenv node
|
||||
contentArea = fromMaybe def (removeOuterBounds style renderArea)
|
||||
resized = (resultWidget node, Seq.singleton (contentArea, contentArea))
|
||||
resized = (resultWidget node, Seq.singleton contentArea)
|
||||
|
||||
keyStrokeActive :: WidgetEnv s e -> KeyCode -> KeyStroke -> Bool
|
||||
keyStrokeActive wenv code ks = currValid && allPressed && validMods where
|
||||
|
@ -149,7 +149,7 @@ makeLabel config state = widget where
|
||||
| abs factorH < 0.01 = FixedSize h
|
||||
| otherwise = FlexSize h factorH
|
||||
|
||||
resize wenv viewport renderArea node = resultWidget newNode where
|
||||
resize wenv renderArea node = resultWidget newNode where
|
||||
style = activeStyle wenv node
|
||||
rect = fromMaybe def (removeOuterBounds style renderArea)
|
||||
newTextStyle = style ^. L.text
|
||||
|
@ -398,11 +398,11 @@ makeListView widgetData items makeRow config state = widget where
|
||||
newSizeReqW = _wniSizeReqW . _wnInfo $ child
|
||||
newSizeReqH = _wniSizeReqH . _wnInfo $ child
|
||||
|
||||
resize wenv viewport renderArea children node = resized where
|
||||
resize wenv renderArea children node = resized where
|
||||
newState = state { _resizeReq = False }
|
||||
newNode = node
|
||||
& L.widget .~ makeListView widgetData items makeRow config newState
|
||||
assignedArea = Seq.singleton (viewport, renderArea)
|
||||
assignedArea = Seq.singleton renderArea
|
||||
resized = (resultWidget newNode, assignedArea)
|
||||
|
||||
updateStyles
|
||||
|
@ -205,42 +205,29 @@ makeNode widget managedWidget = defaultWidgetNode "scroll" widget
|
||||
|
||||
makeScroll :: ScrollCfg -> ScrollState -> Widget s e
|
||||
makeScroll config state = widget where
|
||||
baseWidget = createContainer state def {
|
||||
widget = createContainer state def {
|
||||
containerChildrenOffset = Just offset,
|
||||
containerUseScissor = True,
|
||||
containerGetBaseStyle = getBaseStyle,
|
||||
containerUpdateCWenv = updateCWenv,
|
||||
containerRestore = restore,
|
||||
containerUpdateEvent = updateEvent,
|
||||
containerHandleEvent = handleEvent,
|
||||
containerHandleMessage = handleMessage,
|
||||
containerGetSizeReq = getSizeReq,
|
||||
containerResize = resize
|
||||
}
|
||||
widget = baseWidget {
|
||||
widgetRender = render
|
||||
containerResize = resize,
|
||||
containerRenderAfter = renderAfter
|
||||
}
|
||||
|
||||
ScrollState dragging dx dy cs = state
|
||||
Size childWidth childHeight = cs
|
||||
offset = Point dx dy
|
||||
|
||||
getBaseStyle wenv node = _scStyle config >>= handler where
|
||||
handler lstyle = Just $ collectTheme wenv (cloneLens lstyle)
|
||||
|
||||
updateCWenv wenv cidx cnode node = newWenv where
|
||||
offset = Point dx dy
|
||||
viewport = node ^. L.info . L.viewport
|
||||
newWenv = wenv
|
||||
& L.viewport .~ moveRect (negPoint offset) viewport
|
||||
& L.inputStatus . L.mousePos %~ addPoint (negPoint offset)
|
||||
& L.inputStatus . L.mousePosPrev %~ addPoint (negPoint offset)
|
||||
& L.offset .~ offset
|
||||
|
||||
restore wenv oldState oldNode node = resultWidget newNode where
|
||||
newNode = node
|
||||
& L.widget .~ makeScroll config oldState
|
||||
|
||||
updateEvent wenv evt node = translateEvent (negPoint offset) evt where
|
||||
offset = Point dx dy
|
||||
|
||||
handleEvent wenv target evt node = case evt of
|
||||
ButtonAction point btn status _ -> result where
|
||||
leftPressed = status == PressedBtn && btn == wenv ^. L.mainButton
|
||||
@ -311,9 +298,10 @@ makeScroll config state = widget where
|
||||
handleScrollMessage (ScrollTo rect) = scrollTo wenv node rect
|
||||
result = cast message >>= handleScrollMessage
|
||||
|
||||
scrollTo wenv node rect = result where
|
||||
scrollTo wenv node targetRect = result where
|
||||
style = scrollActiveStyle wenv node
|
||||
contentArea = getContentArea style node
|
||||
rect = moveRect offset targetRect
|
||||
Rect rx ry rw rh = rect
|
||||
Rect cx cy cw ch = contentArea
|
||||
diffL = cx - rx
|
||||
@ -356,13 +344,8 @@ makeScroll config state = widget where
|
||||
}
|
||||
|
||||
rebuildWidget wenv newState node = result where
|
||||
ScrollState _ dx dy _ = newState
|
||||
offset = Point dx dy
|
||||
pviewport = node ^. L.info . L.viewport
|
||||
cviewport = moveRect (negPoint offset) pviewport
|
||||
newNode = node
|
||||
& L.widget .~ makeScroll config newState
|
||||
& L.children . ix 0 . L.info . L.viewport .~ cviewport
|
||||
result = resultWidget newNode
|
||||
|
||||
getSizeReq :: ContainerGetSizeReqHandler s e a
|
||||
@ -377,7 +360,7 @@ makeScroll config state = widget where
|
||||
sizeReq = (FlexSize w factor, FlexSize h factor)
|
||||
|
||||
resize :: ContainerResizeHandler s e
|
||||
resize wenv viewport renderArea children node = result where
|
||||
resize wenv renderArea children node = result where
|
||||
style = scrollActiveStyle wenv node
|
||||
scrollType = fromMaybe ScrollBoth (_scScrollType config)
|
||||
|
||||
@ -398,7 +381,6 @@ makeScroll config state = widget where
|
||||
newDx = scrollAxis dx areaW cw
|
||||
newDy = scrollAxis dy areaH ch
|
||||
cRenderArea = Rect cl ct areaW areaH
|
||||
cViewport = fromMaybe def (intersectRects viewport cRenderArea)
|
||||
newState = state {
|
||||
_sstDeltaX = newDx,
|
||||
_sstDeltaY = newDy,
|
||||
@ -406,21 +388,7 @@ makeScroll config state = widget where
|
||||
}
|
||||
newNode = resultWidget $ node
|
||||
& L.widget .~ makeScroll config newState
|
||||
result = (newNode, Seq.singleton (cViewport, cRenderArea))
|
||||
|
||||
render renderer wenv node =
|
||||
drawInScissor renderer True viewport $
|
||||
drawStyledAction renderer renderArea style $ \_ -> do
|
||||
drawInTranslation renderer offset $
|
||||
widgetRender (child ^. L.widget) renderer cwenv child
|
||||
renderAfter renderer wenv node
|
||||
where
|
||||
style = scrollActiveStyle wenv node
|
||||
child = node ^. L.children ^?! ix 0
|
||||
viewport = node ^. L.info . L.viewport
|
||||
renderArea = node ^. L.info . L.renderArea
|
||||
cwenv = updateCWenv wenv 0 child node
|
||||
offset = Point dx dy
|
||||
result = (newNode, Seq.singleton cRenderArea)
|
||||
|
||||
renderAfter renderer wenv node = do
|
||||
when hScrollRequired $
|
||||
|
@ -100,7 +100,6 @@ type SingleGetSizeReqHandler s e a
|
||||
type SingleResizeHandler s e
|
||||
= WidgetEnv s e
|
||||
-> Rect
|
||||
-> Rect
|
||||
-> WidgetNode s e
|
||||
-> WidgetResult s e
|
||||
|
||||
@ -271,7 +270,6 @@ loadStateHandler single wenv oldInfo newNode nodeHandler = newResult where
|
||||
getBaseStyle = singleGetBaseStyle single
|
||||
tempNode = newNode
|
||||
& L.info . L.widgetId .~ oldInfo ^. L.widgetId
|
||||
& L.info . L.viewport .~ oldInfo ^. L.viewport
|
||||
& L.info . L.renderArea .~ oldInfo ^. L.renderArea
|
||||
& L.info . L.sizeReqW .~ oldInfo ^. L.sizeReqW
|
||||
& L.info . L.sizeReqH .~ oldInfo ^. L.sizeReqH
|
||||
@ -404,29 +402,23 @@ handleSizeReqChange single wenv node evt mResult = result where
|
||||
| otherwise = mResult
|
||||
|
||||
defaultResize :: SingleResizeHandler s e
|
||||
defaultResize wenv viewport renderArea node = resultWidget node
|
||||
defaultResize wenv renderArea node = resultWidget node
|
||||
|
||||
resizeHandlerWrapper
|
||||
:: Single s e a
|
||||
-> WidgetEnv s e
|
||||
-> Rect
|
||||
-> Rect
|
||||
-> WidgetNode s e
|
||||
-> WidgetResult s e
|
||||
resizeHandlerWrapper single wenv viewport renderArea node = result where
|
||||
resizeHandlerWrapper single wenv renderArea node = result where
|
||||
useCustomSize = singleUseCustomSize single
|
||||
handler = singleResize single
|
||||
tmpRes = handler wenv viewport renderArea node
|
||||
lensVp = L.info . L.viewport
|
||||
tmpRes = handler wenv renderArea node
|
||||
lensRa = L.info . L.renderArea
|
||||
newVp
|
||||
| useCustomSize = tmpRes ^. L.node . lensVp
|
||||
| otherwise = viewport
|
||||
newRa
|
||||
| useCustomSize = tmpRes ^. L.node . lensRa
|
||||
| otherwise = renderArea
|
||||
result = tmpRes
|
||||
& L.node . L.info . L.viewport .~ newVp
|
||||
& L.node . L.info . L.renderArea .~ newRa
|
||||
|
||||
defaultRender :: SingleRenderHandler s e
|
||||
@ -439,12 +431,11 @@ renderWrapper
|
||||
-> WidgetNode s e
|
||||
-> IO ()
|
||||
renderWrapper single renderer wenv node =
|
||||
drawInScissor renderer useScissor viewport $
|
||||
drawInScissor renderer useScissor renderArea $
|
||||
drawStyledAction renderer renderArea style $ \_ ->
|
||||
handler renderer wenv node
|
||||
where
|
||||
handler = singleRender single
|
||||
useScissor = singleUseScissor single
|
||||
style = singleGetActiveStyle single wenv node
|
||||
viewport = node ^. L.info . L.viewport
|
||||
renderArea = node ^. L.info . L.renderArea
|
||||
|
@ -177,7 +177,7 @@ makeSplit isHorizontal config state = widget where
|
||||
}
|
||||
tmpNode = node
|
||||
& L.widget .~ makeSplit isHorizontal config newState
|
||||
newNode = widgetResize (tmpNode ^. L.widget) wenv vp ra tmpNode
|
||||
newNode = widgetResize (tmpNode ^. L.widget) wenv ra tmpNode
|
||||
resultDrag
|
||||
| handlePos /= newHandlePos = newNode
|
||||
& L.requests <>~ Seq.fromList [cursorIconReq, RenderOnce]
|
||||
@ -188,7 +188,6 @@ makeSplit isHorizontal config state = widget where
|
||||
maxSize = _spsMaxSize state
|
||||
handlePos = _spsHandlePos state
|
||||
handleRect = _spsHandleRect state
|
||||
vp = node ^. L.info . L.viewport
|
||||
ra = node ^. L.info . L.renderArea
|
||||
children = node ^. L.children
|
||||
isTarget = target == node ^. L.info . L.path
|
||||
@ -214,7 +213,7 @@ makeSplit isHorizontal config state = widget where
|
||||
| isHorizontal = foldl1 sizeReqMergeMax [reqH1, reqH2]
|
||||
| otherwise = foldl1 sizeReqMergeSum [reqWS, reqH1, reqH2]
|
||||
|
||||
resize wenv viewport renderArea children node = resized where
|
||||
resize wenv renderArea children node = resized where
|
||||
style = activeStyle wenv node
|
||||
contentArea = fromMaybe def (removeOuterBounds style renderArea)
|
||||
Rect rx ry rw rh = contentArea
|
||||
@ -260,8 +259,7 @@ makeSplit isHorizontal config state = widget where
|
||||
& L.events .~ Seq.fromList events
|
||||
& L.requests .~ Seq.fromList (requestPos ++ reqOnChange)
|
||||
newRas = Seq.fromList [rect1, rect2]
|
||||
assignedArea = Seq.zip newRas newRas
|
||||
resized = (result, assignedArea)
|
||||
resized = (result, newRas)
|
||||
|
||||
getValidHandlePos maxDim rect point children = addPoint origin newPoint where
|
||||
Rect rx ry _ _ = rect
|
||||
|
@ -91,19 +91,17 @@ makeStack isHorizontal config = widget where
|
||||
where
|
||||
vreqs = accesor <$> vchildren
|
||||
|
||||
resize wenv viewport renderArea children node = resized where
|
||||
resize wenv renderArea children node = resized where
|
||||
style = activeStyle wenv node
|
||||
contentArea = fromMaybe def (removeOuterBounds style renderArea)
|
||||
(newViewports, newDim) = assignStackAreas isHorizontal contentArea children
|
||||
(newRas, newDim) = assignStackAreas isHorizontal contentArea children
|
||||
newCa
|
||||
| isHorizontal = contentArea & L.w .~ newDim
|
||||
| otherwise = contentArea & L.h .~ newDim
|
||||
newRa = fromMaybe newCa (addOuterBounds style newCa)
|
||||
newRenderArea = fromMaybe newCa (addOuterBounds style newCa)
|
||||
newNode = node
|
||||
& L.info . L.viewport .~ newRa
|
||||
& L.info . L.renderArea .~ newRa
|
||||
assignedArea = Seq.zip newViewports newViewports
|
||||
resized = (resultWidget newNode, assignedArea)
|
||||
& L.info . L.renderArea .~ newRenderArea
|
||||
resized = (resultWidget newNode, newRas)
|
||||
|
||||
assignStackAreas :: Bool -> Rect -> Seq (WidgetNode s e) -> (Seq Rect, Double)
|
||||
assignStackAreas isHorizontal contentArea children = result where
|
||||
|
@ -41,7 +41,7 @@ makeTheme theme = widget where
|
||||
newReqH = child ^. L.info . L.sizeReqH
|
||||
|
||||
resize :: ContainerResizeHandler s e
|
||||
resize wenv viewport renderArea children node = resized where
|
||||
resize wenv renderArea children node = resized where
|
||||
style = activeStyle wenv node
|
||||
contentArea = fromMaybe def (removeOuterBounds style renderArea)
|
||||
resized = (resultWidget node, Seq.singleton (contentArea, contentArea))
|
||||
resized = (resultWidget node, Seq.singleton contentArea)
|
||||
|
@ -145,8 +145,8 @@ makeTooltip caption config state = widget where
|
||||
newReqH = child ^. L.info . L.sizeReqH
|
||||
|
||||
resize :: ContainerResizeHandler s e
|
||||
resize wenv viewport renderArea children node = resized where
|
||||
resized = (resultWidget node, Seq.singleton (renderArea, renderArea))
|
||||
resize wenv renderArea children node = resized where
|
||||
resized = (resultWidget node, Seq.singleton renderArea)
|
||||
|
||||
render renderer wenv node = do
|
||||
forM_ children $ \child ->
|
||||
@ -187,7 +187,7 @@ makeTooltip caption config state = widget where
|
||||
tooltipDisplayed wenv node = displayed where
|
||||
TooltipState lastPos lastPosTs = state
|
||||
ts = wenv ^. L.timestamp
|
||||
viewport = node ^. L.info . L.viewport
|
||||
inViewport = pointInRect lastPos viewport
|
||||
renderArea = node ^. L.info . L.renderArea
|
||||
inRenderArea = pointInRect lastPos renderArea
|
||||
delayEllapsed = ts - lastPosTs >= delay
|
||||
displayed = inViewport && delayEllapsed
|
||||
displayed = inRenderArea && delayEllapsed
|
||||
|
@ -24,16 +24,16 @@ import Monomer.Graphics.Types
|
||||
import qualified Monomer.Lens as L
|
||||
|
||||
isPointInNodeVp :: Point -> WidgetNode s e -> Bool
|
||||
isPointInNodeVp p node = pointInRect p (node ^. L.info . L.viewport)
|
||||
isPointInNodeVp p node = pointInRect p (node ^. L.info . L.renderArea)
|
||||
|
||||
isPointInNodeEllipse :: Point -> WidgetNode s e -> Bool
|
||||
isPointInNodeEllipse p node = pointInEllipse p (node ^. L.info . L.viewport)
|
||||
isPointInNodeEllipse p node = pointInEllipse p (node ^. L.info . L.renderArea)
|
||||
|
||||
isNodeActive :: WidgetEnv s e -> WidgetNode s e -> Bool
|
||||
isNodeActive wenv node = validPos && pressed where
|
||||
viewport = node ^. L.info . L.viewport
|
||||
renderArea = node ^. L.info . L.renderArea
|
||||
mousePos = wenv ^. L.inputStatus . L.mousePos
|
||||
validPos = pointInRect mousePos viewport
|
||||
validPos = pointInRect mousePos renderArea
|
||||
pressed = isNodePressed wenv node
|
||||
|
||||
isNodePressed :: WidgetEnv s e -> WidgetNode s e -> Bool
|
||||
@ -49,9 +49,9 @@ isNodeDragged wenv node = mainPressed && draggedPath == Just nodePath where
|
||||
|
||||
isNodeHovered :: WidgetEnv s e -> WidgetNode s e -> Bool
|
||||
isNodeHovered wenv node = validPos && validPress && topLevel where
|
||||
viewport = node ^. L.info . L.viewport
|
||||
renderArea = node ^. L.info . L.renderArea
|
||||
mousePos = wenv ^. L.inputStatus . L.mousePos
|
||||
validPos = pointInRect mousePos viewport
|
||||
validPos = pointInRect mousePos renderArea
|
||||
pressed = wenv ^. L.mainBtnPress ^? _Just . _1
|
||||
validPress = isNothing pressed || isNodePressed wenv node
|
||||
topLevel = isNodeTopLevel wenv node
|
||||
|
@ -46,11 +46,12 @@ defaultWidgetNode widgetType widget = WidgetNode {
|
||||
_wnChildren = Seq.empty
|
||||
}
|
||||
|
||||
isWidgetVisible :: WidgetNode s e -> Rect -> Bool
|
||||
isWidgetVisible node vp = isVisible && isOverlapped where
|
||||
isWidgetVisible :: WidgetEnv s e -> WidgetNode s e -> Bool
|
||||
isWidgetVisible wenv node = isVisible && isOverlapped where
|
||||
info = node ^. L.info
|
||||
isVisible = info ^. L.visible
|
||||
isOverlapped = rectsOverlap vp (info ^. L.viewport)
|
||||
viewport = wenv ^. L.viewport
|
||||
isOverlapped = rectsOverlap viewport (info ^. L.renderArea)
|
||||
|
||||
visibleChildrenChanged :: WidgetNode s e -> WidgetNode s e -> Bool
|
||||
visibleChildrenChanged oldNode newNode = oldVisible /= newVisible where
|
||||
|
@ -144,21 +144,19 @@ makeZStack config state = widget where
|
||||
where
|
||||
vreqs = accesor <$> vchildren
|
||||
|
||||
resize wenv viewport renderArea children node = resized where
|
||||
resize wenv renderArea children node = resized where
|
||||
style = activeStyle wenv node
|
||||
raChild = fromMaybe def (removeOuterBounds style renderArea)
|
||||
vpChild = fromMaybe def (intersectRects viewport raChild)
|
||||
assignedAreas = fmap (const (vpChild, raChild)) children
|
||||
assignedAreas = fmap (const raChild) children
|
||||
resized = (resultWidget node, assignedAreas)
|
||||
|
||||
render renderer wenv node =
|
||||
drawInScissor renderer True viewport $
|
||||
drawInScissor renderer True renderArea $
|
||||
drawStyledAction renderer renderArea style $ \_ ->
|
||||
void $ Seq.traverseWithIndex renderChild children
|
||||
where
|
||||
style = activeStyle wenv node
|
||||
children = Seq.reverse $ node ^. L.children
|
||||
viewport = node ^. L.info . L.viewport
|
||||
renderArea = node ^. L.info . L.renderArea
|
||||
isVisible c = c ^. L.info . L.visible
|
||||
topVisibleIdx = fromMaybe 0 (Seq.findIndexR (_wniVisible . _wnInfo) children)
|
||||
|
@ -132,7 +132,9 @@ mockWenv model = WidgetEnv {
|
||||
_weModel = model,
|
||||
_weInputStatus = def,
|
||||
_weTimestamp = 0,
|
||||
_weInTopLayer = const True
|
||||
_weInTopLayer = const True,
|
||||
_weViewport = Rect 0 0 testW testH,
|
||||
_weOffset = def
|
||||
}
|
||||
|
||||
mockWenvEvtUnit :: s -> WidgetEnv s ()
|
||||
@ -153,9 +155,9 @@ nodeGetSizeReq wenv node = (sizeReqW, sizeReqH) where
|
||||
sizeReqH = node2 ^. L.info . L.sizeReqH
|
||||
|
||||
nodeResize :: WidgetEnv s e -> Rect -> WidgetNode s e -> WidgetNode s e
|
||||
nodeResize wenv viewport node = result ^. L.node where
|
||||
nodeResize wenv renderArea node = result ^. L.node where
|
||||
widget = node ^. L.widget
|
||||
result = widgetResize widget wenv viewport viewport node
|
||||
result = widgetResize widget wenv renderArea node
|
||||
|
||||
nodeHandleEventCtx
|
||||
:: (Eq s)
|
||||
|
@ -98,14 +98,14 @@ resize = describe "resize" $ do
|
||||
|
||||
resizeDefault :: Spec
|
||||
resizeDefault = describe "default" $ do
|
||||
it "should have the provided viewport size" $
|
||||
viewport `shouldBe` vp
|
||||
it "should have the provided renderArea size" $
|
||||
renderArea `shouldBe` vp
|
||||
|
||||
it "should have one child" $
|
||||
children `shouldSatisfy` (== 1) . Seq.length
|
||||
|
||||
it "should have its children assigned a viewport" $
|
||||
cViewport `shouldBe` cvp
|
||||
it "should have its children assigned a renderArea" $
|
||||
cRenderArea `shouldBe` cvp
|
||||
|
||||
where
|
||||
wenv = mockWenv ()
|
||||
@ -114,38 +114,38 @@ resizeDefault = describe "default" $ do
|
||||
boxNode = box (label "Label")
|
||||
newNode = nodeInit wenv boxNode
|
||||
children = newNode ^. L.children
|
||||
viewport = newNode ^. L.info . L.viewport
|
||||
cViewport = getChildVp wenv []
|
||||
renderArea = newNode ^. L.info . L.renderArea
|
||||
cRenderArea = getChildRa wenv []
|
||||
|
||||
resizeExpand :: Spec
|
||||
resizeExpand = describe "expand" $
|
||||
it "should have its children assigned a viewport" $
|
||||
cViewport `shouldBe` vp
|
||||
it "should have its children assigned a valid renderArea" $
|
||||
cRenderArea `shouldBe` vp
|
||||
|
||||
where
|
||||
wenv = mockWenv ()
|
||||
vp = Rect 0 0 640 480
|
||||
cViewport = getChildVp wenv [expandContent]
|
||||
cRenderArea = getChildRa wenv [expandContent]
|
||||
|
||||
resizeAlign :: Spec
|
||||
resizeAlign = describe "align" $ do
|
||||
it "should align its child left" $
|
||||
childVpL `shouldBe` cvpl
|
||||
childRaL `shouldBe` cvpl
|
||||
|
||||
it "should align its child right" $
|
||||
childVpR `shouldBe` cvpr
|
||||
childRaR `shouldBe` cvpr
|
||||
|
||||
it "should align its child top" $
|
||||
childVpT `shouldBe` cvpt
|
||||
childRaT `shouldBe` cvpt
|
||||
|
||||
it "should align its child bottom" $
|
||||
childVpB `shouldBe` cvpb
|
||||
childRaB `shouldBe` cvpb
|
||||
|
||||
it "should align its child top-left" $
|
||||
childVpTL `shouldBe` cvplt
|
||||
childRaTL `shouldBe` cvplt
|
||||
|
||||
it "should align its child bottom-right" $
|
||||
childVpBR `shouldBe` cvpbr
|
||||
childRaBR `shouldBe` cvpbr
|
||||
|
||||
where
|
||||
wenv = mockWenv ()
|
||||
@ -155,15 +155,15 @@ resizeAlign = describe "align" $ do
|
||||
cvpb = Rect 295 460 50 20
|
||||
cvplt = Rect 0 0 50 20
|
||||
cvpbr = Rect 590 460 50 20
|
||||
childVpL = getChildVp wenv [alignLeft]
|
||||
childVpR = getChildVp wenv [alignRight]
|
||||
childVpT = getChildVp wenv [alignTop]
|
||||
childVpB = getChildVp wenv [alignBottom]
|
||||
childVpTL = getChildVp wenv [alignTop, alignLeft]
|
||||
childVpBR = getChildVp wenv [alignBottom, alignRight]
|
||||
childRaL = getChildRa wenv [alignLeft]
|
||||
childRaR = getChildRa wenv [alignRight]
|
||||
childRaT = getChildRa wenv [alignTop]
|
||||
childRaB = getChildRa wenv [alignBottom]
|
||||
childRaTL = getChildRa wenv [alignTop, alignLeft]
|
||||
childRaBR = getChildRa wenv [alignBottom, alignRight]
|
||||
|
||||
getChildVp :: Eq s => WidgetEnv s e -> [BoxCfg s e] -> Rect
|
||||
getChildVp wenv cfgs = childLC ^. L.info . L.viewport where
|
||||
getChildRa :: Eq s => WidgetEnv s e -> [BoxCfg s e] -> Rect
|
||||
getChildRa wenv cfgs = childLC ^. L.info . L.renderArea where
|
||||
lblNode = label "Label"
|
||||
boxNodeLC = nodeInit wenv (box_ cfgs lblNode)
|
||||
childLC = Seq.index (boxNodeLC ^. L.children) 0
|
||||
|
@ -38,7 +38,7 @@ import qualified Monomer.Widgets.Single as SG
|
||||
data MainEvt
|
||||
= MainBtnClicked
|
||||
| ChildClicked
|
||||
| MainResize (Rect, Rect)
|
||||
| MainResize Rect
|
||||
deriving (Eq, Show)
|
||||
|
||||
data ChildEvt
|
||||
@ -112,7 +112,7 @@ handleEventBasic = describe "handleEventBasic" $ do
|
||||
model [evtClick (Point 10 10)] ^. clicks `shouldBe` 1
|
||||
|
||||
it "should generate a resize event on init" $
|
||||
events [] `shouldBe` Seq.fromList [MainResize (vp, vp)]
|
||||
events [] `shouldBe` Seq.fromList [MainResize vp]
|
||||
|
||||
where
|
||||
wenv = mockWenv def
|
||||
@ -317,11 +317,8 @@ getSizeReq = describe "getSizeReq" $ do
|
||||
|
||||
resize :: Spec
|
||||
resize = describe "resize" $ do
|
||||
it "should have the provided viewport size" $
|
||||
viewport `shouldBe` vp
|
||||
|
||||
it "should assign the same viewport size to its child" $
|
||||
childrenVp `shouldBe` Seq.singleton cvp1
|
||||
it "should have the provided renderArea size" $
|
||||
renderArea `shouldBe` vp
|
||||
|
||||
it "should assign the same renderArea size to its child" $
|
||||
childrenRa `shouldBe` Seq.singleton cvp1
|
||||
@ -336,6 +333,5 @@ resize = describe "resize" $ do
|
||||
cmpNode = composite "main" id buildUI handleEvent
|
||||
tmpNode = nodeInit wenv cmpNode
|
||||
newNode = widgetSave (tmpNode ^. L.widget) wenv tmpNode
|
||||
viewport = newNode ^. L.info . L.viewport
|
||||
childrenVp = (^. L.info . L.viewport) <$> newNode ^. L.children
|
||||
renderArea = newNode ^. L.info . L.renderArea
|
||||
childrenRa = (^. L.info . L.renderArea) <$> newNode ^. L.children
|
||||
|
@ -118,8 +118,8 @@ resize = describe "resize" $ do
|
||||
|
||||
resizeEmpty :: Spec
|
||||
resizeEmpty = describe "empty" $ do
|
||||
it "should have the provided viewport size" $
|
||||
viewport `shouldBe` vp
|
||||
it "should have the provided renderArea size" $
|
||||
renderArea `shouldBe` vp
|
||||
|
||||
it "should not have children" $
|
||||
children `shouldSatisfy` Seq.null
|
||||
@ -129,16 +129,13 @@ resizeEmpty = describe "empty" $ do
|
||||
vp = Rect 0 0 640 480
|
||||
gridNode = vgrid []
|
||||
newNode = nodeInit wenv gridNode
|
||||
viewport = newNode ^. L.info . L.viewport
|
||||
renderArea = newNode ^. L.info . L.renderArea
|
||||
children = newNode ^. L.children
|
||||
|
||||
resizeItemsH :: Spec
|
||||
resizeItemsH = describe "several items, horizontal" $ do
|
||||
it "should have the provided viewport size" $
|
||||
viewport `shouldBe` vp
|
||||
|
||||
it "should assign the same viewport size to each children" $
|
||||
childrenVp `shouldBe` Seq.fromList [cvp1, cvp2, cvp3]
|
||||
it "should have the provided renderArea size" $
|
||||
renderArea `shouldBe` vp
|
||||
|
||||
it "should assign the same renderArea size to each children" $
|
||||
childrenRa `shouldBe` Seq.fromList [cvp1, cvp2, cvp3]
|
||||
@ -155,17 +152,13 @@ resizeItemsH = describe "several items, horizontal" $ do
|
||||
label "Label 3"
|
||||
]
|
||||
newNode = nodeInit wenv gridNode
|
||||
viewport = newNode ^. L.info . L.viewport
|
||||
childrenVp = (^. L.info . L.viewport) <$> newNode ^. L.children
|
||||
renderArea = newNode ^. L.info . L.renderArea
|
||||
childrenRa = (^. L.info . L.renderArea) <$> newNode ^. L.children
|
||||
|
||||
resizeItemsV :: Spec
|
||||
resizeItemsV = describe "several items, vertical, one not visible" $ do
|
||||
it "should have the provided viewport size" $
|
||||
viewport `shouldBe` vp
|
||||
|
||||
it "should assign the same viewport size to each children" $
|
||||
childrenVp `shouldBe` Seq.fromList [cvp1, cvp2, cvp3, cvp4]
|
||||
it "should have the provided renderArea size" $
|
||||
renderArea `shouldBe` vp
|
||||
|
||||
it "should assign the same renderArea size to each children" $
|
||||
childrenRa `shouldBe` Seq.fromList [cvp1, cvp2, cvp3, cvp4]
|
||||
@ -184,6 +177,5 @@ resizeItemsV = describe "several items, vertical, one not visible" $ do
|
||||
label "Label 3"
|
||||
]
|
||||
newNode = nodeInit wenv gridNode
|
||||
viewport = newNode ^. L.info . L.viewport
|
||||
childrenVp = (^. L.info . L.viewport) <$> newNode ^. L.children
|
||||
renderArea = newNode ^. L.info . L.renderArea
|
||||
childrenRa = (^. L.info . L.renderArea) <$> newNode ^. L.children
|
||||
|
@ -21,11 +21,8 @@ spec = describe "Scroll"
|
||||
|
||||
resize :: Spec
|
||||
resize = describe "resize" $ do
|
||||
it "should have the provided viewport size" $
|
||||
viewport `shouldBe` vp
|
||||
|
||||
it "should assign the same viewport scroll has" $
|
||||
childrenVp `shouldBe` Seq.fromList [cvp1]
|
||||
it "should have the provided renderArea size" $
|
||||
renderArea `shouldBe` vp
|
||||
|
||||
it "should assign all the requested space" $
|
||||
childrenRa `shouldBe` Seq.fromList [cra1]
|
||||
@ -37,6 +34,5 @@ resize = describe "resize" $ do
|
||||
cra1 = Rect 0 0 3000 2000
|
||||
scrollNode = scroll (label "" `style` [width 3000, height 2000])
|
||||
newNode = nodeInit wenv scrollNode
|
||||
viewport = newNode ^. L.info . L.viewport
|
||||
childrenVp = roundRectUnits . _wniViewport . _wnInfo <$> newNode ^. L.children
|
||||
renderArea = newNode ^. L.info . L.renderArea
|
||||
childrenRa = roundRectUnits . _wniRenderArea . _wnInfo <$> newNode ^. L.children
|
||||
|
@ -73,8 +73,8 @@ resize = describe "resize" $ do
|
||||
|
||||
resizeEmpty :: Spec
|
||||
resizeEmpty = describe "empty" $ do
|
||||
it "should have the provided viewport size" $
|
||||
viewport `shouldBe` vp
|
||||
it "should have the provided renderArea size" $
|
||||
renderArea `shouldBe` vp
|
||||
|
||||
it "should not have children" $
|
||||
children `shouldSatisfy` Seq.null
|
||||
@ -85,16 +85,13 @@ resizeEmpty = describe "empty" $ do
|
||||
vp = Rect 0 0 640 0
|
||||
vstackNode = vstack []
|
||||
newNode = nodeInit wenv vstackNode
|
||||
viewport = newNode ^. L.info . L.viewport
|
||||
renderArea = newNode ^. L.info . L.renderArea
|
||||
children = newNode ^. L.children
|
||||
|
||||
resizeFlexibleH :: Spec
|
||||
resizeFlexibleH = describe "flexible items, horizontal" $ do
|
||||
it "should have the provided viewport size" $
|
||||
viewport `shouldBe` vp
|
||||
|
||||
it "should assign size proportional to requested size to each children" $
|
||||
childrenVp `shouldBe` Seq.fromList [cvp1, cvp2, cvp3]
|
||||
it "should have the provided renderArea size" $
|
||||
renderArea `shouldBe` vp
|
||||
|
||||
it "should assign size proportional to requested size to each children" $
|
||||
childrenRa `shouldBe` Seq.fromList [cvp1, cvp2, cvp3]
|
||||
@ -111,17 +108,13 @@ resizeFlexibleH = describe "flexible items, horizontal" $ do
|
||||
label "Label 3"
|
||||
]
|
||||
newNode = nodeInit wenv hstackNode
|
||||
viewport = newNode ^. L.info . L.viewport
|
||||
childrenVp = roundRectUnits . _wniViewport . _wnInfo <$> newNode ^. L.children
|
||||
renderArea = newNode ^. L.info . L.renderArea
|
||||
childrenRa = roundRectUnits . _wniRenderArea . _wnInfo <$> newNode ^. L.children
|
||||
|
||||
resizeFlexibleV :: Spec
|
||||
resizeFlexibleV = describe "flexible items, vertical" $ do
|
||||
it "should have the provided viewport size" $
|
||||
viewport `shouldBe` vp
|
||||
|
||||
it "should assign size proportional to requested size to each children" $
|
||||
childrenVp `shouldBe` Seq.fromList [cvp1, cvp2, cvp3]
|
||||
it "should have the provided renderArea size" $
|
||||
renderArea `shouldBe` vp
|
||||
|
||||
it "should assign size proportional to requested size to each children" $
|
||||
childrenRa `shouldBe` Seq.fromList [cvp1, cvp2, cvp3]
|
||||
@ -138,14 +131,13 @@ resizeFlexibleV = describe "flexible items, vertical" $ do
|
||||
label "Label 3" `style` [flexHeight 20]
|
||||
]
|
||||
newNode = nodeInit wenv vstackNode
|
||||
viewport = newNode ^. L.info . L.viewport
|
||||
childrenVp = (^. L.info . L.viewport) <$> newNode ^. L.children
|
||||
renderArea = newNode ^. L.info . L.renderArea
|
||||
childrenRa = (^. L.info . L.renderArea) <$> newNode ^. L.children
|
||||
|
||||
resizeStrictFlexH :: Spec
|
||||
resizeStrictFlexH = describe "strict/flexible items, horizontal" $ do
|
||||
it "should have the provided viewport size" $
|
||||
viewport `shouldBe` vp
|
||||
it "should have the provided renderArea size" $
|
||||
renderArea `shouldBe` vp
|
||||
|
||||
it "should assign requested size to the main labels and the rest to grid" $
|
||||
childrenVp `shouldBe` Seq.fromList [cvp1, cvp2, cvp3]
|
||||
@ -165,17 +157,14 @@ resizeStrictFlexH = describe "strict/flexible items, horizontal" $ do
|
||||
label "Label 3"
|
||||
]
|
||||
newNode = nodeInit wenv hstackNode
|
||||
viewport = newNode ^. L.info . L.viewport
|
||||
childrenVp = (^. L.info . L.viewport) <$> newNode ^. L.children
|
||||
renderArea = newNode ^. L.info . L.renderArea
|
||||
childrenVp = (^. L.info . L.renderArea) <$> newNode ^. L.children
|
||||
childrenRa = (^. L.info . L.renderArea) <$> newNode ^. L.children
|
||||
|
||||
resizeStrictFlexV :: Spec
|
||||
resizeStrictFlexV = describe "strict/flexible items, vertical" $ do
|
||||
it "should have the provided viewport size" $
|
||||
viewport `shouldBe` vp
|
||||
|
||||
it "should assign requested size to the main labels and the rest to grid" $
|
||||
childrenVp `shouldBe` Seq.fromList [cvp1, cvp2, cvp3]
|
||||
it "should have the provided renderArea size" $
|
||||
renderArea `shouldBe` vp
|
||||
|
||||
it "should assign requested size to the main labels and the rest to grid" $
|
||||
childrenRa `shouldBe` Seq.fromList [cvp1, cvp2, cvp3]
|
||||
@ -192,17 +181,13 @@ resizeStrictFlexV = describe "strict/flexible items, vertical" $ do
|
||||
label "Label 3" `style` [flexHeight 100]
|
||||
]
|
||||
newNode = nodeInit wenv vstackNode
|
||||
viewport = newNode ^. L.info . L.viewport
|
||||
childrenVp = (^. L.info . L.viewport) <$> newNode ^. L.children
|
||||
renderArea = newNode ^. L.info . L.renderArea
|
||||
childrenRa = (^. L.info . L.renderArea) <$> newNode ^. L.children
|
||||
|
||||
resizeMixedH :: Spec
|
||||
resizeMixedH = describe "mixed items, horizontal" $ do
|
||||
it "should have the provided viewport size" $
|
||||
viewport `shouldBe` vp
|
||||
|
||||
it "should assign size proportional to requested size to each children" $
|
||||
childrenVp `shouldBe` Seq.fromList [cvp1, cvp2]
|
||||
it "should have the provided renderArea size" $
|
||||
renderArea `shouldBe` vp
|
||||
|
||||
it "should assign size proportional to requested size to each children" $
|
||||
childrenRa `shouldBe` Seq.fromList [cvp1, cvp2]
|
||||
@ -219,18 +204,14 @@ resizeMixedH = describe "mixed items, horizontal" $ do
|
||||
]
|
||||
]
|
||||
newNode = nodeInit wenv hstackNode
|
||||
viewport = newNode ^. L.info . L.viewport
|
||||
renderArea = newNode ^. L.info . L.renderArea
|
||||
firstChild = Seq.index (newNode ^. L.children) 0
|
||||
childrenVp = roundRectUnits . _wniViewport . _wnInfo <$> firstChild ^. L.children
|
||||
childrenRa = roundRectUnits . _wniRenderArea . _wnInfo <$> firstChild ^. L.children
|
||||
|
||||
resizeMixedV :: Spec
|
||||
resizeMixedV = describe "mixed items, vertical" $ do
|
||||
it "should have the provided viewport size" $
|
||||
viewport `shouldBe` vp
|
||||
|
||||
it "should assign size proportional to requested size to each children" $
|
||||
childrenVp `shouldBe` Seq.fromList [cvp1, cvp2, cvp3]
|
||||
it "should have the provided renderArea size" $
|
||||
renderArea `shouldBe` vp
|
||||
|
||||
it "should assign size proportional to requested size to each children" $
|
||||
childrenRa `shouldBe` Seq.fromList [cvp1, cvp2, cvp3]
|
||||
@ -249,18 +230,14 @@ resizeMixedV = describe "mixed items, vertical" $ do
|
||||
]
|
||||
]
|
||||
newNode = nodeInit wenv vstackNode
|
||||
viewport = newNode ^. L.info . L.viewport
|
||||
renderArea = newNode ^. L.info . L.renderArea
|
||||
firstChild = Seq.index (newNode ^. L.children) 0
|
||||
childrenVp = roundRectUnits . _wniViewport . _wnInfo <$> firstChild ^. L.children
|
||||
childrenRa = roundRectUnits . _wniRenderArea . _wnInfo <$> firstChild ^. L.children
|
||||
|
||||
resizeAllV :: Spec
|
||||
resizeAllV = describe "all kinds of sizeReq, vertical" $ do
|
||||
it "should have the provided viewport size" $
|
||||
viewport `shouldBe` vp
|
||||
|
||||
it "should assign size proportional to requested size to each children" $
|
||||
childrenVp `shouldBe` Seq.fromList [cvp1, cvp2, cvp3, cvp4, cvp5]
|
||||
it "should have the provided renderArea size" $
|
||||
renderArea `shouldBe` vp
|
||||
|
||||
it "should assign size proportional to requested size to each children" $
|
||||
childrenRa `shouldBe` Seq.fromList [cvp1, cvp2, cvp3, cvp4, cvp5]
|
||||
@ -281,18 +258,14 @@ resizeAllV = describe "all kinds of sizeReq, vertical" $ do
|
||||
label "Label 5" `style` [rangeWidth 90 100, rangeHeight 90 100]
|
||||
]
|
||||
newNode = nodeInit wenv vstackNode
|
||||
viewport = newNode ^. L.info . L.viewport
|
||||
childrenVp = roundRectUnits . _wniViewport . _wnInfo <$> newNode ^. L.children
|
||||
renderArea = newNode ^. L.info . L.renderArea
|
||||
childrenRa = roundRectUnits . _wniRenderArea . _wnInfo <$> newNode ^. L.children
|
||||
|
||||
resizeNoSpaceV :: Spec
|
||||
resizeNoSpaceV = describe "vertical, without enough space" $ do
|
||||
it "should have a larger viewport size (parent should fix it)" $ do
|
||||
viewport `shouldBe` vp
|
||||
it "should have a larger renderArea size (parent should fix it)" $ do
|
||||
renderArea `shouldBe` vp
|
||||
renderArea `shouldBe` vp
|
||||
|
||||
it "should assign size proportional to requested size to each children" $
|
||||
childrenVp `shouldBe` Seq.fromList [cvp1, cvp2, cvp3, cvp4, cvp5]
|
||||
|
||||
it "should assign size proportional to requested size to each children" $
|
||||
childrenRa `shouldBe` Seq.fromList [cvp1, cvp2, cvp3, cvp4, cvp5]
|
||||
@ -313,18 +286,13 @@ resizeNoSpaceV = describe "vertical, without enough space" $ do
|
||||
label "Label 5" `style` [height 200]
|
||||
]
|
||||
newNode = nodeInit wenv vstackNode
|
||||
viewport = newNode ^. L.info . L.viewport
|
||||
renderArea = newNode ^. L.info . L.renderArea
|
||||
childrenVp = roundRectUnits . _wniViewport . _wnInfo <$> newNode ^. L.children
|
||||
childrenRa = roundRectUnits . _wniRenderArea . _wnInfo <$> newNode ^. L.children
|
||||
|
||||
resizeSpacerFlexH :: Spec
|
||||
resizeSpacerFlexH = describe "label flex and spacer, horizontal" $ do
|
||||
it "should have the provided viewport size" $
|
||||
roundRectUnits viewport `shouldBe` vp
|
||||
|
||||
it "should assign size proportional to requested size to each children" $
|
||||
childrenVp `shouldBe` Seq.fromList [cvp1, cvp2, cvp3]
|
||||
it "should have the provided renderArea size" $
|
||||
roundRectUnits renderArea `shouldBe` vp
|
||||
|
||||
it "should assign size proportional to requested size to each children" $
|
||||
childrenRa `shouldBe` Seq.fromList [cvp1, cvp2, cvp3]
|
||||
@ -341,17 +309,13 @@ resizeSpacerFlexH = describe "label flex and spacer, horizontal" $ do
|
||||
label "Label" `style` [flexWidth 200]
|
||||
]
|
||||
newNode = nodeInit wenv hstackNode
|
||||
viewport = newNode ^. L.info . L.viewport
|
||||
childrenVp = roundRectUnits . _wniViewport . _wnInfo <$> newNode ^. L.children
|
||||
renderArea = newNode ^. L.info . L.renderArea
|
||||
childrenRa = roundRectUnits . _wniRenderArea . _wnInfo <$> newNode ^. L.children
|
||||
|
||||
resizeSpacerFixedH :: Spec
|
||||
resizeSpacerFixedH = describe "label fixed and spacer, horizontal" $ do
|
||||
it "should have the provided viewport size" $
|
||||
viewport `shouldBe` vp
|
||||
|
||||
it "should assign size proportional to requested size to each children" $
|
||||
childrenVp `shouldBe` Seq.fromList [cvp1, cvp2, cvp3]
|
||||
it "should have the provided renderArea size" $
|
||||
renderArea `shouldBe` vp
|
||||
|
||||
it "should assign size proportional to requested size to each children" $
|
||||
childrenRa `shouldBe` Seq.fromList [cvp1, cvp2, cvp3]
|
||||
@ -368,6 +332,5 @@ resizeSpacerFixedH = describe "label fixed and spacer, horizontal" $ do
|
||||
label "Label" `style` [width 200]
|
||||
]
|
||||
newNode = nodeInit wenv hstackNode
|
||||
viewport = newNode ^. L.info . L.viewport
|
||||
childrenVp = roundRectUnits . _wniViewport . _wnInfo <$> newNode ^. L.children
|
||||
renderArea = newNode ^. L.info . L.renderArea
|
||||
childrenRa = roundRectUnits . _wniRenderArea . _wnInfo <$> newNode ^. L.children
|
||||
|
@ -159,7 +159,7 @@ handleEventValue = describe "handleEventValue" $ do
|
||||
|
||||
handleEventMouseSelect :: Spec
|
||||
handleEventMouseSelect = describe "handleEventMouseSelect" $ do
|
||||
it "should add text at the end, since click + drag started outside of viewport" $ do
|
||||
it "should add text at the end, since click + drag started outside of renderArea" $ do
|
||||
let str = "This is text"
|
||||
let selStart = Point 50 100
|
||||
let selEnd = Point 120 10
|
||||
|
@ -129,11 +129,10 @@ createStyleState size col = Just newState where
|
||||
|
||||
createNode :: Bool -> WidgetNode s e
|
||||
createNode enabled = newNode where
|
||||
viewport = Rect 100 100 200 200
|
||||
renderArea = Rect 100 100 200 200
|
||||
newNode = label "Test"
|
||||
& L.info . L.path .~ Seq.fromList [0]
|
||||
& L.info . L.viewport .~ viewport
|
||||
& L.info . L.renderArea .~ viewport
|
||||
& L.info . L.renderArea .~ renderArea
|
||||
& L.info . L.style .~ createStyle
|
||||
& L.info . L.visible .~ True
|
||||
& L.info . L.enabled .~ enabled
|
||||
|
@ -248,8 +248,8 @@ resize = describe "resize" $ do
|
||||
|
||||
resizeEmpty :: Spec
|
||||
resizeEmpty = describe "empty" $ do
|
||||
it "should have the provided viewport size" $
|
||||
viewport `shouldBe` vp
|
||||
it "should have the provided renderArea size" $
|
||||
renderArea `shouldBe` vp
|
||||
|
||||
it "should not have children" $
|
||||
children `shouldSatisfy` Seq.null
|
||||
@ -259,16 +259,13 @@ resizeEmpty = describe "empty" $ do
|
||||
vp = Rect 0 0 640 480
|
||||
zstackNode = zstack []
|
||||
newNode = nodeInit wenv zstackNode
|
||||
viewport = newNode ^. L.info . L.viewport
|
||||
renderArea = newNode ^. L.info . L.renderArea
|
||||
children = newNode ^. L.children
|
||||
|
||||
resizeItems :: Spec
|
||||
resizeItems = describe "several items, horizontal" $ do
|
||||
it "should have the provided viewport size" $
|
||||
viewport `shouldBe` vp
|
||||
|
||||
it "should assign the same viewport size to each children" $
|
||||
childrenVp `shouldBe` Seq.fromList [vp, vp, vp]
|
||||
it "should have the provided renderArea size" $
|
||||
renderArea `shouldBe` vp
|
||||
|
||||
it "should assign the same renderArea size to each children" $
|
||||
childrenRa `shouldBe` Seq.fromList [vp, vp, vp]
|
||||
@ -282,6 +279,5 @@ resizeItems = describe "several items, horizontal" $ do
|
||||
label "Label 3"
|
||||
]
|
||||
newNode = nodeInit wenv zstackNode
|
||||
viewport = newNode ^. L.info . L.viewport
|
||||
childrenVp = (^. L.info . L.viewport) <$> newNode ^. L.children
|
||||
renderArea = newNode ^. L.info . L.renderArea
|
||||
childrenRa = (^. L.info . L.renderArea) <$> newNode ^. L.children
|
||||
|
Loading…
Reference in New Issue
Block a user