Find new focus when zstack items change visibility and it is parent of focus

src/Monomer/Core/WidgetTypes.hs

@@ -66,7 +66,7 @@ data WidgetRequest s
   = IgnoreParentEvents
   | IgnoreChildrenEvents
   | ResizeWidgets
-  | MoveFocus FocusDirection
+  | MoveFocus (Maybe Path) FocusDirection
   | SetFocus Path
   | GetClipboard Path
   | SetClipboard ClipboardData
@@ -287,7 +287,7 @@ instance Show (WidgetRequest s) where
   show IgnoreParentEvents = "IgnoreParentEvents"
   show IgnoreChildrenEvents = "IgnoreChildrenEvents"
   show ResizeWidgets = "ResizeWidgets"
-  show (MoveFocus dir) = "MoveFocus: " ++ show dir
+  show (MoveFocus start dir) = "MoveFocus: " ++ show (start, dir)
   show (SetFocus path) = "SetFocus: " ++ show path
   show (GetClipboard path) = "GetClipboard: " ++ show path
   show (SetClipboard _) = "SetClipboard"

src/Monomer/Main/Handlers.hs

@@ -128,7 +128,7 @@ handleRequests reqs step = foldM handleRequest step reqs where
     IgnoreParentEvents -> return step
     IgnoreChildrenEvents -> return step
     ResizeWidgets -> return step
-    MoveFocus dir -> handleMoveFocus dir step
+    MoveFocus start dir -> handleMoveFocus start dir step
     SetFocus path -> handleSetFocus path step
     GetClipboard path -> handleGetClipboard path step
     SetClipboard cdata -> handleSetClipboard cdata step
@@ -168,8 +168,12 @@ handleResizeWidgets reqs previousStep =
     _ -> return previousStep
 
 handleMoveFocus
-  :: (MonomerM s m) => FocusDirection -> HandlerStep s e -> m (HandlerStep s e)
-handleMoveFocus direction  (wenv, events, root) = do
+  :: (MonomerM s m)
+  => Maybe Path
+  -> FocusDirection
+  -> HandlerStep s e
+  -> m (HandlerStep s e)
+handleMoveFocus startFrom direction (wenv, events, root) = do
   oldFocus <- use L.focusedPath
   let wenv0 = wenv { _weFocusedPath = rootPath }
   (wenv1, events1, root1) <- handleSystemEvent wenv0 Blur oldFocus root
@@ -178,7 +182,8 @@ handleMoveFocus direction  (wenv, events, root) = do
 
   if oldFocus == currFocus
     then do
-      let newFocus = findNextFocus wenv1 direction currFocus currOverlay root1
+      let searchFrom = fromMaybe currFocus startFrom
+      let newFocus = findNextFocus wenv1 direction searchFrom currOverlay root1
       let tempWenv = wenv1 { _weFocusedPath = newFocus }
 
       L.focusedPath .= newFocus
@@ -368,7 +373,7 @@ addFocusReq (KeyAction mod code KeyPressed) reqs = newReqs where
     | mod ^. L.leftShift = FocusBwd
     | otherwise = FocusFwd
   newReqs
-    | focusReqNeeded = reqs |> MoveFocus direction
+    | focusReqNeeded = reqs |> MoveFocus Nothing direction
     | otherwise = reqs
 addFocusReq _ reqs = reqs
 

src/Monomer/Widgets/Composite.hs

@@ -641,7 +641,7 @@ toParentReq :: WidgetRequest s -> Maybe (WidgetRequest sp)
 toParentReq IgnoreParentEvents = Just IgnoreParentEvents
 toParentReq IgnoreChildrenEvents = Just IgnoreChildrenEvents
 toParentReq ResizeWidgets = Just ResizeWidgets
-toParentReq (MoveFocus dir) = Just (MoveFocus dir)
+toParentReq (MoveFocus start dir) = Just (MoveFocus start dir)
 toParentReq (SetFocus path) = Just (SetFocus path)
 toParentReq (GetClipboard path) = Just (GetClipboard path)
 toParentReq (SetClipboard clipboard) = Just (SetClipboard clipboard)

