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

Rename references of renderArea to viewport

Browse Source
This commit is contained in:
Francisco Vallarino 2021-02-01 18:27:37 -03:00
parent 99d6856ac3
commit ed80c5bb6d
39 changed files with 264 additions and 269 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Monomer/Core/StyleUtil.hs
View File

@ -54,7 +54,7 @@ visible node visibility = node & L.info . L.visible .~ visibility
getContentArea :: StyleState -> WidgetNode s e -> Rect
getContentArea style node = fromMaybe def area where
area = removeOuterBounds style (node ^. L.info . L.renderArea)
area = removeOuterBounds style (node ^. L.info . L.viewport)
instance CmbStyle Style where
style oldStyle states = newStyle where

4
src/Monomer/Core/Util.hs
View File

@ -29,7 +29,7 @@ nodeDesc level node = infoDesc (_wnInfo node) where
infoDesc info =
spaces ++ "type: " ++ unWidgetType (_wniWidgetType info) ++ "\n" ++
spaces ++ "path: " ++ show (_wniPath info) ++ "\n" ++
spaces ++ "ra: " ++ rectDesc (_wniRenderArea info) ++ "\n" ++
spaces ++ "vp: " ++ rectDesc (_wniViewport info) ++ "\n" ++
spaces ++ "req: " ++ show (_wniSizeReqW info, _wniSizeReqH info) ++ "\n"
rectDesc r = show (_rX r, _rY r, _rW r, _rH r)
@ -44,7 +44,7 @@ nodeInstDesc level node = infoDesc (_winInfo node) where
infoDesc info =
spaces ++ "type: " ++ unWidgetType (_wniWidgetType info) ++ "\n" ++
spaces ++ "path: " ++ show (_wniPath info) ++ "\n" ++
spaces ++ "ra: " ++ rectDesc (_wniRenderArea info) ++ "\n" ++
spaces ++ "vp: " ++ rectDesc (_wniViewport info) ++ "\n" ++
spaces ++ "req: " ++ show (_wniSizeReqW info, _wniSizeReqH info) ++ "\n"
rectDesc r = show (_rX r, _rY r, _rW r, _rH r)

4
src/Monomer/Core/WidgetTypes.hs
View File

@ -201,7 +201,7 @@ data WidgetNodeInfo =
-- | Indicates whether the widget can receive focus
_wniFocusable :: !Bool,
-- | The area of the screen where the widget can draw
_wniRenderArea :: !Rect,
_wniViewport :: !Rect,
-- | Style attributes of the widget instance
_wniStyle :: Style
} deriving (Eq, Show, Generic, Serialise)
@ -217,7 +217,7 @@ instance Default WidgetNodeInfo where
_wniEnabled = True,
_wniVisible = True,
_wniFocusable = False,
_wniRenderArea = def,
_wniViewport = def,
_wniStyle = def
}

6
src/Monomer/Widgets/Box.hs
View File

@ -147,7 +147,7 @@ makeBox config = widget where
handleEvent wenv target evt node = case evt of
Click point btn -> result where
child = Seq.index (node ^. L.children) 0
childClicked = pointInRect point (child ^. L.info . L.renderArea)
childClicked = pointInRect point (child ^. L.info . L.viewport)
events
| childClicked = _boxOnClick config
| otherwise = _boxOnClickEmpty config
@ -167,9 +167,9 @@ makeBox config = widget where
newReqH = child ^. L.info . L.sizeReqH
resize :: ContainerResizeHandler s e
resize wenv renderArea children node = resized where
resize wenv viewport children node = resized where
style = activeStyle wenv node
contentArea = fromMaybe def (removeOuterBounds style renderArea)
contentArea = fromMaybe def (removeOuterBounds style viewport)
Rect cx cy cw ch = contentArea
child = Seq.index children 0
contentW = sizeReqMaxBounded $ child ^. L.info . L.sizeReqW

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

@ -243,9 +243,9 @@ makeButton config state = widget where
| abs factorH < 0.01 = FixedSize h
| otherwise = FlexSize h factorH
resize wenv renderArea node = resultWidget newNode where
resize wenv viewport node = resultWidget newNode where
style = activeStyle wenv node
rect = fromMaybe def (removeOuterBounds style renderArea)
rect = fromMaybe def (removeOuterBounds style viewport)
newTextStyle = style ^. L.text
Rect px py pw ph = textRect
Rect nx ny nw nh = rect

6
src/Monomer/Widgets/Checkbox.hs
View File

@ -172,11 +172,11 @@ makeCheckbox widgetData config = widget where
theme = activeTheme wenv node
style = activeStyle wenv node
value = widgetDataGet model widgetData
rarea = getContentArea style node
carea = getContentArea style node
checkboxW = fromMaybe (theme ^. L.checkboxWidth) (_ckcWidth config)
checkboxBW = max 1 (checkboxW * 0.1)
checkboxL = _rX rarea + (_rW rarea - checkboxW) / 2
checkboxT = _rY rarea + (_rH rarea - checkboxW) / 2
checkboxL = _rX carea + (_rW carea - checkboxW) / 2
checkboxT = _rY carea + (_rH carea - checkboxW) / 2
checkboxArea = Rect checkboxL checkboxT checkboxW checkboxW
fgColor = styleFgColor style
mark = fromMaybe CheckboxSquare (_ckcMark config)

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

@ -370,7 +370,7 @@ 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.renderArea .~ oldComp ^. L.info . L.renderArea
& L.info . L.viewport .~ oldComp ^. L.info . L.viewport
& L.info . L.sizeReqW .~ oldComp ^. L.info . L.sizeReqW
& L.info . L.sizeReqH .~ oldComp ^. L.info . L.sizeReqH
visibleEvts = if visibleChg then _cmpOnVisibleChange comp else []
@ -453,7 +453,7 @@ 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.renderArea .~ oldInfo ^. L.renderArea
& L.node . L.info . L.viewport .~ oldInfo ^. L.viewport
& L.node . L.info . L.sizeReqW .~ oldInfo ^. L.sizeReqW
& L.node . L.info . L.sizeReqH .~ oldInfo ^. L.sizeReqH
| otherwise = throw (AssertionFailed $ "Restore failed. " ++ message)
@ -572,25 +572,25 @@ compositeResize
-> Rect
-> WidgetNode sp ep
-> WidgetResult sp ep
compositeResize comp state wenv renderArea widgetComp = resized where
compositeResize comp state wenv viewport widgetComp = resized where
CompositeState{..} = state
style = activeStyle wenv widgetComp
contentArea = fromMaybe def (removeOuterBounds style renderArea)
contentArea = fromMaybe def (removeOuterBounds style viewport)
widget = _cpsRoot ^. L.widget
model = getModel comp wenv
cwenv = convertWidgetEnv wenv _cpsGlobalKeys model
tmpRes = widgetResize widget cwenv contentArea _cpsRoot
oldRa = widgetComp ^. L.info . L.renderArea
sizeChanged = renderArea /= oldRa
resizeEvts = fmap ($ renderArea) (_cmpOnResize comp)
oldRa = widgetComp ^. L.info . L.viewport
sizeChanged = viewport /= oldRa
resizeEvts = fmap ($ viewport) (_cmpOnResize comp)
newEvts
| sizeChanged = Seq.fromList resizeEvts
| otherwise = Empty
newRes = reduceResult comp state wenv widgetComp $ tmpRes
& L.node . L.info . L.renderArea .~ contentArea
& L.node . L.info . L.viewport .~ contentArea
& L.events .~ tmpRes ^. L.events <> newEvts
resized = newRes
& L.node . L.info . L.renderArea .~ renderArea
& L.node . L.info . L.viewport .~ viewport
-- Render
compositeRender

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

