Fix focus handling (navigating to previous was not working)

src/Monomer/Main/Core.hs

@@ -100,7 +100,7 @@ runApp window theme widgetRoot = do
   }
 
   mainModel .= _weModel newWenv
-  pathFocus .= findNextFocus newWenv rootPath resizedRoot
+  pathFocus .= findNextFocus newWenv FocusFwd rootPath resizedRoot
 
   mainLoop window renderer loopArgs
 

src/Monomer/Main/Handlers.hs

@@ -145,7 +145,7 @@ handleFocusChange systemEvent stopProcessing (wenv, events, widgetRoot)
       oldFocus <- use pathFocus
       (wenv1, events1, root1) <- handleSystemEvent wenv Blur oldFocus widgetRoot
 
-      let newFocus = findNextFocus wenv1 oldFocus root1
+      let newFocus = findNextFocus wenv1 focusDirection oldFocus root1
       let tempWenv = wenv1 {
         _weFocusedPath = newFocus
       }
@@ -157,6 +157,9 @@ handleFocusChange systemEvent stopProcessing (wenv, events, widgetRoot)
   | otherwise = return (wenv, events, widgetRoot)
   where
     focusChangeRequested = not stopProcessing && isKeyPressed systemEvent keyTab
+    focusDirection
+      | isShiftPressed systemEvent = FocusBwd
+      | otherwise = FocusFwd
 
 handleFocusSet
   :: (MonomerM s m)

src/Monomer/Main/Util.hs

@@ -27,12 +27,13 @@ initMonomerContext model winSize useHiDPI devicePixelRate = MonomerContext {
   _mcWidgetTasks = Seq.empty
 }
 
-findNextFocus :: WidgetEnv s e -> Path -> WidgetInstance s e -> Path
-findNextFocus wenv currentFocus widgetRoot = fromJust nextFocus where
+findNextFocus
+  :: WidgetEnv s e -> FocusDirection -> Path -> WidgetInstance s e -> Path
+findNextFocus wenv direction focus widgetRoot = fromJust nextFocus where
   widget = _wiWidget widgetRoot
-  candidateFocus = widgetFindNextFocus widget wenv currentFocus widgetRoot
-  fromRootFocus = widgetFindNextFocus widget wenv rootPath widgetRoot
-  nextFocus = candidateFocus <|> fromRootFocus <|> Just currentFocus
+  candidateFocus = widgetFindNextFocus widget wenv direction focus widgetRoot
+  fromRootFocus = widgetFindNextFocus widget wenv direction rootPath widgetRoot
+  nextFocus = candidateFocus <|> fromRootFocus <|> Just focus
 
 resizeWidget
   :: WidgetEnv s e -> Size -> WidgetInstance s e -> WidgetInstance s e

src/Monomer/Widget/BaseContainer.hs

@@ -61,6 +61,7 @@ type ContainerGetStateHandler s e
 
 type ContainerFindNextFocusHandler s e
   = WidgetEnv s e
+  -> FocusDirection
   -> Path
   -> WidgetInstance s e
   -> Maybe Path
@@ -262,16 +263,20 @@ defaultGetState _ = Nothing
 
 -- | Find next focusable item
 defaultFindNextFocus
-  :: WidgetEnv s e -> Path -> WidgetInstance s e -> Maybe Path
-defaultFindNextFocus wenv startFrom widgetInst = nextFocus where
-  children = _wiChildren widgetInst
-  isBeforeTarget ch = isTargetBeforeCurrent startFrom ch
-  nextCandidate ch = widgetFindNextFocus (_wiWidget ch) wenv startFrom ch
+  :: WidgetEnv s e -> FocusDirection -> Path -> WidgetInstance s e -> Maybe Path
+defaultFindNextFocus wenv direction start widgetInst = nextFocus where
+  children
+    | direction == FocusFwd = _wiChildren widgetInst
+    | otherwise = Seq.reverse (_wiChildren widgetInst)
+  isBeforeTarget ch
+    | direction == FocusFwd = isTargetBeforeCurrent start ch
+    | otherwise = isTargetAfterCurrent start ch
+  nextCandidate ch = widgetFindNextFocus (_wiWidget ch) wenv direction start ch
   filtered = Seq.filter isBeforeTarget children
   candidates = fmap nextCandidate filtered
   focusedPaths = fmap fromJust (Seq.filter isJust candidates)
   nextFocus
-    | isFocusCandidate startFrom widgetInst = Just (_wiPath widgetInst)
+    | isFocusCandidate direction start widgetInst = Just (_wiPath widgetInst)
     | otherwise = Seq.lookup 0 focusedPaths
 
 -- | Find instance matching point

src/Monomer/Widget/BaseSingle.hs

@@ -41,6 +41,7 @@ type SingleGetStateHandler s e
 
 type SingleFindNextFocusHandler s e
   = WidgetEnv s e
+  -> FocusDirection
   -> Path
   -> WidgetInstance s e
   -> Maybe Path
@@ -156,8 +157,8 @@ mergeWrapper mergeHandler wenv oldInst newInst = result where
   result = mergeHandler wenv oldState tempInst
 
 defaultFindNextFocus :: SingleFindNextFocusHandler s e
