Split containers preferredSize/resize parameters from tuple to individual args

src/Monomer/Widget/BaseContainer.hs

@@ -14,7 +14,8 @@ module Monomer.Widget.BaseContainer (
   containerPreferredSize,
   containerResize,
   containerRender,
-  defaultContainerRender
+  defaultContainerRender,
+  visibleChildrenReq
 ) where
 
 import Control.Monad
@@ -38,14 +39,12 @@ import Monomer.Widget.WidgetContext
 import Monomer.Widget.Types
 import Monomer.Widget.Util
 
-type ChildSizeReq s e = (WidgetInstance s e, Tree SizeReq)
-
 type ContainerInitHandler s e = WidgetEnv s e -> WidgetContext -> WidgetInstance s e -> WidgetResult s e
 type ContainerMergeHandler s e = WidgetEnv s e -> WidgetContext -> Maybe WidgetState -> WidgetInstance s e -> WidgetResult s e
 type ContainerEventHandler s e = WidgetEnv s e -> WidgetContext -> SystemEvent -> WidgetInstance s e -> Maybe (WidgetResult s e)
 type ContainerMessageHandler i s e = Typeable i => WidgetEnv s e -> WidgetContext -> i -> WidgetInstance s e -> Maybe (WidgetResult s e)
-type ContainerPreferredSizeHandler s e = WidgetEnv s e -> WidgetInstance s e -> Seq (ChildSizeReq s e) -> Tree SizeReq
-type ContainerResizeHandler s e = WidgetEnv s e -> Rect -> Rect -> WidgetInstance s e -> Seq (ChildSizeReq s e) -> (WidgetInstance s e, Seq (Rect, Rect))
+type ContainerPreferredSizeHandler s e = WidgetEnv s e -> WidgetInstance s e -> Seq (WidgetInstance s e) -> Seq (Tree SizeReq) -> Tree SizeReq
+type ContainerResizeHandler s e = WidgetEnv s e -> Rect -> Rect -> WidgetInstance s e -> Seq (WidgetInstance s e) -> Seq (Tree SizeReq) -> (WidgetInstance s e, Seq (Rect, Rect))
 type ContainerRenderHandler s e m = (Monad m) => Renderer m -> WidgetEnv s e -> WidgetContext -> WidgetInstance s e -> m ()
 
 createContainer :: Widget s e
@@ -209,16 +208,15 @@ containerHandleMessage mHandler wenv ctx arg widgetInstance
 
 -- | Preferred size
 defaultPreferredSize :: ContainerPreferredSizeHandler s e
-defaultPreferredSize wenv widgetInstance childrenPairs = Node current childrenReqs where
+defaultPreferredSize wenv widgetInstance children reqs = Node current reqs where
   current = SizeReq {
     _sizeRequested = Size 0 0,
     _sizePolicyWidth = FlexibleSize,
     _sizePolicyHeight = FlexibleSize
   }
-  childrenReqs = fmap snd childrenPairs
 
 containerPreferredSize :: ContainerPreferredSizeHandler s e -> WidgetEnv s e -> WidgetInstance s e -> Tree SizeReq
-containerPreferredSize psHandler wenv widgetInstance = psHandler wenv widgetInstance (Seq.zip children childrenReqs) where
+containerPreferredSize psHandler wenv widgetInstance = psHandler wenv widgetInstance children childrenReqs where
   children = _instanceChildren widgetInstance
   childrenReqs = fmap updateChild children
   updateChild child = Node (updateSizeReq req child) reqs where
@@ -226,8 +224,8 @@ containerPreferredSize psHandler wenv widgetInstance = psHandler wenv widgetInst
 
 -- | Resize
 defaultResize :: ContainerResizeHandler s e