@ -265,9 +265,9 @@ getUpdateCWenv container wenv cidx cnode node = newWenv where
updateCWenv = containerUpdateCWenv container
offset = fromMaybe def cOffset
accumOffset = wenv ^. L.offset
renderArea = node ^. L.info . L.renderArea
viewport = node ^. L.info . L.viewport
tmpWenv = wenv
& L.viewport .~ moveRect (negPoint accumOffset) renderArea
& L.viewport .~ moveRect (negPoint accumOffset) viewport
& L.inputStatus . L.mousePos %~ addPoint (negPoint offset)
& L.inputStatus . L.mousePosPrev %~ addPoint (negPoint offset)
& L.offset %~ addPoint offset
@ -372,7 +372,7 @@ mergeParent mergeHandler wenv oldState oldNode newNode = result where
oldInfo = oldNode ^. L.info
tempNode = newNode
& L.info . L.widgetId .~ oldInfo ^. L.widgetId
& L.info . L.renderArea .~ oldInfo ^. L.renderArea
& L.info . L.viewport .~ oldInfo ^. L.viewport
& L.info . L.sizeReqW .~ oldInfo ^. L.sizeReqW
& L.info . L.sizeReqH .~ oldInfo ^. L.sizeReqH
result = case useState oldState of
@ -504,7 +504,7 @@ restoreWrapper container wenv win newNode = newResult where
oldInfo = win ^. L.info
tempNode = newNode
& L.info . L.widgetId .~ oldInfo ^. L.widgetId
& L.info . L.renderArea .~ oldInfo ^. L.renderArea
& L.info . L.viewport .~ oldInfo ^. L.viewport
& L.info . L.sizeReqW .~ oldInfo ^. L.sizeReqW
& L.info . L.sizeReqH .~ oldInfo ^. L.sizeReqH
styledNode = initNodeStyle getBaseStyle wenv tempNode
@ -607,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.renderArea)
pointInWidget wi = wi ^. L.visible && pointInRect point (wi ^. L.viewport)
result = Seq.findIndexL (pointInWidget . _wnInfo) children
findByPointWrapper
@ -795,7 +795,7 @@ handleSizeReqChange container wenv node evt mResult = result where
-- | Resize
defaultResize :: ContainerResizeHandler s e
defaultResize wenv renderArea children node = newSize where
defaultResize wenv viewport children node = newSize where
childrenSizes = Seq.replicate (Seq.length children) def
newSize = (resultWidget node, childrenSizes)
@ -805,33 +805,33 @@ resizeWrapper
-> Rect
-> WidgetNode s e
-> WidgetResult s e
resizeWrapper container wenv renderArea node = result where
resizeWrapper container wenv viewport node = result where
updateCWenv = getUpdateCWenv container
resizeRequired = containerResizeRequired container
useCustomSize = containerUseCustomSize container
useChildSize = containerUseChildrenSizes container
handler = containerResize container
lensRa = L.info . L.renderArea
raChanged = renderArea /= node ^. lensRa
lensVp = L.info . L.viewport
vpChanged = viewport /= node ^. lensVp
children = node ^. L.children
(tempRes, assigned) = handler wenv renderArea children node
resize idx (child, ra) = newChildRes where
(tempRes, assigned) = handler wenv viewport children node
resize idx (child, vp) = newChildRes where
cwenv = updateCWenv wenv idx child node
tempChildRes = widgetResize (child ^. L.widget) cwenv ra child
cra = tempChildRes ^. L.node . L.info . L.renderArea
icra = fromMaybe ra (intersectRects ra cra)
tempChildRes = widgetResize (child ^. L.widget) cwenv vp child
cvp = tempChildRes ^. L.node . L.info . L.viewport
icvp = fromMaybe vp (intersectRects vp cvp)
newChildRes = tempChildRes
& L.node . L.info . L.renderArea .~ (if useChildSize then icra else ra)
& L.node . L.info . L.viewport .~ (if useChildSize then icvp else vp)
newChildrenRes = Seq.mapWithIndex resize (Seq.zip children assigned)
newChildren = fmap _wrNode newChildrenRes
newChildrenReqs = foldMap _wrRequests newChildrenRes
newChildrenEvts = foldMap _wrEvents newChildrenRes
newRa
| useCustomSize = tempRes ^. L.node . lensRa
| otherwise = renderArea
newVp
| useCustomSize = tempRes ^. L.node . lensVp
| otherwise = viewport
result
| resizeRequired || raChanged = tempRes
& L.node . L.info . L.renderArea .~ newRa
| resizeRequired || vpChanged = tempRes
& L.node . L.info . L.viewport .~ newVp
& L.node . L.children .~ newChildren
& L.requests <>~ newChildrenReqs
& L.events <>~ newChildrenEvts
@ -848,8 +848,8 @@ renderWrapper
-> WidgetNode s e
-> IO ()
renderWrapper container renderer wenv node =
drawInScissor renderer useScissor renderArea $
drawStyledAction renderer renderArea style $ \_ -> do
drawInScissor renderer useScissor viewport $
drawStyledAction renderer viewport style $ \_ -> do
renderBefore renderer wenv node
when (isJust offset) $ do
@ -872,7 +872,7 @@ renderWrapper container renderer wenv node =
renderBefore = containerRender container
renderAfter = containerRenderAfter container
children = node ^. L.children
renderArea = node ^. L.info . L.renderArea
viewport = node ^. L.info . L.viewport
pairs = Seq.mapWithIndex (,) children
cwenv idx child = updateCWenv wenv idx child node

6
src/Monomer/Widgets/Dial.hs
View File

@ -306,9 +306,9 @@ getDialInfo :: WidgetEnv s e -> WidgetNode s e -> DialCfg s e a -> (Point, Rect)
getDialInfo wenv node config = (dialCenter, dialArea) where
theme = activeTheme wenv node
style = activeStyle wenv node
rarea = getContentArea style node
carea = getContentArea style node
dialW = fromMaybe (theme ^. L.dialWidth) (_dlcWidth config)
dialL = _rX rarea + (_rW rarea - dialW) / 2
dialT = _rY rarea + (_rH rarea - dialW) / 2
dialL = _rX carea + (_rW carea - dialW) / 2
dialT = _rY carea + (_rH carea - dialW) / 2
dialCenter = Point (dialL + dialW / 2) (dialT + dialW / 2)
dialArea = Rect dialL dialT dialW dialW

6
src/Monomer/Widgets/Draggable.hs
View File

@ -114,9 +114,9 @@ makeDraggable msg config = widget where
newReqH = child ^. L.info . L.sizeReqH
resize :: ContainerResizeHandler s e
resize wenv renderArea children node = resized where
resize wenv viewport children node = resized where
style = activeStyle wenv node
contentArea = fromMaybe def (removeOuterBounds style renderArea)
contentArea = fromMaybe def (removeOuterBounds style viewport)
resized = (resultWidget node, Seq.singleton contentArea)
defaultRender renderer wenv node =
@ -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.renderArea
Rect cx cy cw ch = cnode ^. L.info . L.viewport
Point mx my = wenv ^. L.inputStatus . L.mousePos
Point px py = wenv ^?! L.mainBtnPress . _Just . _2
dim = fromMaybe (max cw ch) (_dgcMaxDim config)

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

@ -92,9 +92,9 @@ makeDropTarget dropEvt config = widget where
newReqH = child ^. L.info . L.sizeReqH
resize :: ContainerResizeHandler s e
resize wenv renderArea children node = resized where
resize wenv viewport children node = resized where
style = activeStyle wenv node
contentArea = fromMaybe def (removeOuterBounds style renderArea)
contentArea = fromMaybe def (removeOuterBounds style viewport)
resized = (resultWidget node, Seq.singleton contentArea)
isDropTarget wenv node = case wenv ^. L.dragStatus of