-defaultFindNextFocus wenv startFrom widgetInst
-  | isFocusCandidate startFrom widgetInst = Just (_wiPath widgetInst)
+defaultFindNextFocus wenv direction startFrom widgetInst
+  | isFocusCandidate direction startFrom widgetInst = Just (_wiPath widgetInst)
   | otherwise = Nothing
 
 defaultFindByPoint :: SingleFindByPointHandler s e

src/Monomer/Widget/Composite.hs

@@ -173,14 +173,15 @@ compositeFindNextFocus
   :: Composite s e ep
   -> CompositeState s e
   -> WidgetEnv sp ep
+  -> FocusDirection
   -> Path
   -> WidgetInstance sp ep
   -> Maybe Path
-compositeFindNextFocus comp state wenv startFrom widgetComp = nextFocus where
+compositeFindNextFocus comp state wenv dir start widgetComp = nextFocus where
   CompositeState{..} = state
   widget = _wiWidget _cmpRoot
   cwenv = convertWidgetEnv wenv _cmpGlobalKeys _cmpModel
-  nextFocus = widgetFindNextFocus widget cwenv startFrom _cmpRoot
+  nextFocus = widgetFindNextFocus widget cwenv dir start _cmpRoot
 
 -- | Find
 compositeFindByPoint

src/Monomer/Widget/Types.hs

@@ -20,6 +20,11 @@ import Monomer.Graphics.Types
 type Timestamp = Int
 type GlobalKeys s e = Map WidgetKey (WidgetInstance s e)
 
+data FocusDirection
+  = FocusFwd
+  | FocusBwd
+  deriving (Eq, Show)
+
 newtype WidgetType
   = WidgetType { unWidgetType :: String }
   deriving (Eq, Show)
@@ -124,6 +129,7 @@ data Widget s e =
     --
     widgetFindNextFocus
       :: WidgetEnv s e
+      -> FocusDirection
       -> Path
       -> WidgetInstance s e
       -> Maybe Path,

src/Monomer/Widget/Util.hs

@@ -354,13 +354,24 @@ resizeInstance wenv inst = newInst where
   instReqs = widgetUpdateSizeReq (_wiWidget inst) wenv inst
   newInst = widgetResize (_wiWidget instReqs) wenv viewport renderArea instReqs
 
-isFocusCandidate :: Path -> WidgetInstance s e -> Bool
-isFocusCandidate startFrom widgetInst = isValid where
+isFocusCandidate :: FocusDirection -> Path -> WidgetInstance s e -> Bool
+isFocusCandidate FocusFwd = isFocusFwdCandidate
+isFocusCandidate FocusBwd = isFocusBwdCandidate
+
+isFocusFwdCandidate :: Path -> WidgetInstance s e -> Bool
+isFocusFwdCandidate startFrom widgetInst = isValid where
   isBefore = isTargetBeforeCurrent startFrom widgetInst
   isFocusable = _wiFocusable widgetInst
   isEnabled = _wiVisible widgetInst && _wiEnabled widgetInst
   isValid = isBefore && isFocusable && isEnabled
 
+isFocusBwdCandidate :: Path -> WidgetInstance s e -> Bool
+isFocusBwdCandidate startFrom widgetInst = isValid where
+  isAfter = isTargetAfterCurrent startFrom widgetInst
+  isFocusable = _wiFocusable widgetInst
+  isEnabled = _wiVisible widgetInst && _wiEnabled widgetInst
+  isValid = isAfter && isFocusable && isEnabled
+
 isTargetReached :: Path -> WidgetInstance s e -> Bool
 isTargetReached target widgetInst = target == _wiPath widgetInst
 
@@ -381,6 +392,13 @@ isTargetBeforeCurrent target widgetInst = result where
     | lenTarget > lenCurrent = targetPrefix <= currentPath
     | otherwise = target < currentPath
 
+isTargetAfterCurrent :: Path -> WidgetInstance s e -> Bool
+isTargetAfterCurrent target widgetInst
+  | target == rootPath = True
+  | otherwise = target > currentPath
+  where
+    currentPath = _wiPath widgetInst
+
 numberInBounds :: (Ord a, Num a) => Maybe a -> Maybe a -> a -> Bool
 numberInBounds Nothing Nothing _ = True
 numberInBounds (Just minVal) Nothing val = val >= minVal

tasks.md

@@ -178,13 +178,21 @@
   - textField should support textFieldV and validInputV
     - Add mandatory event parameter for V constructors
   - Why does the model update when trying to input a char in FloatingInput?
+  - Focus event not received after clicking and gaining focus
 
 - Pending
-  - Focus event not received after clicking and gaining focus
   - Rethink focus handling. Maybe return a list of all focusable elements? Currently shift-tab is not possible
     - http://hackage.haskell.org/package/data-clist-0.1.2.3
+    - Ver si tiene sentido esta opcion o es mejor volver a dos funciones
+      - Empezar desde atras pero con logica similar a la normal
+
+
+
+
+
   - Think about argument position for widgets, in particular listview/radio
     - Should value come before items/option?
+    - Should we use a list of configs instead of <> operator?
   - Compare Cairo/Skia interfaces to make Renderer able to handle future implementations
   - Can _wiChildren be removed from Widget and only be kept in Container?
   - Rename spacer