src/Monomer/Widgets/Container.hs

@@ -348,9 +348,7 @@ mergeChildrenCheckVisible
   -> WidgetResult s e
 mergeChildrenCheckVisible oldNode result = newResult where
   newNode = result ^. L.node
-  newVisible = fmap (^. L.info . L.visible) (newNode ^. L.children)
-  oldVisible = fmap (^. L.info . L.visible) (oldNode ^. L.children)
-  resizeRequired = oldVisible /= newVisible
+  resizeRequired = visibleChildrenChanged oldNode newNode
   newResult
     | resizeRequired = result & L.requests %~ (|> ResizeWidgets)
     | otherwise = result

src/Monomer/Widgets/Dropdown.hs

@@ -247,10 +247,12 @@ makeDropdown widgetData items makeMain makeRow config state = widget where
     Click point _
       | openRequired point node -> Just $ openDropdown wenv node
       | closeRequired point node -> Just $ closeDropdown wenv node
-    KeyAction mode code status
+    KeyAction mode code KeyPressed
       | isKeyOpenDropdown && not isOpen -> Just $ openDropdown wenv node
       | isKeyEscape code && isOpen -> Just $ closeDropdown wenv node
-      where isKeyOpenDropdown = isKeyDown code || isKeyUp code
+      where
+        activationKeys = [isKeyDown, isKeyUp, isKeySpace, isKeyReturn]
+        isKeyOpenDropdown = or (fmap ($ code) activationKeys)
     _
       | not isOpen -> Just $ resultReqs node [IgnoreChildrenEvents]
       | otherwise -> Nothing
@@ -387,7 +389,7 @@ makeListView wenv value items makeRow config path = listViewNode where
     & L.info . L.style .~ lvStyle
 
 createMoveFocusReq :: WidgetEnv s e -> WidgetRequest s
-createMoveFocusReq wenv = MoveFocus direction where
+createMoveFocusReq wenv = MoveFocus Nothing direction where
   direction
     | wenv ^. L.inputStatus . L.keyMod . L.leftShift = FocusBwd
     | otherwise = FocusFwd

src/Monomer/Widgets/Util/Widget.hs