24
src/Monomer/Widgets/Dropdown.hs
View File

@ -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 && inRenderArea where
inRenderArea = pointInRect point (node ^. L.info . L.renderArea)
openRequired point node = not isOpen && inViewport where
inViewport = pointInRect point (node ^. L.info . L.viewport)
closeRequired point node = isOpen && not inOverlay where
inOverlay = case Seq.lookup listIdx (node ^. L.children) of
Just node -> pointInRect point (node ^. L.info . L.renderArea)
Just node -> pointInRect point (node ^. L.info . L.viewport)
Nothing -> False
openDropdown wenv node = resultReqs newNode requests where
@ -367,16 +367,16 @@ makeDropdown widgetData items makeMain makeRow config state = widget where
newReqW = sizeReqMergeMax mainReqW listReqW
newReqH = mainReqH
resize wenv renderArea children node = resized where
resize wenv viewport children node = resized where
Size winW winH = _weWindowSize wenv
Rect rx ry rw rh = renderArea
Rect rx ry rw rh = viewport
theme = activeTheme wenv node
dropdownY dh
| ry + rh + dh <= winH = ry + rh
| ry - dh >= 0 = ry - dh
| otherwise = 0
!listArea = case Seq.lookup 1 children of
Just child -> oRenderArea where
Just child -> oViewport where
maxHeightTheme = theme ^. L.dropdownMaxHeight
cfgMaxHeight = _ddcMaxHeight config
-- Avoid having an invisible list if style/theme as not set
@ -385,18 +385,18 @@ makeDropdown widgetData items makeMain makeRow config state = widget where
maxHeight = min winH (min reqHeight maxHeightStyle)
dy = dropdownY maxHeight
dh = maxHeight
!oRenderArea = renderArea {
!oViewport = viewport {
_rY = dy,
_rH = dh
}
Nothing -> renderArea
!mainArea = renderArea
Nothing -> viewport
!mainArea = viewport
assignedAreas = Seq.fromList [mainArea, listArea]
resized = (resultWidget node, assignedAreas)
render renderer wenv node = do
drawInScissor renderer True renderArea $
drawStyledAction renderer renderArea style $ \contentArea -> do
drawInScissor renderer True viewport $
drawStyledAction renderer viewport style $ \contentArea -> do
widgetRender (mainNode ^. L.widget) renderer wenv mainNode
renderArrow renderer style contentArea
@ -405,7 +405,7 @@ makeDropdown widgetData items makeMain makeRow config state = widget where
renderOverlay renderer wenv (fromJust listViewOverlay)
where
style = activeStyle wenv node
renderArea = node ^. L.info . L.renderArea
viewport = node ^. L.info . L.viewport
mainNode = Seq.index (node ^. L.children) mainIdx
listViewOverlay = Seq.lookup listIdx (node ^. L.children)

12
src/Monomer/Widgets/Grid.hs
View File

@ -48,9 +48,9 @@ makeFixedGrid isHorizontal = widget where
nreqs = Seq.length vreqs
maxSize = foldl1 sizeReqMergeMax vreqs
resize wenv renderArea children node = resized where
resize wenv viewport children node = resized where
style = activeStyle wenv node
contentArea = fromMaybe def (removeOuterBounds style renderArea)
contentArea = fromMaybe def (removeOuterBounds style viewport)
Rect l t w h = contentArea
vchildren = Seq.filter (_wniVisible . _wnInfo) children
cols = if isHorizontal then length vchildren else 1
@ -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, newRenderArea)
| child ^. L.info . L.visible = (index + 1, calcRenderArea index)
(newIndex, newViewport)
| child ^. L.info . L.visible = (index + 1, calcViewport index)
| otherwise = (index, def)
newArea = newRenderArea
newArea = newViewport
newAreas = currAreas |> newArea
calcRenderArea i = Rect (cx i) (cy i) cw ch
calcViewport i = Rect (cx i) (cy i) cw ch
assignedAreas = fst $ foldl' foldHelper (Seq.empty, 0) children
resized = (resultWidget node, assignedAreas)

6
src/Monomer/Widgets/Icon.hs
View File

@ -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 renderArea lw = case iconType of
drawIcon renderer style iconType viewport lw = case iconType of
IconClose ->
drawTimesX renderer renderArea lw (Just fgColor)
drawTimesX renderer viewport lw (Just fgColor)
IconPlus -> do
beginPath renderer
setFillColor renderer fgColor
@ -97,7 +97,7 @@ drawIcon renderer style iconType renderArea lw = case iconType of
renderRect renderer (Rect x (cy - hw) w lw)
fill renderer
where
Rect x y w h = renderArea
Rect x y w h = viewport
fgColor = fromMaybe (rgb 0 0 0) (style ^. L.fgColor)
hw = lw / 2
cx = x + w / 2

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

@ -182,13 +182,13 @@ makeImage imgPath config state = widget where
imageExists = isJust (getImage renderer imgPath)
fitImage :: ImageFit -> Size -> Rect -> Rect
fitImage fitMode imageSize renderArea = case fitMode of
fitImage fitMode imageSize viewport = case fitMode of
FitNone -> Rect x y iw ih
FitFill -> Rect x y w h
FitWidth -> Rect x y w ih
FitHeight -> Rect x y iw h
where
Rect x y w h = renderArea
Rect x y w h = viewport
Size iw ih = imageSize
handleImageLoad :: WidgetEnv s e -> String -> IO ImageMessage

10
src/Monomer/Widgets/InputField.hs
View File

@ -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 renderArea]
reqs = [RenderEvery widgetId caretMs Nothing, StartTextInput viewport]
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
renderArea = node ^. L.info . L.renderArea
viewport = node ^. L.info . L.viewport
focused = isNodeFocused wenv node
dragSelectText btn
= wenv ^. L.mainButton == btn
@ -509,10 +509,10 @@ makeInputField config state = widget where
factor = 1
sizeReq = (FlexSize targetW factor, FixedSize h)
resize wenv renderArea node = resultWidget newNode where
-- newTextState depends on having correct renderArea in the node
resize wenv viewport node = resultWidget newNode where
-- newTextState depends on having correct viewport in the node
tempNode = node
& L.info . L.renderArea .~ renderArea
& L.info . L.viewport .~ viewport
newState = newTextState wenv tempNode state currVal currText currPos currSel
newNode = tempNode
& L.widget .~ makeInputField config newState

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

@ -113,9 +113,9 @@ makeKeystroke bindings config = widget where
newReqH = child ^. L.info . L.sizeReqH
resize :: ContainerResizeHandler s e
resize wenv renderArea children node = resized where
resize wenv viewport children node = resized where
style = activeStyle wenv node
contentArea = fromMaybe def (removeOuterBounds style renderArea)
contentArea = fromMaybe def (removeOuterBounds style viewport)
resized = (resultWidget node, Seq.singleton contentArea)
keyStrokeActive :: WidgetEnv s e -> KeyCode -> KeyStroke -> Bool

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

@ -149,9 +149,9 @@ makeLabel config state = widget where
| abs factorH < 0.01 = FixedSize h
| otherwise = FlexSize h factorH
resize wenv renderArea node = resultWidget newNode where
resize wenv viewport node = resultWidget newNode where
style = activeStyle wenv node
rect = fromMaybe def (removeOuterBounds style renderArea)
rect = fromMaybe def (removeOuterBounds style viewport)
newTextStyle = style ^. L.text
Rect px py pw ph = textRect
Rect nx ny nw nh = rect

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

