diff --git a/app/Main.hs b/app/Main.hs index a2bc5a51..380f890b 100644 --- a/app/Main.hs +++ b/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, diff --git a/src/GUI/Widget/Button.hs b/src/GUI/Widget/Button.hs index 9373f90e..d9c65c5f 100644 --- a/src/GUI/Widget/Button.hs +++ b/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 diff --git a/src/GUI/Widget/Core.hs b/src/GUI/Widget/Core.hs index ebb5d237..95c3311b 100644 --- a/src/GUI/Widget/Core.hs +++ b/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 { diff --git a/src/GUI/Widget/Label.hs b/src/GUI/Widget/Label.hs index b44a673f..b743d4b2 100644 --- a/src/GUI/Widget/Label.hs +++ b/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 diff --git a/src/GUI/Widget/Layout.hs b/src/GUI/Widget/Layout.hs index f36c17e3..448e9a38 100644 --- a/src/GUI/Widget/Layout.hs +++ b/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 () {-- diff --git a/src/GUI/Widget/Sandbox.hs b/src/GUI/Widget/Sandbox.hs index 65802159..b94f22af 100644 --- a/src/GUI/Widget/Sandbox.hs +++ b/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 diff --git a/src/GUI/Widget/Scroll.hs b/src/GUI/Widget/Scroll.hs index 45a787b8..19835067 100644 --- a/src/GUI/Widget/Scroll.hs +++ b/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] diff --git a/src/GUI/Widget/TextField.hs b/src/GUI/Widget/TextField.hs index 3d57ec9b..f2d8b269 100644 --- a/src/GUI/Widget/TextField.hs +++ b/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