@@ -1,12 +1,13 @@
 {-# LANGUAGE FlexibleContexts #-}
 
 module Monomer.Widgets.Util.Widget (
-  pointInViewport,
   defaultWidgetNode,
+  pointInViewport,
   isWidgetVisible,
   isPressed,
   isFocused,
   isHovered,
+  visibleChildrenChanged,
   widgetDataGet,
   widgetDataSet,
   resultWidget,
@@ -45,9 +46,6 @@ import Monomer.Graphics.Types
 
 import qualified Monomer.Lens as L
 
-pointInViewport :: Point -> WidgetNode s e -> Bool
-pointInViewport p node = pointInRect p (node ^. L.info . L.viewport)
-
 defaultWidgetNode :: WidgetType -> Widget s e -> WidgetNode s e
 defaultWidgetNode widgetType widget = WidgetNode {
   _wnWidget = widget,
@@ -55,6 +53,9 @@ defaultWidgetNode widgetType widget = WidgetNode {
   _wnChildren = Seq.empty
 }
 
+pointInViewport :: Point -> WidgetNode s e -> Bool
+pointInViewport p node = pointInRect p (node ^. L.info . L.viewport)
+
 isWidgetVisible :: WidgetNode s e -> Rect -> Bool
 isWidgetVisible node vp = isVisible && isOverlapped where
   info = node ^. L.info
@@ -77,6 +78,11 @@ isHovered wenv node = validPos && validPress && isTopLevel wenv node where
   validPos = pointInRect mousePos viewport
   validPress = isPressed wenv node
 
+visibleChildrenChanged :: WidgetNode s e -> WidgetNode s e -> Bool
+visibleChildrenChanged oldNode newNode = oldVisible /= newVisible  where
+  oldVisible = fmap (^. L.info . L.visible) (oldNode ^. L.children)
+  newVisible = fmap (^. L.info . L.visible) (newNode ^. L.children)
+
 widgetDataGet :: s -> WidgetData s a -> a
 widgetDataGet _ (WidgetValue value) = value
 widgetDataGet model (WidgetLens lens) = model ^# lens

src/Monomer/Widgets/ZStack.hs

@@ -7,7 +7,7 @@ module Monomer.Widgets.ZStack (
 ) where
 
 import Control.Applicative ((<|>))
-import Control.Lens ((&), (^.), (.~))
+import Control.Lens ((&), (^.), (.~), (%~))
 import Control.Monad (forM_, void, when)
 import Data.Default
 import Data.Maybe
@@ -57,6 +57,7 @@ makeZStack :: ZStackCfg -> Widget s e
 makeZStack config = widget where
   baseWidget = createContainer def {
     containerKeepChildrenSizes = True,
+    containerMergePost = mergePost,
     containerFindNextFocus = findNextFocus,
     containerGetSizeReq = getSizeReq,
     containerResize = resize
@@ -66,6 +67,20 @@ makeZStack config = widget where
     widgetRender = render
   }
 
+  mergePost wenv result oldState oldNode newNode = newResult where
+    children = newNode ^. L.children
+    focusedPath = wenv ^. L.focusedPath
+    isFocusParent = isWidgetParentOfPath focusedPath newNode
+    topLevel = isTopLevel wenv newNode
+    childrenChanged = visibleChildrenChanged oldNode newNode
+    topVisibleIdx = fromMaybe 0 (Seq.findIndexL (^.L.info . L.visible) children)
+    needsFocus = isFocusParent && topLevel && childrenChanged
+    newPath = Just $ newNode ^. L.info . L.path |> topVisibleIdx
+
+    newResult
+      | needsFocus = result & L.requests %~ (|> MoveFocus newPath FocusFwd)
+      | otherwise = result
+
   -- | Find instance matching point
   findByPoint wenv startPath point node = result where
     onlyTop = fromMaybe True (_zscOnlyTopActive config)

tasks.md

@@ -327,6 +327,9 @@
   - Draw close button on Dialog
   - Check why putting box reduces label's space
     - scroll $ vstack $ (\i -> box $ label ("Label: " <> showt i)) <$> [0..100::Int]
+  - Set focus on ButtonDown, not Click
+    - Can it be handled in Single/Container?
+    - Handled in Single, not in Container, since it clashes with children. Handle explicitly on Containers that need it.
 
 - Pending
   - Add testing
@@ -344,24 +347,22 @@
   - Add user documentation
 
 Maybe postponed after release?
-  - Set focus on ButtonDown, not Click
-    - Can it be handled in Single/Container?
   - Restore focus to previous widget when zstack changes (dialog situation)
     - Also think about not losing focus because of click (when onlyTopFocusable is active)
   - ZStack should set _weIsTopLayer based on used space
+  - Add config to invert mouse buttons (Core.hs:211)
+  - Scroll wheel rate should be configurable, or even depend on content size
   - Image
     - Can performance be improved? Use sbt functions?
     - Does adding function to return imgData from Renderer make sense? Replace imageExists?
     - Remove delay logic when adding an image
     - When adding image, on failure remove an the least used image and retry
   - Make sure WidgetTask/Node association is preserved if node location in tree changes
-  - Add config to invert mouse buttons (Core.hs:211)
   - Check why after click focus is not immediately shown in listView items
   - Further textField improvements
     - Handle undo history
     - Handle mouse selection
     - Create numeric wrapper that allows increasing/decreasing with mouse
-  - Scroll wheel rate should be configurable, or even depend on content size
   - Check if SDL can be initialized headless (for tests that involve the API)
     - https://discourse.libsdl.org/t/possible-to-run-sdl2-headless/25665/2
   - Does it make sense to handle offset