Consider renderArea when resizing

app/Main.hs

@@ -131,12 +131,18 @@ buildUI model = styledTree where
         label "Short",
         scroll $ label "This is a really really really long label, you know?" `style` labelStyle
       ],
-      hstack [
+      scroll $ hstack [
         label "Short",
         spacer,
         label "Long",
         spacer,
-        label "Very Long"
+        label "Very Long",
+        spacer,
+        label "Very Very Long",
+        spacer,
+        label "Very Very Very Long",
+        spacer,
+        label "Very Very Very Very Long"
       ],
       hgrid [
         sandbox (Action1 1) `style` buttonStyle,

src/GUI/Widget/Button.hs

@@ -42,7 +42,7 @@ makeButton label onClick = Widget {
     preferredSize renderer (style@Style{..}) _ = do
       size <- calcTextBounds renderer _textStyle label
       return $ SizeReq size FlexibleSize FlexibleSize
-    resizeChildren _ _ _ = Nothing
+    resizeChildren _ _ _ _ = Nothing
     render renderer WidgetInstance{..} _ ts =
       do
         drawBgRect renderer _widgetInstanceRenderArea _widgetInstanceStyle

src/GUI/Widget/Core.hs

@@ -180,7 +180,7 @@ data Widget s e m =
     -- Preferred size for each of the children widgets
     --
     -- Returns: the size assigned to each of the children
-    _widgetResizeChildren :: Rect -> Style -> [SizeReq] -> Maybe (WidgetResizeResult s e m),
+    _widgetResizeChildren :: Rect -> Rect -> Style -> [SizeReq] -> Maybe (WidgetResizeResult s e m),
     -- | Renders the widget
     --
     -- Renderer
@@ -373,7 +373,7 @@ resizeNode renderer viewport renderArea (Node _ childrenSizes) (Node widgetInsta
   where
     widget = _widgetInstanceWidget widgetInstance
     style = _widgetInstanceStyle widgetInstance
-    (WidgetResizeResult viewports renderAreas newWidget) = case (_widgetResizeChildren widget) viewport style (seqToList childrenSizes) of
+    (WidgetResizeResult viewports renderAreas newWidget) = case (_widgetResizeChildren widget) viewport renderArea style (seqToList childrenSizes) of
       Nothing -> WidgetResizeResult [] [] Nothing
       Just wrr -> wrr
     updatedNode = widgetInstance {

src/GUI/Widget/Label.hs

@@ -44,7 +44,7 @@ makeLabel caption = Widget {
     preferredSize renderer (style@Style{..}) _ = do
       size <- calcTextBounds renderer _textStyle caption
       return $ SizeReq size FlexibleSize FlexibleSize
-    resizeChildren _ _ _ = Nothing
+    resizeChildren _ _ _ _ = Nothing
     render renderer WidgetInstance{..} _ ts =
       do
         drawBgRect renderer _widgetInstanceRenderArea _widgetInstanceStyle

src/GUI/Widget/Layout.hs

@@ -52,7 +52,7 @@ makeFixedGrid widgetType direction = Widget {
       height = (fromIntegral hMul) * (maximum . map (_h . _srSize)) children
       wMul = if direction == Horizontal then length children else 1
       hMul = if direction == Horizontal then 1 else length children
-    resizeChildren (Rect l t w h) style children = Just $ WidgetResizeResult newViewports newViewports Nothing where
+    resizeChildren _ (Rect l t w h) style children = Just $ WidgetResizeResult newViewports newViewports Nothing where
       cols = if direction == Horizontal then (length children) else 1
       rows = if direction == Horizontal then 1 else (length children)
       newViewports = fmap resizeChild [0..(length children - 1)]
@@ -84,7 +84,7 @@ makeHStack widgetType direction = Widget {
     handleEvent _ _ = Nothing
     preferredSize _ _ children = return reqSize where
       reqSize = SizeReq (calcPreferredSize children) FlexibleSize FlexibleSize
-    resizeChildren (Rect l t w h) style children = Just $ WidgetResizeResult (reverse newViewports) (reverse newViewports) Nothing where
+    resizeChildren _ (Rect l t w h) style children = Just $ WidgetResizeResult newViewports newViewports Nothing where
       sChildren = filter (\c -> _srPolicyWidth c == StrictSize) children
       fChildren = filter (\c -> _srPolicyWidth c == FlexibleSize) children
       rChildren = filter (\c -> _srPolicyWidth c == RemainderSize) children
@@ -98,7 +98,8 @@ makeHStack widgetType direction = Widget {
                   | otherwise                         -> 0
       remainderTotal = w - (sw + fw * fRatio)
       remainderUnit = if remainderExist then max 0 remainderTotal / fromIntegral remainderCount else 0
-      (newViewports, _) = foldl foldHelper ([], 0) children
+      newViewports = reverse revViewports
+      (revViewports, _) = foldl foldHelper ([], l) children
       foldHelper (accum, left) child = (newSize : accum, left + nw) where
         newSize@(Rect _ _ nw _) = resizeChild left child
       resizeChild left (SizeReq (Size cw _) srW _) = Rect left t newWidth h where
@@ -134,8 +135,8 @@ makeSpacer = Widget {
   }
   where
     handleEvent view evt = Nothing
-    preferredSize renderer (style@Style{..}) _ = return $ SizeReq (Size 0 0) RemainderSize RemainderSize
-    resizeChildren _ _ _ = Nothing
+    preferredSize renderer (style@Style{..}) _ = return $ SizeReq (Size 10 10) RemainderSize RemainderSize
+    resizeChildren _ _ _ _ = Nothing
     render renderer WidgetInstance{..} _ ts = return ()
 
 {--

src/GUI/Widget/Sandbox.hs

@@ -57,7 +57,7 @@ makeSandbox state onClick = Widget {
     preferredSize renderer (style@Style{..}) _ = do
       size <- calcTextBounds renderer _textStyle (T.pack (show (_clickCount state)))
       return $ SizeReq size FlexibleSize FlexibleSize
-    resizeChildren _ _ _ = Nothing
+    resizeChildren _ _ _ _ = Nothing
     render renderer WidgetInstance{..} _ ts =
       do
         drawBgRect renderer _widgetInstanceRenderArea _widgetInstanceStyle

src/GUI/Widget/Scroll.hs

@@ -71,7 +71,7 @@ makeScroll state@(ScrollState dx dy cs@(Size cw ch)) = Widget {
                       then currScroll + reqDelta
                       else viewportLimit - childPos
     preferredSize _ _ children = return (head children)
-    resizeChildren (Rect l t w h) _ children = Just $ WidgetResizeResult viewport renderArea newWidget where
+    resizeChildren (Rect l t w h) _ _ children = Just $ WidgetResizeResult viewport renderArea newWidget where
       SizeReq (Size cw2 ch2) _ _ = (head children)
       newWidget = Just $ makeScroll (ScrollState dx dy (Size cw2 ch2))
       viewport = [Rect l t w h]

src/GUI/Widget/TextField.hs

@@ -68,7 +68,7 @@ makeTextField tfs@(TextFieldState txt tp) = Widget {
     preferredSize renderer (style@Style{..}) _ = do
       size <- calcTextBounds renderer _textStyle (T.pack txt)
       return $ SizeReq size FlexibleSize FlexibleSize
-    resizeChildren _ _ _ = Nothing
+    resizeChildren _ _ _ _ = Nothing
     render renderer WidgetInstance{..} _ ts =
       do
         drawBgRect renderer _widgetInstanceRenderArea _widgetInstanceStyle