Handle node visibility

app/Main.hs

@@ -136,17 +136,17 @@ buildUI model = styledTree where
   labelStyle = bgColor (rgb 100 100 100) <> textSize 48
   textStyle = textColor (rgb 0 255 0)
   extraWidgets = map (\i -> sandbox (Action1 (10 + i))) [1..(_clickCount model)]
-  widgetTree = vgrid [
+  widgetTree = vstack [
       hgrid [
         scroll $ vstack [
-          textField `style` textStyle,
-          spacer,
+          textField `style` textStyle `visible` False,
+          spacer `visible` False,
           label "Label 1",
           spacer,
           label "Label 2",
-          spacer,
-          label "Label 3",
-          spacer,
+          spacer `visible` False,
+          label "Label 3" `visible` False,
+          spacer `visible` False,
           label "Label 4",
           spacer,
           label "Label 5",
@@ -165,7 +165,7 @@ buildUI model = styledTree where
           spacer,
           label "Label 12"
         ],
-        vgrid [
+        vstack [
           textField `style` textStyle,
           scroll $ label "This is a really really really long label, you know?" `style` labelStyle
         ]
@@ -184,7 +184,7 @@ buildUI model = styledTree where
           spacer,
           label "Very Very Very Very Long"
         ],
-        hgrid [
+        hstack [
           sandbox (Action1 1) `style` buttonStyle,
           sandbox (Action1 2) `style` buttonStyle,
           sandbox (Action1 3) `style` buttonStyle

src/GUI/Common/Core.hs

@@ -36,7 +36,7 @@ type Timestamp = Int
 type WidgetNode s e m = Tree (WidgetInstance s e m)
 type WidgetChildren s e m = SQ.Seq (WidgetNode s e m)
 
-newtype WidgetType = WidgetType String deriving Eq
+newtype WidgetType = WidgetType String deriving (Eq, Show)
 newtype WidgetKey = WidgetKey String deriving Eq
 
 instance IsString WidgetType where
@@ -50,7 +50,8 @@ data WidgetState = forall i . (Typeable i, Generic i) => WidgetState i
 data SizeReq = SizeReq {
   _srSize :: Size,
   _srPolicyWidth :: SizePolicy,
-  _srPolicyHeight :: SizePolicy
+  _srPolicyHeight :: SizePolicy,
+  _srVisible :: Bool
 } deriving (Show, Eq)
 
 data WidgetEventResult s e m = WidgetEventResult {
@@ -143,6 +144,8 @@ data WidgetInstance s e m =
     _widgetInstanceWidget :: Widget s e m,
     -- | Indicates if the widget is enabled for user interaction
     _widgetInstanceEnabled :: Bool,
+    -- | Indicates if the widget is visible
+    _widgetInstanceVisible :: Bool,
     -- | Indicates if the widget is focused
     _widgetInstanceFocused :: Bool,
     -- | The visible area of the screen assigned to the widget
@@ -174,6 +177,9 @@ initGUIContext app winSize useHiDPI devicePixelRate = GUIContext {
   _widgetTasks = []
 }
 
+sizeReq :: Size -> SizePolicy -> SizePolicy -> SizeReq
+sizeReq size policyWidth policyHeight = SizeReq size policyWidth policyHeight True
+
 resultEvents :: [e] -> Maybe (WidgetEventResult s e m)
 resultEvents userEvents = Just $ WidgetEventResult [] userEvents Nothing
 
@@ -207,6 +213,9 @@ key key wn = wn { _widgetInstanceKey = Just key }
 style :: (MonadState s m) => WidgetNode s e m -> Style -> WidgetNode s e m
 style (Node value children) newStyle = Node (value { _widgetInstanceStyle = newStyle }) children
 
+visible :: (MonadState s m) => WidgetNode s e m -> Bool -> WidgetNode s e m
+visible (Node value children) visibility = Node (value { _widgetInstanceVisible = visibility }) children
+
 children :: (MonadState s m) => WidgetNode s e m -> [WidgetNode s e m] -> WidgetNode s e m
 children (Node value _) newChildren = fromList value newChildren
 
@@ -221,6 +230,7 @@ defaultWidgetInstance widget = WidgetInstance {
   _widgetInstanceKey = Nothing,
   _widgetInstanceWidget = widget,
   _widgetInstanceEnabled = True,
+  _widgetInstanceVisible = True,
   _widgetInstanceFocused = False,
   _widgetInstanceViewport = def,
   _widgetInstanceRenderArea = def,
@@ -310,7 +320,8 @@ handleCustomCommand path treeNode customData = case GUI.Data.Tree.lookup path tr
 
 handleRender :: (MonadState s m) => Renderer m -> WidgetNode s e m -> Timestamp -> m ()
 handleRender renderer (Node (widgetInstance@WidgetInstance { _widgetInstanceWidget = Widget{..}, .. }) children) ts = do
-  _widgetRender renderer widgetInstance children ts
+  when _widgetInstanceVisible $
+    _widgetRender renderer widgetInstance children ts
 
 handleRenderChildren :: (MonadState s m) => Renderer m -> WidgetChildren s e m -> Timestamp -> m ()
 handleRenderChildren renderer children ts = do
@@ -330,15 +341,17 @@ setFocusedStatus path focused root = case updateWidgetInstance path root updateF
 
 resizeUI :: (MonadState s m) => Renderer m -> Rect -> WidgetNode s e m -> m (WidgetNode s e m)
 resizeUI renderer assignedRect widgetInstance = do
-  preferredSizes <- buildPreferredSizes renderer widgetInstance
+  preferredSizes <- buildPreferredSizes renderer True widgetInstance
   resizeNode renderer assignedRect assignedRect preferredSizes widgetInstance
 
-buildPreferredSizes :: (MonadState s m) => Renderer m -> WidgetNode s e m -> m (Tree SizeReq)
-buildPreferredSizes renderer (Node (WidgetInstance {..}) children) = do
-  childrenSizes <- mapM (buildPreferredSizes renderer) children
+buildPreferredSizes :: (MonadState s m) => Renderer m -> Bool -> WidgetNode s e m -> m (Tree SizeReq)
+buildPreferredSizes renderer parentVisible (Node (WidgetInstance {..}) children) = do
+  let isVisible = parentVisible && _widgetInstanceVisible
+
+  childrenSizes <- mapM (buildPreferredSizes renderer isVisible) children
   size <- _widgetPreferredSize _widgetInstanceWidget renderer _widgetInstanceStyle (seqToList childrenSizes)
 
-  return $ Node size childrenSizes
+  return $ Node (size { _srVisible = isVisible}) childrenSizes
 
 resizeNode :: (MonadState s m) => Renderer m -> Rect -> Rect -> Tree SizeReq -> WidgetNode s e m -> m (WidgetNode s e m)
 resizeNode renderer viewport renderArea (Node _ childrenSizes) (Node widgetInstance childrenWns) = do

src/GUI/Widget/Button.hs

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

src/GUI/Widget/Grid.hs

@@ -46,19 +46,22 @@ makeFixedGrid widgetType direction = Widget {
     focusable = False
     handleEvent _ _ = Nothing
     preferredSize _ _ children = return reqSize where
-      reqSize = SizeReq (Size width height) FlexibleSize FlexibleSize
+      reqSize = sizeReq (Size width height) FlexibleSize FlexibleSize
       width = if null children then 0 else (fromIntegral wMul) * (maximum . map (_w . _srSize)) children
       height = if null children then 0 else (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
-      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)]
+      visibleChildren = filter _srVisible children
+      cols = if direction == Horizontal then (length visibleChildren) else 1
+      rows = if direction == Horizontal then 1 else (length visibleChildren)
+      foldHelper (accum, index) child = (index : accum, index + if _srVisible child then 1 else 0)
+      indices = reverse . fst $ foldl foldHelper ([], 0) children
+      newViewports = fmap resizeChild indices
       resizeChild i = Rect (cx i) (cy i) cw ch
-      cw = w / fromIntegral cols
-      ch = h / fromIntegral rows
-      cx i = l + (fromIntegral $ i `div` rows) * cw
-      cy i = t + (fromIntegral $ i `div` cols) * ch
+      cw = if cols > 0 then w / fromIntegral cols else 0
+      ch = if rows > 0 then h / fromIntegral rows else 0
+      cx i = if rows > 0 then l + (fromIntegral $ i `div` rows) * cw else 0
+      cy i = if cols > 0 then t + (fromIntegral $ i `div` cols) * ch else 0
     render renderer WidgetInstance{..} children ts = do
       handleRenderChildren renderer children ts

src/GUI/Widget/Label.hs

@@ -41,7 +41,7 @@ makeLabel caption = Widget {
     handleEvent view evt = Nothing
     preferredSize renderer (style@Style{..}) _ = do
       size <- calcTextBounds renderer _textStyle (if caption == "" then " " else caption)
-      return $ SizeReq size FlexibleSize FlexibleSize
+      return $ sizeReq size FlexibleSize FlexibleSize
     resizeChildren _ _ _ _ = Nothing
     render renderer WidgetInstance{..} _ ts =
       do

src/GUI/Widget/Sandbox.hs

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

src/GUI/Widget/Scroll.hs

@@ -74,7 +74,7 @@ makeScroll state@(ScrollState dx dy cs@(Size cw ch)) = Widget {
                       else viewportLimit - childPos
     preferredSize _ _ children = return (head children)
     resizeChildren (Rect l t w h) _ _ children = Just $ WidgetResizeResult viewport renderArea newWidget where
-      SizeReq (Size cw2 ch2) _ _ = (head children)
+      Size cw2 ch2 = _srSize (head children)
       areaW = max w cw2
       areaH = max h ch2
       newWidget = Just $ makeScroll (ScrollState dx dy (Size areaW areaH))

src/GUI/Widget/Spacer.hs

@@ -30,6 +30,6 @@ makeSpacer = Widget {
   }
   where
     handleEvent view evt = Nothing
-    preferredSize renderer (style@Style{..}) _ = return $ SizeReq (Size defaultSpace defaultSpace) RemainderSize RemainderSize
+    preferredSize renderer (style@Style{..}) _ = return $ sizeReq (Size defaultSpace defaultSpace) RemainderSize RemainderSize
     resizeChildren _ _ _ _ = Nothing
     render renderer WidgetInstance{..} _ ts = return ()

src/GUI/Widget/Stack.hs

@@ -41,16 +41,17 @@ makeStack widgetType direction = Widget {
     focusable = False
     handleEvent _ _ = Nothing
     preferredSize _ _ children = return reqSize where
-      reqSize = SizeReq (calcPreferredSize children) FlexibleSize FlexibleSize
+      reqSize = sizeReq (calcPreferredSize children) FlexibleSize FlexibleSize
     resizeChildren _ (Rect l t w h) style children = Just $ WidgetResizeResult newViewports newViewports Nothing where
+      visibleChildren = filter _srVisible children
       policySelector = if isHorizontal then _srPolicyWidth else _srPolicyHeight
       sizeSelector = if isHorizontal then _w else _h
       rectSelector = if isHorizontal then _rw else _rh
       mSize = if isHorizontal then w else h
       mStart = if isHorizontal then l else t
-      sChildren = filter (\c -> policySelector c == StrictSize) children
-      fChildren = filter (\c -> policySelector c == FlexibleSize) children
-      rChildren = filter (\c -> policySelector c == RemainderSize) children
+      sChildren = filter (\c -> policySelector c == StrictSize) visibleChildren
+      fChildren = filter (\c -> policySelector c == FlexibleSize) visibleChildren
+      rChildren = filter (\c -> policySelector c == RemainderSize) visibleChildren
       remainderCount = length rChildren
       remainderExist = not $ null rChildren
       sSize = sizeSelector $ calcPreferredSize sChildren
@@ -65,7 +66,9 @@ makeStack widgetType direction = Widget {
       (revViewports, _) = foldl foldHelper ([], mStart) children
       foldHelper (accum, offset) child = (newSize : accum, offset + rectSelector newSize) where
         newSize = resizeChild offset child
-      resizeChild offset sr@(SizeReq srSize _ _) = if isHorizontal then hRect else vRect where
+      resizeChild offset sr = if not (_srVisible sr) then emptyRect else if isHorizontal then hRect else vRect where
+        srSize = _srSize sr
+        emptyRect = Rect l t 0 0
         hRect = Rect offset t newSize h
         vRect = Rect l offset w newSize
         newSize = case policySelector sr of

src/GUI/Widget/TextField.hs

@@ -72,7 +72,7 @@ makeTextField tfs@(TextFieldState currText currPos) = Widget {
       newState = TextFieldState newText newPos
     preferredSize renderer (style@Style{..}) _ = do
       size <- calcTextBounds renderer _textStyle (if currText == "" then " " else currText)
-      return $ SizeReq size FlexibleSize FlexibleSize
+      return $ sizeReq size FlexibleSize FlexibleSize
     resizeChildren _ _ _ _ = Nothing
     render renderer WidgetInstance{..} _ ts =
       do