@ -382,14 +382,14 @@ makeListView widgetData items makeRow config state = widget where
requests = valueSetReq ++ scrollToReq ++ changeReqs ++ resizeReq
result = resultReqsEvts newNode requests events
itemScrollTo node idx = maybeToList (fmap scrollReq renderArea) where
renderArea = itemRenderArea node idx
itemScrollTo node idx = maybeToList (fmap scrollReq viewport) where
viewport = itemViewport node idx
scrollPath = parentPath node
scrollReq rect = SendMessage scrollPath (ScrollTo rect)
itemRenderArea node idx = renderArea where
itemViewport node idx = viewport where
lookup idx node = Seq.lookup idx (node ^. L.children)
renderArea = fmap (_wniRenderArea . _wnInfo) $ pure node
viewport = fmap (_wniViewport . _wnInfo) $ pure node
>>= lookup 0 -- vstack
>>= lookup idx -- item
@ -398,11 +398,11 @@ makeListView widgetData items makeRow config state = widget where
newSizeReqW = _wniSizeReqW . _wnInfo $ child
newSizeReqH = _wniSizeReqH . _wnInfo $ child
resize wenv renderArea children node = resized where
resize wenv viewport children node = resized where
newState = state { _resizeReq = False }
newNode = node
& L.widget .~ makeListView widgetData items makeRow config newState
assignedArea = Seq.singleton renderArea
assignedArea = Seq.singleton viewport
resized = (resultWidget newNode, assignedArea)
updateStyles

8
src/Monomer/Widgets/Scroll.hs
View File

@ -360,11 +360,11 @@ makeScroll config state = widget where
sizeReq = (FlexSize w factor, FlexSize h factor)
resize :: ContainerResizeHandler s e
resize wenv renderArea children node = result where
resize wenv viewport children node = result where
style = scrollActiveStyle wenv node
scrollType = fromMaybe ScrollBoth (_scScrollType config)
Rect cl ct cw ch = fromMaybe def (removeOuterBounds style renderArea)
Rect cl ct cw ch = fromMaybe def (removeOuterBounds style viewport)
dx = _sstDeltaX state
dy = _sstDeltaY state
@ -380,7 +380,7 @@ makeScroll config state = widget where
| otherwise = max ch childHeight2
newDx = scrollAxis dx areaW cw
newDy = scrollAxis dy areaH ch
cRenderArea = Rect cl ct areaW areaH
cViewport = Rect cl ct areaW areaH
newState = state {
_sstDeltaX = newDx,
_sstDeltaY = newDy,
@ -388,7 +388,7 @@ makeScroll config state = widget where
}
newNode = resultWidget $ node
& L.widget .~ makeScroll config newState
result = (newNode, Seq.singleton cRenderArea)
result = (newNode, Seq.singleton cViewport)
renderAfter renderer wenv node = do
when hScrollRequired $

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

@ -270,7 +270,7 @@ loadStateHandler single wenv oldInfo newNode nodeHandler = newResult where
getBaseStyle = singleGetBaseStyle single
tempNode = newNode
& L.info . L.widgetId .~ oldInfo ^. L.widgetId
& L.info . L.renderArea .~ oldInfo ^. L.renderArea
& L.info . L.viewport .~ oldInfo ^. L.viewport
& L.info . L.sizeReqW .~ oldInfo ^. L.sizeReqW
& L.info . L.sizeReqH .~ oldInfo ^. L.sizeReqH
styledNode = initNodeStyle getBaseStyle wenv tempNode
@ -402,7 +402,7 @@ handleSizeReqChange single wenv node evt mResult = result where
| otherwise = mResult
defaultResize :: SingleResizeHandler s e
defaultResize wenv renderArea node = resultWidget node
defaultResize wenv viewport node = resultWidget node
resizeHandlerWrapper
:: Single s e a
@ -410,16 +410,16 @@ resizeHandlerWrapper
-> Rect
-> WidgetNode s e
-> WidgetResult s e
resizeHandlerWrapper single wenv renderArea node = result where
resizeHandlerWrapper single wenv viewport node = result where
useCustomSize = singleUseCustomSize single
handler = singleResize single
tmpRes = handler wenv renderArea node
lensRa = L.info . L.renderArea
newRa
| useCustomSize = tmpRes ^. L.node . lensRa
| otherwise = renderArea
tmpRes = handler wenv viewport node
lensVp = L.info . L.viewport
newVp
| useCustomSize = tmpRes ^. L.node . lensVp
| otherwise = viewport
result = tmpRes
& L.node . L.info . L.renderArea .~ newRa
& L.node . L.info . L.viewport .~ newVp
defaultRender :: SingleRenderHandler s e
defaultRender renderer wenv node = return ()
@ -431,11 +431,11 @@ renderWrapper
-> WidgetNode s e
-> IO ()
renderWrapper single renderer wenv node =
drawInScissor renderer useScissor renderArea $
drawStyledAction renderer renderArea style $ \_ ->
drawInScissor renderer useScissor viewport $
drawStyledAction renderer viewport style $ \_ ->
handler renderer wenv node
where
handler = singleRender single
useScissor = singleUseScissor single
style = singleGetActiveStyle single wenv node
renderArea = node ^. L.info . L.renderArea
viewport = node ^. L.info . L.viewport

20
src/Monomer/Widgets/Split.hs
View File

@ -167,17 +167,17 @@ makeSplit isHorizontal config state = widget where
| isTarget && isDragging -> Just resultDrag
| isTarget && isInHandle point -> Just resultHover
where
Point px py = getValidHandlePos maxSize ra point children
Point px py = getValidHandlePos maxSize vp point children
newHandlePos
| isHorizontal = (px - ra ^. L.x) / maxSize
| otherwise = (py - ra ^. L.y) / maxSize
| isHorizontal = (px - vp ^. L.x) / maxSize
| otherwise = (py - vp ^. L.y) / maxSize
newState = state {
_spsHandlePosUserSet = True,
_spsHandlePos = newHandlePos
}
tmpNode = node
& L.widget .~ makeSplit isHorizontal config newState
newNode = widgetResize (tmpNode ^. L.widget) wenv ra tmpNode
newNode = widgetResize (tmpNode ^. L.widget) wenv vp tmpNode
resultDrag
| handlePos /= newHandlePos = newNode
& L.requests <>~ Seq.fromList [cursorIconReq, RenderOnce]
@ -188,7 +188,7 @@ makeSplit isHorizontal config state = widget where
maxSize = _spsMaxSize state
handlePos = _spsHandlePos state
handleRect = _spsHandleRect state
ra = node ^. L.info . L.renderArea
vp = node ^. L.info . L.viewport
children = node ^. L.children
isTarget = target == node ^. L.info . L.path
isDragging = isNodePressed wenv node
@ -213,9 +213,9 @@ makeSplit isHorizontal config state = widget where
| isHorizontal = foldl1 sizeReqMergeMax [reqH1, reqH2]
| otherwise = foldl1 sizeReqMergeSum [reqWS, reqH1, reqH2]
resize wenv renderArea children node = resized where
resize wenv viewport children node = resized where
style = activeStyle wenv node
contentArea = fromMaybe def (removeOuterBounds style renderArea)
contentArea = fromMaybe def (removeOuterBounds style viewport)
Rect rx ry rw rh = contentArea
(areas, newSize) = assignStackAreas isHorizontal contentArea children
oldHandlePos = _spsHandlePos state
@ -231,7 +231,7 @@ makeSplit isHorizontal config state = widget where
useOldPos = customPos || ignoreSizeReq || sizeReqEquals
handlePos
| useOldPos && handlePosUserSet && validSize = oldHandlePos
| otherwise = calcHandlePos newSize oldHandlePos renderArea children
| otherwise = calcHandlePos newSize oldHandlePos viewport children
(w1, h1)
| isHorizontal = ((newSize - handleW) * handlePos, rh)
| otherwise = (rw, (newSize - handleW) * handlePos)
@ -258,8 +258,8 @@ makeSplit isHorizontal config state = widget where
& L.node . L.widget .~ makeSplit isHorizontal config newState
& L.events .~ Seq.fromList events
& L.requests .~ Seq.fromList (requestPos ++ reqOnChange)
newRas = Seq.fromList [rect1, rect2]
resized = (result, newRas)
newVps = Seq.fromList [rect1, rect2]
resized = (result, newVps)
getValidHandlePos maxDim rect point children = addPoint origin newPoint where
Rect rx ry _ _ = rect

