diff --git a/app/Main.hs b/app/Main.hs index 03071ec5..91931f39 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -118,7 +118,7 @@ handleAppEvent wenv model evt = case evt of buildUI :: WidgetEnv App AppEvent -> App -> WidgetNode App AppEvent buildUI wenv model = trace "Creating UI" widgetSplit where - widgetSplit = hsplit (image "assets/images/pecans.jpg", widgetTree) + widgetSplit = hsplit (image "assets/images/pecans.jpg" `style` [maxWidth 200], widgetTree `style` [maxWidth 200]) mkImg i = vstack [ label ("Image: " <> showt i), image ("https://picsum.photos/600/400?ts=" ++ show i) diff --git a/src/Monomer/Widgets/Box.hs b/src/Monomer/Widgets/Box.hs index e4ab67a4..be148000 100644 --- a/src/Monomer/Widgets/Box.hs +++ b/src/Monomer/Widgets/Box.hs @@ -172,8 +172,8 @@ makeBox config = widget where contentArea = fromMaybe def (removeOuterBounds style renderArea) Rect cx cy cw ch = contentArea child = Seq.index children 0 - contentW = sizeReqMax $ child ^. L.info . L.sizeReqW - contentH = sizeReqMax $ child ^. L.info . L.sizeReqH + contentW = sizeReqMaxBounded $ child ^. L.info . L.sizeReqW + contentH = sizeReqMaxBounded $ child ^. L.info . L.sizeReqH raChild = Rect cx cy (min cw contentW) (min ch contentH) ah = fromMaybe ACenter (_boxAlignH config) av = fromMaybe AMiddle (_boxAlignV config) diff --git a/src/Monomer/Widgets/Button.hs b/src/Monomer/Widgets/Button.hs index e64ebde1..a018a4ab 100644 --- a/src/Monomer/Widgets/Button.hs +++ b/src/Monomer/Widgets/Button.hs @@ -232,7 +232,7 @@ makeButton config state = widget where getSizeReq wenv currState node = (sizeW, sizeH) where caption = _btsCaption currState style = activeStyle wenv node - targetW = fmap sizeReqMax (style ^. L.sizeReqW) + targetW = fmap sizeReqMaxBounded (style ^. L.sizeReqW) Size w h = getTextSize_ wenv style mode trimSpaces targetW caption factorW = fromMaybe 0.01 (_btnFactorW config) factorH = fromMaybe 0 (_btnFactorH config) diff --git a/src/Monomer/Widgets/Dropdown.hs b/src/Monomer/Widgets/Dropdown.hs index f61405cc..640b41a2 100644 --- a/src/Monomer/Widgets/Dropdown.hs +++ b/src/Monomer/Widgets/Dropdown.hs @@ -374,7 +374,7 @@ makeDropdown widgetData items makeMain makeRow config state = widget where cfgMaxHeight = _ddcMaxHeight config -- Avoid having an invisible list if style/theme as not set maxHeightStyle = max 20 $ fromMaybe maxHeightTheme cfgMaxHeight - reqHeight = sizeReqMin $ child ^. L.info . L.sizeReqH + reqHeight = sizeReqMaxBounded $ child ^. L.info . L.sizeReqH maxHeight = min winH (min reqHeight maxHeightStyle) dy = dropdownY maxHeight dh = maxHeight diff --git a/src/Monomer/Widgets/Label.hs b/src/Monomer/Widgets/Label.hs index 96e9f904..cecdb3e1 100644 --- a/src/Monomer/Widgets/Label.hs +++ b/src/Monomer/Widgets/Label.hs @@ -136,7 +136,7 @@ makeLabel config state = widget where getSizeReq wenv currState node = (sizeW, sizeH) where caption = _lstCaption currState style = activeStyle wenv node - targetW = fmap sizeReqMax (style ^. L.sizeReqW) + targetW = fmap sizeReqMaxBounded (style ^. L.sizeReqW) Size w h = getTextSize_ wenv style mode trimSpaces targetW caption factorW = fromMaybe 0.01 (_lscFactorW config) factorH = fromMaybe 0 (_lscFactorH config) diff --git a/src/Monomer/Widgets/Scroll.hs b/src/Monomer/Widgets/Scroll.hs index 2b71df4e..42dc6e5f 100644 --- a/src/Monomer/Widgets/Scroll.hs +++ b/src/Monomer/Widgets/Scroll.hs @@ -350,8 +350,8 @@ makeScroll config state = widget where getSizeReq wenv currState node children = sizeReq where style = scrollActiveStyle wenv node child = Seq.index children 0 - tw = sizeReqMax $ child ^. L.info . L.sizeReqW - th = sizeReqMax $ child ^. L.info . L.sizeReqH + tw = sizeReqMaxBounded $ child ^. L.info . L.sizeReqW + th = sizeReqMaxBounded $ child ^. L.info . L.sizeReqH Size w h = fromMaybe def (addOuterSize style (Size tw th)) factor = 1 @@ -366,8 +366,8 @@ makeScroll config state = widget where dy = _sstDeltaY state child = Seq.index (node ^. L.children) 0 - childWidth2 = sizeReqMax $ child ^. L.info . L.sizeReqW - childHeight2 = sizeReqMax $ child ^. L.info . L.sizeReqH + childWidth2 = sizeReqMaxBounded $ child ^. L.info . L.sizeReqW + childHeight2 = sizeReqMaxBounded $ child ^. L.info . L.sizeReqH areaW | scrollType == ScrollV = cw diff --git a/src/Monomer/Widgets/Util/SizeReq.hs b/src/Monomer/Widgets/Util/SizeReq.hs index aeadf2f7..e2d94247 100644 --- a/src/Monomer/Widgets/Util/SizeReq.hs +++ b/src/Monomer/Widgets/Util/SizeReq.hs @@ -1,9 +1,9 @@ module Monomer.Widgets.Util.SizeReq ( - isSizeReqFixed, - isSizeReqFlex, + sizeReqBound, sizeReqAddStyle, sizeReqMin, sizeReqMax, + sizeReqMaxBounded, sizeReqFixed, sizeReqFlex, sizeReqExtra, @@ -21,13 +21,10 @@ import Monomer.Event import Monomer.Widgets.Util.Style import Monomer.Widgets.Util.Widget -isSizeReqFixed :: SizeReq -> Bool -isSizeReqFixed FixedSize{} = True -isSizeReqFixed _ = False - -isSizeReqFlex :: SizeReq -> Bool -isSizeReqFlex FlexSize{} = True -isSizeReqFlex _ = False +sizeReqBound :: SizeReq -> Double -> Double -> Double +sizeReqBound sizeReq offset value = max minSize . min maxSize $ value where + minSize = offset + sizeReqMin sizeReq + maxSize = offset + sizeReqMax sizeReq sizeReqAddStyle :: StyleState -> (SizeReq, SizeReq) -> (SizeReq, SizeReq) sizeReqAddStyle style (reqW, reqH) = (newReqW, newReqH) where @@ -39,18 +36,25 @@ sizeReqAddStyle style (reqW, reqH) = (newReqW, newReqH) where sizeReqMin :: SizeReq -> Double sizeReqMin (FixedSize c) = c -sizeReqMin (FlexSize c _) = c +sizeReqMin (FlexSize c _) = 0 sizeReqMin (MinSize c _) = c -sizeReqMin (MaxSize c _) = c +sizeReqMin (MaxSize c _) = 0 sizeReqMin (RangeSize c1 c2 _) = c1 sizeReqMax :: SizeReq -> Double sizeReqMax (FixedSize c) = c -sizeReqMax (FlexSize c _) = c -sizeReqMax (MinSize c _) = c +sizeReqMax (FlexSize c _) = maxNumericValue +sizeReqMax (MinSize c _) = maxNumericValue sizeReqMax (MaxSize c _) = c sizeReqMax (RangeSize c1 c2 _) = c2 +sizeReqMaxBounded :: SizeReq -> Double +sizeReqMaxBounded (FixedSize c) = c +sizeReqMaxBounded (FlexSize c _) = c +sizeReqMaxBounded (MinSize c _) = c +sizeReqMaxBounded (MaxSize c _) = c +sizeReqMaxBounded (RangeSize c1 c2 _) = c2 + sizeReqFixed :: SizeReq -> Double sizeReqFixed (FixedSize s) = s sizeReqFixed (FlexSize s _) = 0 diff --git a/tasks.md b/tasks.md index fdd2734a..fcd5966a 100644 --- a/tasks.md +++ b/tasks.md @@ -429,7 +429,9 @@ Maybe postponed after release? - Create Split + - Use space proportional to what widgets request - Does widgetResize need to return WidgetResult? + - User may want to listen for resize events - Create Slider - Create Keystroke component (shortcuts and general key handling like Esc for dialog) - Create Tooltip component. It just wraps a given component and draws the tooltip with renderOverlay