Set correct viewport from scroll (it looked good because of scissoring)

src/Monomer/Widgets/Container.hs

@@ -471,11 +471,17 @@ getUpdateCWenv container !wenv !node !cnode !cidx = newWenv where
   cOffset = containerChildrenOffset container
   updateCWenv = containerUpdateCWenv container
   layoutDirection = containerLayoutDirection container
+
+  pViewport = node ^. L.info . L.viewport
+  cViewport = cnode ^. L.info . L.viewport
+  newViewport = fromMaybe def (intersectRects pViewport cViewport)
+
   offsetWenv !wenv
-    | isJust cOffset = updateWenvOffset container wenv node
+    | isJust cOffset = updateWenvOffset container wenv node newViewport
     | otherwise = wenv
   !directionWenv = wenv
     & L.layoutDirection .~ layoutDirection
+
   !newWenv = updateCWenv (offsetWenv directionWenv) node cnode cidx
 
 {-|
@@ -487,15 +493,16 @@ updateWenvOffset
   :: Container s e a  -- ^ The container config
   -> WidgetEnv s e    -- ^ The widget environment.
   -> WidgetNode s e   -- ^ The widget node.
+  -> Rect             -- ^ The target viewport.
   -> WidgetEnv s e    -- ^ THe updated widget environment.
-updateWenvOffset container wenv node = newWenv where
+updateWenvOffset container wenv node viewport = newWenv where
   cOffset = containerChildrenOffset container
   offset = fromMaybe def cOffset
-  accumOffset = addPoint offset (wenv ^. L.offset)
-  viewport = node ^. L.info . L.viewport
+
   updateMain (path, point)
     | isNodeParentOfPath node path = (path, addPoint (negPoint offset) point)
     | otherwise = (path, point)
+
   newWenv = wenv
     & L.viewport .~ moveRect (negPoint offset) viewport
     & L.inputStatus . L.mousePos %~ addPoint (negPoint offset)

src/Monomer/Widgets/Containers/Dropdown.hs

@@ -496,7 +496,7 @@ makeDropdown widgetData items makeMain makeRow config state = widget where
       scOffset = wenv ^. L.offset
       offset = _ddsOffset state
       totalOffset = addPoint scOffset offset
-      cwenv = updateWenvOffset container wenv node
+      cwenv = updateWenvOffset container wenv node listOverlayVp
         & L.viewport .~ listOverlayVp
 
   renderArrow renderer style contentArea =

src/Monomer/Widgets/Containers/Scroll.hs

@@ -350,6 +350,7 @@ makeScroll config state = widget where
     containerLayoutDirection = layoutDirection,
     containerGetBaseStyle = getBaseStyle,
     containerGetCurrentStyle = scrollCurrentStyle,
+    containerUpdateCWenv = updateCWenv,
     containerInit = init,
     containerMerge = merge,
     containerFindByPoint = findByPoint,
@@ -385,6 +386,28 @@ makeScroll config state = widget where
         & L.children . ix 0 . L.info . L.style .~ childStyle
       | otherwise = node
 
+  -- This is overriden to account for space used by scroll bars
+  updateCWenv wenv node cnode cidx = newWenv where
+    theme = currentTheme wenv node
+    barW = fromMaybe (theme ^. L.scrollBarWidth) (_scBarWidth config)
+    overlay = fromMaybe (theme ^. L.scrollOverlay) (_scScrollOverlay config)
+
+    ScrollContext{..} = scrollStatus config wenv node state (Point 0 0)
+    style = currentStyle wenv node
+    carea = getContentArea node style
+
+    -- barH consumes vertical space, barV consumes horizontal space
+    barH
+      | hScrollRequired && not overlay = barW
+      | otherwise = 0
+    barV
+      | vScrollRequired && not overlay = barW
+      | otherwise = 0
+    clientArea = subtractFromRect carea 0 barV 0 barH
+
+    newWenv = wenv
+      & L.viewport .~ moveRect (negPoint offset) (fromMaybe carea clientArea)
+
   init wenv node = resultNode newNode where
     newNode = checkFwdStyle wenv node