11
src/Monomer/Widgets/Stack.hs
View File

@ -91,17 +91,16 @@ makeStack isHorizontal config = widget where
where
vreqs = accesor <$> vchildren
resize wenv renderArea children node = resized where
resize wenv viewport children node = resized where
style = activeStyle wenv node
contentArea = fromMaybe def (removeOuterBounds style renderArea)
(newRas, newDim) = assignStackAreas isHorizontal contentArea children
contentArea = fromMaybe def (removeOuterBounds style viewport)
(newVps, newDim) = assignStackAreas isHorizontal contentArea children
newCa
| isHorizontal = contentArea & L.w .~ newDim
| otherwise = contentArea & L.h .~ newDim
newRenderArea = fromMaybe newCa (addOuterBounds style newCa)
newNode = node
& L.info . L.renderArea .~ newRenderArea
resized = (resultWidget newNode, newRas)
& L.info . L.viewport .~ fromMaybe newCa (addOuterBounds style newCa)
resized = (resultWidget newNode, newVps)
assignStackAreas :: Bool -> Rect -> Seq (WidgetNode s e) -> (Seq Rect, Double)
assignStackAreas isHorizontal contentArea children = result where

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

@ -41,7 +41,7 @@ makeTheme theme = widget where
newReqH = child ^. L.info . L.sizeReqH
resize :: ContainerResizeHandler s e
resize wenv renderArea children node = resized where
resize wenv viewport children node = resized where
style = activeStyle wenv node
contentArea = fromMaybe def (removeOuterBounds style renderArea)
contentArea = fromMaybe def (removeOuterBounds style viewport)
resized = (resultWidget node, Seq.singleton contentArea)

10
src/Monomer/Widgets/Tooltip.hs
View File

@ -145,8 +145,8 @@ makeTooltip caption config state = widget where
newReqH = child ^. L.info . L.sizeReqH
resize :: ContainerResizeHandler s e
resize wenv renderArea children node = resized where
resized = (resultWidget node, Seq.singleton renderArea)
resize wenv viewport children node = resized where
resized = (resultWidget node, Seq.singleton viewport)
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
renderArea = node ^. L.info . L.renderArea
inRenderArea = pointInRect lastPos renderArea
viewport = node ^. L.info . L.viewport
inViewport = pointInRect lastPos viewport
delayEllapsed = ts - lastPosTs >= delay
displayed = inRenderArea && delayEllapsed
displayed = inViewport && delayEllapsed

12
src/Monomer/Widgets/Util/Hover.hs
View File

@ -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.renderArea)
isPointInNodeVp p node = pointInRect p (node ^. L.info . L.viewport)
isPointInNodeEllipse :: Point -> WidgetNode s e -> Bool
isPointInNodeEllipse p node = pointInEllipse p (node ^. L.info . L.renderArea)
isPointInNodeEllipse p node = pointInEllipse p (node ^. L.info . L.viewport)
isNodeActive :: WidgetEnv s e -> WidgetNode s e -> Bool
isNodeActive wenv node = validPos && pressed where
renderArea = node ^. L.info . L.renderArea
viewport = node ^. L.info . L.viewport
mousePos = wenv ^. L.inputStatus . L.mousePos
validPos = pointInRect mousePos renderArea
validPos = pointInRect mousePos viewport
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
renderArea = node ^. L.info . L.renderArea
viewport = node ^. L.info . L.viewport
mousePos = wenv ^. L.inputStatus . L.mousePos
validPos = pointInRect mousePos renderArea
validPos = pointInRect mousePos viewport
pressed = wenv ^. L.mainBtnPress ^? _Just . _1
validPress = isNothing pressed || isNodePressed wenv node
topLevel = isNodeTopLevel wenv node

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

@ -51,7 +51,7 @@ isWidgetVisible wenv node = isVisible && isOverlapped where
info = node ^. L.info
isVisible = info ^. L.visible
viewport = wenv ^. L.viewport
isOverlapped = rectsOverlap viewport (info ^. L.renderArea)
isOverlapped = rectsOverlap viewport (info ^. L.viewport)
visibleChildrenChanged :: WidgetNode s e -> WidgetNode s e -> Bool
visibleChildrenChanged oldNode newNode = oldVisible /= newVisible where

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

@ -144,20 +144,20 @@ makeZStack config state = widget where
where
vreqs = accesor <$> vchildren
resize wenv renderArea children node = resized where
resize wenv viewport children node = resized where
style = activeStyle wenv node
raChild = fromMaybe def (removeOuterBounds style renderArea)
assignedAreas = fmap (const raChild) children
vpChild = fromMaybe def (removeOuterBounds style viewport)
assignedAreas = fmap (const vpChild) children
resized = (resultWidget node, assignedAreas)
render renderer wenv node =
drawInScissor renderer True renderArea $
drawStyledAction renderer renderArea style $ \_ ->
drawInScissor renderer True viewport $
drawStyledAction renderer viewport style $ \_ ->
void $ Seq.traverseWithIndex renderChild children
where
style = activeStyle wenv node
children = Seq.reverse $ node ^. L.children
renderArea = node ^. L.info . L.renderArea
viewport = node ^. L.info . L.viewport
isVisible c = c ^. L.info . L.visible
topVisibleIdx = fromMaybe 0 (Seq.findIndexR (_wniVisible . _wnInfo) children)
isPointEmpty point idx = not covered where

6
tasks.md
View File

@ -239,7 +239,7 @@
- Update style when merging to avoid recalculating/merging theme every time
- Use theme for all components
- Replace uses of Seq.zip with foldlWithIndex
- Check provided renderArea is used correctly
- Check provided viewport is used correctly
- Provided viewport should consider parent viewport
- Check scroll styling works correctly (contentRect being applied, etc)
- Also handle hover so scrollbars get correct cursor
@ -292,7 +292,7 @@
- Maybe some composites could have a typeclass for its constructor, and react differently if provided Eq?
- Still need to provide method for custom mergeNeeded check
- Avoid forced resize after merge (if an item needs more space, it should request it)
- Avoid rebuilding glyphs if renderArea did not change for label
- Avoid rebuilding glyphs if viewport did not change for label
- Fix dialog not generating RenderOnce
- The issue was in zstack, where changing visible items should generate a resize request
- Review composite initialization. View creation can be moved to init
@ -380,7 +380,7 @@
- Rethink containerStyleOnMerge (it should really be containerStyleOnEvent and yes we need it)
- Removed, no longer needed (performance issue gone with removal of getSizeReq)
- Listview is not properly changing styles
- Label needs to rebuild its glyphs if style/renderArea changes
- Label needs to rebuild its glyphs if style/viewport changes
- Listview needs to update sizeReq of modified items
- If sizeReq changes, it should request ResizeWidgets
- When hover is lost, size is not reduced/recalculated