-defaultResize wenv viewport renderArea widgetInstance childrenReqs = (widgetInstance, childrenSizes) where
-  childrenSizes = Seq.replicate (Seq.length childrenReqs) (def, def)
+defaultResize wenv viewport renderArea widgetInstance children reqs = (widgetInstance, childrenSizes) where
+  childrenSizes = Seq.replicate (Seq.length reqs) (def, def)
 
 containerResize :: ContainerResizeHandler s e -> WidgetEnv s e -> Rect -> Rect -> WidgetInstance s e -> Tree SizeReq -> WidgetInstance s e
 containerResize rHandler wenv viewport renderArea widgetInstance reqs = newInstance where
@@ -235,7 +233,7 @@ containerResize rHandler wenv viewport renderArea widgetInstance reqs = newInsta
   defReqs = Seq.replicate (Seq.length children) (singleNode def)
   curReqs = nodeChildren reqs
   childrenReqs = if Seq.null curReqs then defReqs else curReqs
-  (tempInstance, assignedAreas) = rHandler wenv viewport renderArea widgetInstance (Seq.zip children childrenReqs)
+  (tempInstance, assignedAreas) = rHandler wenv viewport renderArea widgetInstance children childrenReqs
   resizeChild (child, req, (viewport, renderArea)) = _widgetResize (_instanceWidget child) wenv viewport renderArea child req
   newChildren = resizeChild <$> Seq.zip3 children childrenReqs assignedAreas
   newInstance = tempInstance {
@@ -277,3 +275,10 @@ updateCtx ctx widgetInstance = ctx {
   _wcVisible = _wcVisible ctx && _instanceVisible widgetInstance,
   _wcEnabled = _wcEnabled ctx && _instanceEnabled widgetInstance
 }
+
+visibleChildrenReq :: Seq (WidgetInstance s e) -> Seq (Tree SizeReq) -> (Seq (WidgetInstance s e), Seq SizeReq)
+visibleChildrenReq children reqs = Seq.unzipWith extract filtered where
+  pairs = Seq.zip children reqs
+  isVisible (child, req) = _instanceVisible child
+  filtered = Seq.filter isVisible pairs
+  extract (child, treq) = (child, nodeValue treq)

src/Monomer/Widget/Widgets/Container.hs

@@ -56,11 +56,10 @@ makeContainer config = createContainer {
                     else Nothing
       _ -> Nothing
 
-    preferredSize wenv widgetInstance childrenPairs = Node sizeReq childrenReqs where
-      childrenReqs = fmap snd childrenPairs
-      sizeReq = nodeValue $ Seq.index childrenReqs 0
+    preferredSize wenv widgetInstance children reqs = Node sizeReq reqs where
+      sizeReq = nodeValue $ Seq.index reqs 0
 
-    resize wenv viewport renderArea widgetInstance childrenPairs = (widgetInstance, assignedArea) where
+    resize wenv viewport renderArea widgetInstance children reqs = (widgetInstance, assignedArea) where
       assignedArea = Seq.singleton (viewport, renderArea)
 
     render renderer wenv ctx widgetInstance = do

src/Monomer/Widget/Widgets/Dropdown.hs

@@ -154,20 +154,21 @@ makeDropdown config state = createContainer {
       newReqs = Seq.fromList $ widgetValueSet (_ddValue config) item
       newEvents = Seq.fromList $ fmap ($ item) (_ddOnChange config)
 
-    preferredSize wenv widgetInstance childrenPairs = Node sizeReq childrenReqs where
+    preferredSize wenv widgetInstance children reqs = Node sizeReq reqs where
       Style{..} = _instanceStyle widgetInstance
       size = getTextBounds wenv _styleText (dropdownLabel wenv)
       sizeReq = SizeReq size FlexibleSize StrictSize
-      childrenReqs = fmap snd childrenPairs
 
-    resize wenv viewport renderArea widgetInstance reqs = (widgetInstance, Seq.singleton assignedArea) where
-      assignedArea = case Seq.lookup 0 reqs of
+    resize wenv viewport renderArea widgetInstance children reqs = (widgetInstance, assignedArea) where
+      childrenReqs = Seq.zip children reqs
+      area = case Seq.lookup 0 childrenReqs of
         Just (child, reqChild) -> (oViewport, oRenderArea) where
           reqHeight = _h . _sizeRequested . nodeValue $ reqChild
           maxHeight = min reqHeight 150
           oViewport = viewport { _ry = _ry viewport + _rh viewport, _rh = maxHeight }
           oRenderArea = renderArea { _ry = _ry renderArea + _rh viewport }
         Nothing -> (viewport, renderArea)
+      assignedArea = Seq.singleton area
 
     render renderer wenv ctx WidgetInstance{..} =
       do

src/Monomer/Widget/Widgets/Grid.hs

@@ -32,28 +32,25 @@ makeFixedGrid isHorizontal = createContainer {
     _widgetResize = containerResize resize
   }
   where
-    preferredSize wenv widgetInstance childrenPairs = Node reqSize children where
-      children = fmap snd childrenPairs
-      visiblePairs = Seq.filter (_instanceVisible . fst) childrenPairs
-      childrenReqs = fmap (nodeValue . snd) visiblePairs
+    preferredSize wenv widgetInstance children reqs = Node reqSize reqs where
+      (vchildren, vreqs) = visibleChildrenReq children reqs
       reqSize = SizeReq (Size width height) FlexibleSize FlexibleSize
-      width = if Seq.null children then 0 else fromIntegral wMul * (maximum . fmap (_w . _sizeRequested)) childrenReqs
-      height = if Seq.null children then 0 else fromIntegral hMul * (maximum . fmap (_h . _sizeRequested)) childrenReqs
-      wMul = if isHorizontal then length children else 1
-      hMul = if isHorizontal then 1 else length children
+      width = if Seq.null vchildren then 0 else fromIntegral wMul * (maximum . fmap (_w . _sizeRequested)) vreqs
+      height = if Seq.null vchildren then 0 else fromIntegral hMul * (maximum . fmap (_h . _sizeRequested)) vreqs
+      wMul = if isHorizontal then length vchildren else 1
+      hMul = if isHorizontal then 1 else length vchildren
 
-    resize wenv viewport renderArea widgetInstance childrenPairs = (widgetInstance, assignedAreas) where
-      visiblePairs = Seq.filter (_instanceVisible . fst) childrenPairs
-      children = fmap fst visiblePairs
+    resize wenv viewport renderArea widgetInstance children reqs = (widgetInstance, assignedAreas) where
+      vchildren = Seq.filter _instanceVisible children
       Rect l t w h = renderArea
-      cols = if isHorizontal then length visiblePairs else 1
-      rows = if isHorizontal then 1 else length visiblePairs
+      cols = if isHorizontal then length vchildren else 1
+      rows = if isHorizontal then 1 else length vchildren
       foldHelper (newAreas, index) child = (newAreas |> newArea, newIndex) where
         visible = _instanceVisible child
         newIndex = index + if _instanceVisible child then 1 else 0
         newViewport = if visible then calcViewport index else def
         newArea = (newViewport, newViewport)
-      assignedAreas = fst $ foldl' foldHelper (Seq.empty, 0) children
+      assignedAreas = fst $ foldl' foldHelper (Seq.empty, 0) vchildren
       calcViewport i = Rect (cx i) (cy i) cw ch
       cw = if cols > 0 then w / fromIntegral cols else 0
       ch = if rows > 0 then h / fromIntegral rows else 0

src/Monomer/Widget/Widgets/ListView.hs

@@ -166,11 +166,10 @@ makeListView config state = createContainer {
       scrollPath = _wcCurrentPath $ childContext ctx
       makeScrollReq rect = SendMessage scrollPath (ScrollTo rect)
 
-    preferredSize wenv widgetInstance childrenPairs = Node sizeReq childrenReqs where
-      childrenReqs = fmap snd childrenPairs
-      sizeReq = nodeValue $ Seq.index childrenReqs 0
+    preferredSize wenv widgetInstance children reqs = Node sizeReq reqs where
+      sizeReq = nodeValue $ Seq.index reqs 0
 
-    resize wenv viewport renderArea widgetInstance childrenPairs = (widgetInstance, assignedArea) where
+    resize wenv viewport renderArea widgetInstance children reqs = (widgetInstance, assignedArea) where
       assignedArea = Seq.singleton (viewport, renderArea)
 
 makeItemsList :: (Eq a) => ListViewConfig s e a -> WidgetContext -> a -> Int -> WidgetInstance s e

src/Monomer/Widget/Widgets/Scroll.hs

@@ -208,9 +208,8 @@ makeScroll config state@(ScrollState dragging dx dy cs prevReqs) = createContain
       tempInstance = widgetInstance { _instanceWidget = newWidget }
       newInstance = scrollResize (Just newWidget) wenv (_instanceViewport tempInstance) (_instanceRenderArea tempInstance) tempInstance reqs
 
-    preferredSize wenv widgetInstance childrenPairs = Node sizeReq childrenReqs where
-      childrenReqs = fmap snd childrenPairs
-      sizeReq = SizeReq (_sizeRequested . nodeValue $ Seq.index childrenReqs 0) FlexibleSize FlexibleSize
+    preferredSize wenv widgetInstance children reqs = Node sizeReq reqs where
+      sizeReq = SizeReq (_sizeRequested . nodeValue $ Seq.index reqs 0) FlexibleSize FlexibleSize
 
     scrollResize updatedWidget wenv viewport renderArea widgetInstance reqs = newInstance where
       Rect l t w h = renderArea

src/Monomer/Widget/Widgets/Stack.hs

@@ -33,22 +33,20 @@ makeStack isHorizontal = createContainer {
     _widgetResize = containerResize resize
   }
   where
-    preferredSize wenv widgetInstance childrenPairs = Node reqSize childrenReqs where
-      reqSize = SizeReq (calcPreferredSize childrenPairs) FlexibleSize FlexibleSize
-      childrenReqs = fmap snd childrenPairs
+    preferredSize wenv widgetInstance children reqs = Node reqSize reqs where
+      (_, vreqs) = visibleChildrenReq children reqs
+      reqSize = SizeReq (calcPreferredSize vreqs) FlexibleSize FlexibleSize
 
-    resize wenv viewport renderArea widgetInstance childrenPairs = (widgetInstance, assignedArea) where
+    resize wenv viewport renderArea widgetInstance children reqs = (widgetInstance, assignedArea) where
       Rect l t w h = renderArea
-      visibleChildren = Seq.filter (_instanceVisible . fst) childrenPairs
-      policySelector = if isHorizontal then _sizePolicyWidth else _sizePolicyHeight
-      sizeSelector = if isHorizontal then _w else _h
-      rectSelector = if isHorizontal then _rw else _rh
+      childrenPairs = Seq.zip children reqs
+      (vchildren, vreqs) = visibleChildrenReq children reqs
       mainSize = if isHorizontal then w else h
       mainStart = if isHorizontal then l else t
-      policyFilter policy childPair = policySelector (nodeValue $ snd childPair) == policy
-      sChildren = Seq.filter (policyFilter StrictSize) visibleChildren
-      fChildren = Seq.filter (policyFilter FlexibleSize) visibleChildren
-      rChildren = Seq.filter (policyFilter RemainderSize) visibleChildren
+      policyFilter policy req = policySelector req == policy
+      sChildren = Seq.filter (policyFilter StrictSize) vreqs
+      fChildren = Seq.filter (policyFilter FlexibleSize) vreqs
+      rChildren = Seq.filter (policyFilter RemainderSize) vreqs
       fExists = not $ null fChildren
       rExists = not $ null rChildren
       sSize = sizeSelector $ calcPreferredSize sChildren
@@ -63,33 +61,37 @@ makeStack isHorizontal = createContainer {
       (revViewports, _) = foldl' foldHelper (Seq.empty, mainStart) childrenPairs
       foldHelper (accum, offset) childPair = (newAccum, newOffset) where
         newAccum = newSize <| accum
-        newSize = resizeChild offset childPair
+        newSize = resizeChild renderArea fSize fExtra rSize rUnit offset childPair
         newOffset = offset + rectSelector newSize
-      resizeChild offset childPair = result where
-        result = if | not $ _instanceVisible widgetInstance -> emptyRect
-                    | isHorizontal -> hRect
-                    | otherwise -> vRect
-        widgetInstance = fst childPair
-        req = nodeValue $ snd childPair
-        srSize = _sizeRequested req
-        emptyRect = Rect l t 0 0
-        hRect = Rect offset t calcNewSize h
-        vRect = Rect l offset w calcNewSize
-        calcNewSize = case policySelector req of
-          StrictSize -> sizeSelector srSize
-          FlexibleSize -> if | rSize >= fSize -> sizeSelector srSize + fExtra
-                             | otherwise -> sizeSelector srSize * rSize / fSize
-          RemainderSize -> rUnit
 
-    calcPreferredSize childrenPairs = Size width height where
-      (maxWidth, sumWidth, maxHeight, sumHeight) = calcDimensions childrenPairs
+    resizeChild renderArea fSize fExtra rSize rUnit offset childPair = result where
+      Rect l t w h = renderArea
+      result = if | not $ _instanceVisible childInstance -> emptyRect
+                  | isHorizontal -> hRect
+                  | otherwise -> vRect
+      childInstance = fst childPair
+      req = nodeValue $ snd childPair
+      srSize = _sizeRequested req
+      emptyRect = Rect l t 0 0
+      hRect = Rect offset t calcNewSize h
+      vRect = Rect l offset w calcNewSize
+      calcNewSize = case policySelector req of
+        StrictSize -> sizeSelector srSize
+        FlexibleSize -> if | rSize >= fSize -> sizeSelector srSize + fExtra
+                           | otherwise -> sizeSelector srSize * rSize / fSize
+        RemainderSize -> rUnit
+
+    calcPreferredSize vreqs = Size width height where
+      (maxWidth, sumWidth, maxHeight, sumHeight) = calcDimensions vreqs
       width = if isHorizontal then sumWidth else maxWidth
       height = if isHorizontal then maxHeight else sumHeight
 
-    calcDimensions childrenPairs = (maxWidth, sumWidth, maxHeight, sumHeight) where
-      visiblePairs = Seq.filter (_instanceVisible . fst) childrenPairs
-      visibleChildren = fmap (nodeValue . snd) visiblePairs 
-      maxWidth = if Seq.null visibleChildren then 0 else (maximum . fmap (_w . _sizeRequested)) visibleChildren
-      sumWidth = (sum . fmap (_w . _sizeRequested)) visibleChildren
-      maxHeight = if null visibleChildren then 0 else (maximum . fmap (_h . _sizeRequested)) visibleChildren
-      sumHeight = (sum . fmap (_h . _sizeRequested)) visibleChildren
+    calcDimensions vreqs = (maxWidth, sumWidth, maxHeight, sumHeight) where
+      maxWidth = if Seq.null vreqs then 0 else (maximum . fmap (_w . _sizeRequested)) vreqs
+      sumWidth = (sum . fmap (_w . _sizeRequested)) vreqs
+      maxHeight = if null vreqs then 0 else (maximum . fmap (_h . _sizeRequested)) vreqs
+      sumHeight = (sum . fmap (_h . _sizeRequested)) vreqs
+
+    sizeSelector = if isHorizontal then _w else _h
+    rectSelector = if isHorizontal then _rw else _rh
+    policySelector = if isHorizontal then _sizePolicyWidth else _sizePolicyHeight

tasks.md

@@ -127,6 +127,7 @@
 - Pending
   - Make sure enabled/visible attributes are being used
     - This needs modifying WidgetContext (former PathContext) to include visible and enabled attributes
+  - Move widgetPath into WidgetInstance (do it in init/merge)
   - Format code!
   - Add testing
     - Delayed until this point to try to settle down interfaces