4
test/unit/Monomer/TestUtil.hs
View File

@ -155,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 renderArea node = result ^. L.node where
nodeResize wenv viewport node = result ^. L.node where
widget = node ^. L.widget
result = widgetResize widget wenv renderArea node
result = widgetResize widget wenv viewport node
nodeHandleEventCtx
:: (Eq s)

46
test/unit/Monomer/Widgets/BoxSpec.hs
View File

@ -98,14 +98,14 @@ resize = describe "resize" $ do
resizeDefault :: Spec
resizeDefault = describe "default" $ do
it "should have the provided renderArea size" $
renderArea `shouldBe` vp
it "should have the provided viewport size" $
viewport `shouldBe` vp
it "should have one child" $
children `shouldSatisfy` (== 1) . Seq.length
it "should have its children assigned a renderArea" $
cRenderArea `shouldBe` cvp
it "should have its children assigned a viewport" $
cViewport `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
renderArea = newNode ^. L.info . L.renderArea
cRenderArea = getChildRa wenv []
viewport = newNode ^. L.info . L.viewport
cViewport = getChildVp wenv []
resizeExpand :: Spec
resizeExpand = describe "expand" $
it "should have its children assigned a valid renderArea" $
cRenderArea `shouldBe` vp
it "should have its children assigned a valid viewport" $
cViewport `shouldBe` vp
where
wenv = mockWenv ()
vp = Rect 0 0 640 480
cRenderArea = getChildRa wenv [expandContent]
cViewport = getChildVp wenv [expandContent]
resizeAlign :: Spec
resizeAlign = describe "align" $ do
it "should align its child left" $
childRaL `shouldBe` cvpl
childVpL `shouldBe` cvpl
it "should align its child right" $
childRaR `shouldBe` cvpr
childVpR `shouldBe` cvpr
it "should align its child top" $
childRaT `shouldBe` cvpt
childVpT `shouldBe` cvpt
it "should align its child bottom" $
childRaB `shouldBe` cvpb
childVpB `shouldBe` cvpb
it "should align its child top-left" $
childRaTL `shouldBe` cvplt
childVpTL `shouldBe` cvplt
it "should align its child bottom-right" $
childRaBR `shouldBe` cvpbr
childVpBR `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
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]
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]
getChildRa :: Eq s => WidgetEnv s e -> [BoxCfg s e] -> Rect
getChildRa wenv cfgs = childLC ^. L.info . L.renderArea where
getChildVp :: Eq s => WidgetEnv s e -> [BoxCfg s e] -> Rect
getChildVp wenv cfgs = childLC ^. L.info . L.viewport where
lblNode = label "Label"
boxNodeLC = nodeInit wenv (box_ cfgs lblNode)
childLC = Seq.index (boxNodeLC ^. L.children) 0

12
test/unit/Monomer/Widgets/CompositeSpec.hs
View File

@ -317,11 +317,11 @@ getSizeReq = describe "getSizeReq" $ do
resize :: Spec
resize = describe "resize" $ do
it "should have the provided renderArea size" $
renderArea `shouldBe` vp
it "should have the provided viewport size" $
viewport `shouldBe` vp
it "should assign the same renderArea size to its child" $
childrenRa `shouldBe` Seq.singleton cvp1
it "should assign the same viewport size to its child" $
childrenVp `shouldBe` Seq.singleton cvp1
where
wenv = mockWenv () & L.windowSize .~ Size 640 480
@ -333,5 +333,5 @@ resize = describe "resize" $ do
cmpNode = composite "main" id buildUI handleEvent
tmpNode = nodeInit wenv cmpNode
newNode = widgetSave (tmpNode ^. L.widget) wenv tmpNode
renderArea = newNode ^. L.info . L.renderArea
childrenRa = (^. L.info . L.renderArea) <$> newNode ^. L.children
viewport = newNode ^. L.info . L.viewport
childrenVp = (^. L.info . L.viewport) <$> newNode ^. L.children

30
test/unit/Monomer/Widgets/GridSpec.hs
View File

@ -118,8 +118,8 @@ resize = describe "resize" $ do
resizeEmpty :: Spec
resizeEmpty = describe "empty" $ do
it "should have the provided renderArea size" $
renderArea `shouldBe` vp
it "should have the provided viewport size" $
viewport `shouldBe` vp
it "should not have children" $
children `shouldSatisfy` Seq.null
@ -129,16 +129,16 @@ resizeEmpty = describe "empty" $ do
vp = Rect 0 0 640 480
gridNode = vgrid []
newNode = nodeInit wenv gridNode
renderArea = newNode ^. L.info . L.renderArea
viewport = newNode ^. L.info . L.viewport
children = newNode ^. L.children
resizeItemsH :: Spec
resizeItemsH = describe "several items, horizontal" $ do
it "should have the provided renderArea size" $
renderArea `shouldBe` vp
it "should have the provided viewport size" $
viewport `shouldBe` vp
it "should assign the same renderArea size to each children" $
childrenRa `shouldBe` Seq.fromList [cvp1, cvp2, cvp3]
it "should assign the same viewport size to each children" $
childrenVp `shouldBe` Seq.fromList [cvp1, cvp2, cvp3]
where
wenv = mockWenv () & L.windowSize .~ Size 480 640
@ -152,16 +152,16 @@ resizeItemsH = describe "several items, horizontal" $ do
label "Label 3"
]
newNode = nodeInit wenv gridNode
renderArea = newNode ^. L.info . L.renderArea
childrenRa = (^. L.info . L.renderArea) <$> newNode ^. L.children
viewport = newNode ^. L.info . L.viewport
childrenVp = (^. L.info . L.viewport) <$> newNode ^. L.children
resizeItemsV :: Spec
resizeItemsV = describe "several items, vertical, one not visible" $ do
it "should have the provided renderArea size" $
renderArea `shouldBe` vp
it "should have the provided viewport size" $
viewport `shouldBe` vp
it "should assign the same renderArea size to each children" $
childrenRa `shouldBe` Seq.fromList [cvp1, cvp2, cvp3, cvp4]
it "should assign the same viewport size to each children" $
childrenVp `shouldBe` Seq.fromList [cvp1, cvp2, cvp3, cvp4]
where
wenv = mockWenv ()
@ -177,5 +177,5 @@ resizeItemsV = describe "several items, vertical, one not visible" $ do
label "Label 3"
]
newNode = nodeInit wenv gridNode
renderArea = newNode ^. L.info . L.renderArea
childrenRa = (^. L.info . L.renderArea) <$> newNode ^. L.children
viewport = newNode ^. L.info . L.viewport
childrenVp = (^. L.info . L.viewport) <$> newNode ^. L.children

10
test/unit/Monomer/Widgets/ScrollSpec.hs
View File

@ -21,11 +21,11 @@ spec = describe "Scroll"
resize :: Spec
resize = describe "resize" $ do
it "should have the provided renderArea size" $
renderArea `shouldBe` vp
it "should have the provided viewport size" $
viewport `shouldBe` vp
it "should assign all the requested space" $
childrenRa `shouldBe` Seq.fromList [cra1]
childrenVp `shouldBe` Seq.fromList [cra1]
where
wenv = mockWenv () & L.windowSize .~ Size 640 480
@ -34,5 +34,5 @@ resize = describe "resize" $ do
cra1 = Rect 0 0 3000 2000
scrollNode = scroll (label "" `style` [width 3000, height 2000])
newNode = nodeInit wenv scrollNode
renderArea = newNode ^. L.info . L.renderArea
childrenRa = roundRectUnits . _wniRenderArea . _wnInfo <$> newNode ^. L.children
viewport = newNode ^. L.info . L.viewport
childrenVp = roundRectUnits . _wniViewport . _wnInfo <$> newNode ^. L.children

8
test/unit/Monomer/Widgets/SplitSpec.hs
View File

@ -85,9 +85,9 @@ handleEventMouseDragH = describe "handleEventMouseDragH" $ do
btn2 = button "Longer" Button2
splitNode = hsplit_ [splitHandlePos sliderPos] (btn1, btn2)
model es = nodeHandleEventModel wenv es splitNode
areas es = ra where
areas es = vp where
root = nodeHandleEventRoot wenv es splitNode
ra = fmap (roundRectUnits . _wniRenderArea . _wnInfo) (root ^. L.children)
vp = fmap (roundRectUnits . _wniViewport . _wnInfo) (root ^. L.children)
handleEventMouseDragV :: Spec
handleEventMouseDragV = describe "handleEventMouseDragV" $ do
@ -133,9 +133,9 @@ handleEventMouseDragV = describe "handleEventMouseDragV" $ do
btn2 = button "Longer" Button2 `style` [rangeHeight 200 400]
splitNode = vsplit_ [splitHandlePosV 0.5, onChange SliderChanged] (btn1, btn2)
evts es = nodeHandleEventEvts wenv es splitNode
areas es = ra where
areas es = vp where
root = nodeHandleEventRoot wenv es splitNode
ra = fmap (roundRectUnits . _wniRenderArea . _wnInfo) (root ^. L.children)
vp = fmap (roundRectUnits . _wniViewport . _wnInfo) (root ^. L.children)
getSizeReq :: Spec
getSizeReq = describe "getSizeReq" $ do

110
test/unit/Monomer/Widgets/StackSpec.hs
View File

@ -73,8 +73,8 @@ resize = describe "resize" $ do
resizeEmpty :: Spec
resizeEmpty = describe "empty" $ do
it "should have the provided renderArea size" $
renderArea `shouldBe` vp
it "should have the provided viewport size" $
viewport `shouldBe` vp
it "should not have children" $
children `shouldSatisfy` Seq.null
@ -85,16 +85,16 @@ resizeEmpty = describe "empty" $ do
vp = Rect 0 0 640 0
vstackNode = vstack []
newNode = nodeInit wenv vstackNode
renderArea = newNode ^. L.info . L.renderArea
viewport = newNode ^. L.info . L.viewport
children = newNode ^. L.children
resizeFlexibleH :: Spec
resizeFlexibleH = describe "flexible items, horizontal" $ do
it "should have the provided renderArea size" $
renderArea `shouldBe` vp
it "should have the provided viewport size" $
viewport `shouldBe` vp
it "should assign size proportional to requested size to each children" $
childrenRa `shouldBe` Seq.fromList [cvp1, cvp2, cvp3]
childrenVp `shouldBe` Seq.fromList [cvp1, cvp2, cvp3]
where
wenv = mockWenv () & L.windowSize .~ Size 480 640
@ -108,16 +108,16 @@ resizeFlexibleH = describe "flexible items, horizontal" $ do
label "Label 3"
]
newNode = nodeInit wenv hstackNode
renderArea = newNode ^. L.info . L.renderArea
childrenRa = roundRectUnits . _wniRenderArea . _wnInfo <$> newNode ^. L.children
viewport = newNode ^. L.info . L.viewport
childrenVp = roundRectUnits . _wniViewport . _wnInfo <$> newNode ^. L.children
resizeFlexibleV :: Spec
resizeFlexibleV = describe "flexible items, vertical" $ do
it "should have the provided renderArea size" $
renderArea `shouldBe` vp
it "should have the provided viewport size" $
viewport `shouldBe` vp
it "should assign size proportional to requested size to each children" $
childrenRa `shouldBe` Seq.fromList [cvp1, cvp2, cvp3]
childrenVp `shouldBe` Seq.fromList [cvp1, cvp2, cvp3]
where
wenv = mockWenv ()
@ -131,20 +131,17 @@ resizeFlexibleV = describe "flexible items, vertical" $ do
label "Label 3" `style` [flexHeight 20]
]
newNode = nodeInit wenv vstackNode
renderArea = newNode ^. L.info . L.renderArea
childrenRa = (^. L.info . L.renderArea) <$> newNode ^. L.children
viewport = newNode ^. L.info . L.viewport
childrenVp = (^. L.info . L.viewport) <$> newNode ^. L.children
resizeStrictFlexH :: Spec
resizeStrictFlexH = describe "strict/flexible items, horizontal" $ do
it "should have the provided renderArea size" $
renderArea `shouldBe` vp
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 assign requested size to the main labels and the rest to grid" $
childrenRa `shouldBe` Seq.fromList [cvp1, cvp2, cvp3]
where
wenv = mockWenv ()
vp = Rect 0 0 640 480
@ -157,17 +154,16 @@ resizeStrictFlexH = describe "strict/flexible items, horizontal" $ do
label "Label 3"
]
newNode = nodeInit wenv hstackNode
renderArea = newNode ^. L.info . L.renderArea
childrenVp = (^. L.info . L.renderArea) <$> newNode ^. L.children
childrenRa = (^. L.info . L.renderArea) <$> newNode ^. L.children
viewport = newNode ^. L.info . L.viewport
childrenVp = (^. L.info . L.viewport) <$> newNode ^. L.children
resizeStrictFlexV :: Spec
resizeStrictFlexV = describe "strict/flexible items, vertical" $ do
it "should have the provided renderArea size" $
renderArea `shouldBe` vp
it "should have the provided viewport size" $
viewport `shouldBe` vp
it "should assign requested size to the main labels and the rest to grid" $
childrenRa `shouldBe` Seq.fromList [cvp1, cvp2, cvp3]
childrenVp `shouldBe` Seq.fromList [cvp1, cvp2, cvp3]
where
wenv = mockWenv ()
@ -181,16 +177,16 @@ resizeStrictFlexV = describe "strict/flexible items, vertical" $ do
label "Label 3" `style` [flexHeight 100]
]
newNode = nodeInit wenv vstackNode
renderArea = newNode ^. L.info . L.renderArea
childrenRa = (^. L.info . L.renderArea) <$> newNode ^. L.children
viewport = newNode ^. L.info . L.viewport
childrenVp = (^. L.info . L.viewport) <$> newNode ^. L.children
resizeMixedH :: Spec
resizeMixedH = describe "mixed items, horizontal" $ do
it "should have the provided renderArea size" $
renderArea `shouldBe` vp
it "should have the provided viewport size" $
viewport `shouldBe` vp
it "should assign size proportional to requested size to each children" $
childrenRa `shouldBe` Seq.fromList [cvp1, cvp2]
childrenVp `shouldBe` Seq.fromList [cvp1, cvp2]
where
wenv = mockWenv ()
@ -204,17 +200,17 @@ resizeMixedH = describe "mixed items, horizontal" $ do
]
]
newNode = nodeInit wenv hstackNode
renderArea = newNode ^. L.info . L.renderArea
viewport = newNode ^. L.info . L.viewport
firstChild = Seq.index (newNode ^. L.children) 0
childrenRa = roundRectUnits . _wniRenderArea . _wnInfo <$> firstChild ^. L.children
childrenVp = roundRectUnits . _wniViewport . _wnInfo <$> firstChild ^. L.children
resizeMixedV :: Spec
resizeMixedV = describe "mixed items, vertical" $ do
it "should have the provided renderArea size" $
renderArea `shouldBe` vp
it "should have the provided viewport size" $
viewport `shouldBe` vp
it "should assign size proportional to requested size to each children" $
childrenRa `shouldBe` Seq.fromList [cvp1, cvp2, cvp3]
childrenVp `shouldBe` Seq.fromList [cvp1, cvp2, cvp3]
where
wenv = mockWenv ()
@ -230,17 +226,17 @@ resizeMixedV = describe "mixed items, vertical" $ do
]
]
newNode = nodeInit wenv vstackNode
renderArea = newNode ^. L.info . L.renderArea
viewport = newNode ^. L.info . L.viewport
firstChild = Seq.index (newNode ^. L.children) 0
childrenRa = roundRectUnits . _wniRenderArea . _wnInfo <$> firstChild ^. L.children
childrenVp = roundRectUnits . _wniViewport . _wnInfo <$> firstChild ^. L.children
resizeAllV :: Spec
resizeAllV = describe "all kinds of sizeReq, vertical" $ do
it "should have the provided renderArea size" $
renderArea `shouldBe` vp
it "should have the provided viewport size" $
viewport `shouldBe` vp
it "should assign size proportional to requested size to each children" $
childrenRa `shouldBe` Seq.fromList [cvp1, cvp2, cvp3, cvp4, cvp5]
childrenVp `shouldBe` Seq.fromList [cvp1, cvp2, cvp3, cvp4, cvp5]
where
wenv = mockWenv ()
@ -258,17 +254,17 @@ resizeAllV = describe "all kinds of sizeReq, vertical" $ do
label "Label 5" `style` [rangeWidth 90 100, rangeHeight 90 100]
]
newNode = nodeInit wenv vstackNode
renderArea = newNode ^. L.info . L.renderArea
childrenRa = roundRectUnits . _wniRenderArea . _wnInfo <$> newNode ^. L.children
viewport = newNode ^. L.info . L.viewport
childrenVp = roundRectUnits . _wniViewport . _wnInfo <$> newNode ^. L.children
resizeNoSpaceV :: Spec
resizeNoSpaceV = describe "vertical, without enough space" $ do
it "should have a larger renderArea size (parent should fix it)" $ do
renderArea `shouldBe` vp
renderArea `shouldBe` vp
it "should have a larger viewport size (parent should fix it)" $ do
viewport `shouldBe` vp
viewport `shouldBe` vp
it "should assign size proportional to requested size to each children" $
childrenRa `shouldBe` Seq.fromList [cvp1, cvp2, cvp3, cvp4, cvp5]
childrenVp `shouldBe` Seq.fromList [cvp1, cvp2, cvp3, cvp4, cvp5]
where
wenv = mockWenv ()
@ -286,16 +282,16 @@ resizeNoSpaceV = describe "vertical, without enough space" $ do
label "Label 5" `style` [height 200]
]
newNode = nodeInit wenv vstackNode
renderArea = newNode ^. L.info . L.renderArea
childrenRa = roundRectUnits . _wniRenderArea . _wnInfo <$> newNode ^. L.children
viewport = newNode ^. L.info . L.viewport
childrenVp = roundRectUnits . _wniViewport . _wnInfo <$> newNode ^. L.children
resizeSpacerFlexH :: Spec
resizeSpacerFlexH = describe "label flex and spacer, horizontal" $ do
it "should have the provided renderArea size" $
roundRectUnits renderArea `shouldBe` vp
it "should have the provided viewport size" $
roundRectUnits viewport `shouldBe` vp
it "should assign size proportional to requested size to each children" $
childrenRa `shouldBe` Seq.fromList [cvp1, cvp2, cvp3]
childrenVp `shouldBe` Seq.fromList [cvp1, cvp2, cvp3]
where
wenv = mockWenv ()
@ -309,16 +305,16 @@ resizeSpacerFlexH = describe "label flex and spacer, horizontal" $ do
label "Label" `style` [flexWidth 200]
]
newNode = nodeInit wenv hstackNode
renderArea = newNode ^. L.info . L.renderArea
childrenRa = roundRectUnits . _wniRenderArea . _wnInfo <$> newNode ^. L.children
viewport = newNode ^. L.info . L.viewport
childrenVp = roundRectUnits . _wniViewport . _wnInfo <$> newNode ^. L.children
resizeSpacerFixedH :: Spec
resizeSpacerFixedH = describe "label fixed and spacer, horizontal" $ do
it "should have the provided renderArea size" $
renderArea `shouldBe` vp
it "should have the provided viewport size" $
viewport `shouldBe` vp
it "should assign size proportional to requested size to each children" $
childrenRa `shouldBe` Seq.fromList [cvp1, cvp2, cvp3]
childrenVp `shouldBe` Seq.fromList [cvp1, cvp2, cvp3]
where
wenv = mockWenv ()
@ -332,5 +328,5 @@ resizeSpacerFixedH = describe "label fixed and spacer, horizontal" $ do
label "Label" `style` [width 200]
]
newNode = nodeInit wenv hstackNode
renderArea = newNode ^. L.info . L.renderArea
childrenRa = roundRectUnits . _wniRenderArea . _wnInfo <$> newNode ^. L.children
viewport = newNode ^. L.info . L.viewport
childrenVp = roundRectUnits . _wniViewport . _wnInfo <$> newNode ^. L.children

2
test/unit/Monomer/Widgets/TextFieldSpec.hs
View File

@ -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 renderArea" $ do
it "should add text at the end, since click + drag started outside of viewport" $ do
let str = "This is text"
let selStart = Point 50 100
let selEnd = Point 120 10

4
test/unit/Monomer/Widgets/Util/StyleSpec.hs
View File

@ -129,10 +129,10 @@ createStyleState size col = Just newState where
createNode :: Bool -> WidgetNode s e
createNode enabled = newNode where
renderArea = Rect 100 100 200 200
viewport = Rect 100 100 200 200
newNode = label "Test"
& L.info . L.path .~ Seq.fromList [0]
& L.info . L.renderArea .~ renderArea
& L.info . L.viewport .~ viewport
& L.info . L.style .~ createStyle
& L.info . L.visible .~ True
& L.info . L.enabled .~ enabled

16
test/unit/Monomer/Widgets/ZStackSpec.hs
View File

@ -248,8 +248,8 @@ resize = describe "resize" $ do
resizeEmpty :: Spec
resizeEmpty = describe "empty" $ do
it "should have the provided renderArea size" $
renderArea `shouldBe` vp
it "should have the provided viewport size" $
viewport `shouldBe` vp
it "should not have children" $
children `shouldSatisfy` Seq.null
@ -259,15 +259,15 @@ resizeEmpty = describe "empty" $ do
vp = Rect 0 0 640 480
zstackNode = zstack []
newNode = nodeInit wenv zstackNode
renderArea = newNode ^. L.info . L.renderArea
viewport = newNode ^. L.info . L.viewport
children = newNode ^. L.children
resizeItems :: Spec
resizeItems = describe "several items, horizontal" $ do
it "should have the provided renderArea size" $
renderArea `shouldBe` vp
it "should have the provided viewport size" $
viewport `shouldBe` vp
it "should assign the same renderArea size to each children" $
it "should assign the same viewport size to each children" $
childrenRa `shouldBe` Seq.fromList [vp, vp, vp]
where
@ -279,5 +279,5 @@ resizeItems = describe "several items, horizontal" $ do
label "Label 3"
]
newNode = nodeInit wenv zstackNode
renderArea = newNode ^. L.info . L.renderArea
childrenRa = (^. L.info . L.renderArea) <$> newNode ^. L.children
viewport = newNode ^. L.info . L.viewport
childrenRa = (^. L.info . L.viewport) <$> newNode ^. L.children