Rename App to Model. Add wctx parameter to find and nextFocusable

app/KeysComposite.hs

@@ -54,17 +54,17 @@ initialState = KeysCompState {
 
 keysComposite = composite "keysComposite" initialState Nothing handleKeysCompEvent buildKeysComp
 
-handleKeysCompEvent app evt = case evt of
-  RotateChildren -> Model (app & items %~ rotateSeq)
+handleKeysCompEvent model evt = case evt of
+  RotateChildren -> Model (model & items %~ rotateSeq)
 
-buildKeysComp app = trace "Created keys composite UI" $
+buildKeysComp model = trace "Created keys composite UI" $
   hgrid [
     button RotateChildren "Rotate",
-    vgrid $ fmap (editableItem app) [0..(length (_items app) - 1)]
+    vgrid $ fmap (editableItem model) [0..(length (_items model) - 1)]
   ]
 
-editableItem app idx = widget where
-  widgetKey = app ^. singular (items . ix idx . itemId)
+editableItem model idx = widget where
+  widgetKey = model ^. singular (items . ix idx . itemId)
   widget = hgrid [
       label $ "Item " <> showt idx,
       textField (singular $ items . ix idx . itemDesc)

src/Monomer/Main/Core.hs

@@ -79,7 +79,7 @@ runWidgets window c widgetRoot = do
   let newWidgetRoot = resizeUI wctx newWindowSize initializedRoot
 
   mainModel .= _wcModel newWctx
-  focused .= findNextFocusable rootPath newWidgetRoot
+  focused .= findNextFocusable newWctx rootPath newWidgetRoot
 
   mainLoop window c renderer widgetPlatform ticks 0 0 newWidgetRoot
 
@@ -91,6 +91,8 @@ mainLoop window c renderer widgetPlatform !prevTicks !tsAccum !frames widgetRoot
   startTicks <- fmap fromIntegral SDL.ticks
   events <- SDL.pollEvents
   mousePos <- getCurrentMousePos
+  currentModel <- use mainModel
+  oldInputStatus <- use inputStatus
 
   let !ts = startTicks - prevTicks
   let eventsPayload = fmap SDL.eventPayload events
@@ -102,24 +104,26 @@ mainLoop window c renderer widgetPlatform !prevTicks !tsAccum !frames widgetRoot
   let newSecond = tsAccum + ts > 1000
   let newTsAccum = if newSecond then 0 else tsAccum + ts
   let newFrameCount = if newSecond then 0 else frames + 1
+  let oldWctx = WidgetContext {
+    _wcPlatform = widgetPlatform,
+    _wcScreenSize = windowSize,
+    _wcGlobalKeys = M.empty,
+    _wcModel = currentModel,
+    _wcInputStatus = oldInputStatus,
+    _wcTimestamp = startTicks
+  }
 
   --when newSecond $
   --  liftIO . putStrLn $ "Frames: " ++ (show frames)
 
   -- Pre process events (change focus, add Enter/Leave events when Move is received, etc)
-  currentModel <- use mainModel
-  systemEvents <- preProcessEvents widgetRoot baseSystemEvents
+  systemEvents <- preProcessEvents oldWctx widgetRoot baseSystemEvents
   inputStatus <- use inputStatus
   isMouseFocusedWidget <- fmap isJust (use latestPressed)
 
   let isLeftPressed = isButtonPressed inputStatus LeftBtn
-  let wctx = WidgetContext {
-    _wcPlatform = widgetPlatform,
-    _wcScreenSize = windowSize,
-    _wcGlobalKeys = M.empty,
-    _wcModel = currentModel,
-    _wcInputStatus = inputStatus,
-    _wcTimestamp = startTicks
+  let wctx = oldWctx {
+    _wcInputStatus = oldInputStatus
   }
 
   when (mouseEntered && isLeftPressed && isMouseFocusedWidget) $
@@ -169,16 +173,16 @@ resizeWindow window wctx widgetRoot = do
 
   return $ resizeUI wctx newWindowSize widgetRoot
 
-preProcessEvents :: (MonomerM s m) => WidgetInstance s e -> [SystemEvent] -> m [SystemEvent]
-preProcessEvents widgets events = do
-  systemEvents <- concatMapM (preProcessEvent widgets) events
+preProcessEvents :: (MonomerM s m) => WidgetContext s e -> WidgetInstance s e -> [SystemEvent] -> m [SystemEvent]
+preProcessEvents wctx widgets events = do
+  systemEvents <- concatMapM (preProcessEvent wctx widgets) events
   mapM_ updateInputStatus systemEvents
   return systemEvents
 
-preProcessEvent :: (MonomerM s m) => WidgetInstance s e -> SystemEvent -> m [SystemEvent]
-preProcessEvent widgetRoot evt@(Move point) = do
+preProcessEvent :: (MonomerM s m) => WidgetContext s e -> WidgetInstance s e -> SystemEvent -> m [SystemEvent]
+preProcessEvent wctx widgetRoot evt@(Move point) = do
   hover <- use latestHover
-  let current = _widgetFind (_instanceWidget widgetRoot) rootPath point widgetRoot
+  let current = _widgetFind (_instanceWidget widgetRoot) wctx rootPath point widgetRoot
   let hoverChanged = isJust hover && current /= hover
   let enter = [Enter point | isNothing hover || hoverChanged]
   let leave = [Leave (fromJust hover) point | hoverChanged]
@@ -187,16 +191,16 @@ preProcessEvent widgetRoot evt@(Move point) = do
     latestHover .= current
 
   return $ leave ++ enter ++ [evt]
-preProcessEvent widgetRoot evt@(ButtonAction point btn PressedBtn) = do
-  let current = _widgetFind (_instanceWidget widgetRoot) rootPath point widgetRoot
+preProcessEvent wctx widgetRoot evt@(ButtonAction point btn PressedBtn) = do
+  let current = _widgetFind (_instanceWidget widgetRoot) wctx rootPath point widgetRoot
 
   latestPressed .= current
   return [evt]
-preProcessEvent widgetRoot evt@(ButtonAction point btn ReleasedBtn) = do
+preProcessEvent wctx widgetRoot evt@(ButtonAction point btn ReleasedBtn) = do
   latestPressed .= Nothing
   return [Click point btn, evt]
 
-preProcessEvent widgetRoot event = return [event]
+preProcessEvent wctx widgetRoot event = return [event]
 
 updateInputStatus :: (MonomerM s m) => SystemEvent -> m ()
 updateInputStatus (Move point) = inputStatus %= \status -> status {

src/Monomer/Main/Handlers.hs

@@ -32,8 +32,8 @@ import Monomer.Widget.Util
 
 type HandlerStep s e = (WidgetContext s e, Seq e, WidgetInstance s e)
 
-createEventContext :: Maybe Path -> Maybe Path -> Path -> Path -> SystemEvent -> WidgetInstance s e -> Maybe PathContext
-createEventContext latestPressed activeOverlay currentFocus currentTarget systemEvent widgetRoot = case systemEvent of
+createEventContext :: WidgetContext s e -> Maybe Path -> Maybe Path -> Path -> Path -> SystemEvent -> WidgetInstance s e -> Maybe PathContext
+createEventContext wctx latestPressed activeOverlay currentFocus currentTarget systemEvent widgetRoot = case systemEvent of
     -- Keyboard
     KeyAction{}            -> pathEvent currentTarget
     TextInput _            -> pathEvent currentTarget
@@ -51,7 +51,7 @@ createEventContext latestPressed activeOverlay currentFocus currentTarget system
   where
     pathEvent = Just . makePathCtx
     findStartPath = fromMaybe rootPath activeOverlay
-    pathFromPoint point = _widgetFind (_instanceWidget widgetRoot) findStartPath point widgetRoot
+    pathFromPoint point = _widgetFind (_instanceWidget widgetRoot) wctx findStartPath point widgetRoot
     pointEvent point = makePathCtx <$> (pathFromPoint point <|> activeOverlay <|> latestPressed)
     makePathCtx targetPath = PathContext currentFocus targetPath rootPath
 
@@ -68,7 +68,7 @@ handleSystemEvent renderer wctx systemEvent currentFocus currentTarget widgetRoo
   latestPressed <- use latestPressed
   activeOverlay <- use activeOverlay
 
-  case createEventContext latestPressed activeOverlay currentFocus currentTarget systemEvent widgetRoot of
+  case createEventContext wctx latestPressed activeOverlay currentFocus currentTarget systemEvent widgetRoot of
     Nothing -> return (wctx, Seq.empty, widgetRoot)
     Just ctx -> do
       let widget = _instanceWidget widgetRoot
@@ -106,13 +106,13 @@ handleFocusChange :: (MonomerM s m) => Renderer m -> PathContext -> SystemEvent
 handleFocusChange renderer ctx systemEvent stopProcessing (model, events, widgetRoot)
   | focusChangeRequested = do
       oldFocus <- use focused
-      (newModel, newEvents1, newRoot1) <- handleSystemEvent renderer model Blur oldFocus oldFocus widgetRoot
+      (newWctx, newEvents1, newRoot1) <- handleSystemEvent renderer model Blur oldFocus oldFocus widgetRoot
 
-      let newFocus = findNextFocusable oldFocus widgetRoot
-      (newModel2, newEvents2, newRoot2) <- handleSystemEvent renderer newModel Focus newFocus newFocus newRoot1
+      let newFocus = findNextFocusable newWctx oldFocus widgetRoot
+      (newWctx2, newEvents2, newRoot2) <- handleSystemEvent renderer newWctx Focus newFocus newFocus newRoot1
       focused .= newFocus
 
-      return (newModel2, events >< newEvents1 >< newEvents2, widgetRoot)
+      return (newWctx2, events >< newEvents1 >< newEvents2, widgetRoot)
   | otherwise = return (model, events, widgetRoot)
   where
     focusChangeRequested = not stopProcessing && isKeyPressed systemEvent keyTab
@@ -136,9 +136,9 @@ handleClipboardGet renderer ctx reqs previousStep = do
     foldM (reducer contents) previousStep reqs
   where
     reducer contents (model, events, widgetRoot) (GetClipboard path) = do
-      (newModel2, newEvents2, newRoot2) <- handleSystemEvent renderer model (Clipboard contents) (_pathCurrent ctx) path widgetRoot
+      (newWctx2, newEvents2, newRoot2) <- handleSystemEvent renderer model (Clipboard contents) (_pathCurrent ctx) path widgetRoot
 
-      return (newModel2, events >< newEvents2, newRoot2)
+      return (newWctx2, events >< newEvents2, newRoot2)
     reducer contents previousStep _ = return previousStep
 
 handleClipboardSet :: (MonomerM s m) => Renderer m -> Seq (WidgetRequest s) -> HandlerStep s e -> m (HandlerStep s e)

src/Monomer/Main/Util.hs

@@ -26,9 +26,9 @@ initMonomerContext model winSize useHiDPI devicePixelRate = MonomerContext {
   _widgetTasks = Seq.empty
 }
 
-findNextFocusable :: Path -> WidgetInstance s e -> Path
-findNextFocusable currentFocus widgetRoot = fromMaybe rootFocus candidateFocus where
+findNextFocusable :: WidgetContext s e -> Path -> WidgetInstance s e -> Path
+findNextFocusable wctx currentFocus widgetRoot = fromMaybe rootFocus candidateFocus where
   ctxFocus = PathContext currentFocus currentFocus rootPath
-  candidateFocus = _widgetNextFocusable (_instanceWidget widgetRoot) ctxFocus widgetRoot
+  candidateFocus = _widgetNextFocusable (_instanceWidget widgetRoot) wctx ctxFocus widgetRoot
   ctxRootFocus = PathContext rootPath rootPath rootPath
-  rootFocus = fromMaybe currentFocus $ _widgetNextFocusable (_instanceWidget widgetRoot) ctxRootFocus widgetRoot
+  rootFocus = fromMaybe currentFocus $ _widgetNextFocusable (_instanceWidget widgetRoot) wctx ctxRootFocus widgetRoot

src/Monomer/Widget/BaseContainer.hs

@@ -121,8 +121,8 @@ mergeChildren wctx oldFull@(oldChild :<| oldChildren) ((ctx, newChild) :<| newCh
   result = child <| mergeChildren wctx oldRest newChildren
 
 -- | Find next focusable item
-containerNextFocusable :: PathContext -> WidgetInstance s e -> Maybe Path
-containerNextFocusable ctx widgetInstance = nextFocus where
+containerNextFocusable :: WidgetContext s e -> PathContext -> WidgetInstance s e -> Maybe Path
+containerNextFocusable wctx ctx widgetInstance = nextFocus where
   children = _instanceChildren widgetInstance
   stepper idx child = (addToCurrent ctx idx, child)
   filterChildren (ctx, child) = isTargetBeforeCurrent ctx && not (isTargetReached ctx)
@@ -133,11 +133,11 @@ containerNextFocusable ctx widgetInstance = nextFocus where
   nextFocus = Seq.lookup 0 focusedPaths
   getFocused (ctx, child) = if _instanceFocusable child
     then Just (currentPath ctx)
-    else _widgetNextFocusable (_instanceWidget child) ctx child
+    else _widgetNextFocusable (_instanceWidget child) wctx ctx child
 
 -- | Find instance matching point
-containerFind :: Path -> Point -> WidgetInstance s e -> Maybe Path
-containerFind path point widgetInstance = fmap (combinePath newPath point children) childIdx where
+containerFind :: WidgetContext s e -> Path -> Point -> WidgetInstance s e -> Maybe Path
+containerFind wctx path point widgetInstance = fmap (combinePath wctx newPath point children) childIdx where
   children = _instanceChildren widgetInstance
   pointInWidget wi = pointInRect point (_instanceViewport wi)
   newPath = Seq.drop 1 path
@@ -145,10 +145,10 @@ containerFind path point widgetInstance = fmap (combinePath newPath point childr
     Empty -> Seq.findIndexL pointInWidget children
     p :<| ps -> if Seq.length children > p then Just p else Nothing
 
-combinePath :: Path -> Point -> Seq (WidgetInstance s e) -> Int -> Path
-combinePath path point children childIdx = childIdx <| childPath where
+combinePath :: WidgetContext s e -> Path -> Point -> Seq (WidgetInstance s e) -> Int -> Path
+combinePath wctx path point children childIdx = childIdx <| childPath where
   child = Seq.index children childIdx
-  childPath = fromMaybe Seq.empty $ _widgetFind (_instanceWidget child) path point child
+  childPath = fromMaybe Seq.empty $ _widgetFind (_instanceWidget child) wctx path point child
 
 -- | Event Handling
 defaultHandleEvent :: ContainerEventHandler s e

src/Monomer/Widget/BaseWidget.hs

@@ -48,11 +48,11 @@ widgetMerge mergeHandler wctx ctx oldInstance newInstance = result where
   oldState = _widgetGetState (_instanceWidget oldInstance) wctx
   result = mergeHandler wctx ctx oldState newInstance
 
-defaultNextFocusable :: PathContext -> WidgetInstance s e -> Maybe Path
-defaultNextFocusable ctx widgetInstance = Nothing
+defaultNextFocusable :: WidgetContext s e -> PathContext -> WidgetInstance s e -> Maybe Path
+defaultNextFocusable wctx ctx widgetInstance = Nothing
 
-defaultFind :: Path -> Point -> WidgetInstance s e -> Maybe Path
-defaultFind path point widgetInstance = Nothing
+defaultFind :: WidgetContext s e -> Path -> Point -> WidgetInstance s e -> Maybe Path
+defaultFind wctx path point widgetInstance = Nothing
 
 defaultHandleEvent :: WidgetContext s e -> PathContext -> SystemEvent -> WidgetInstance s e -> Maybe (WidgetResult s e)
 defaultHandleEvent wctx ctx evt widgetInstance = Nothing

src/Monomer/Widget/CompositeWidget.hs

@@ -127,18 +127,22 @@ compositeMerge comp state wctx ctx oldComposite newComposite = result where
                   else _widgetInit newWidget cwctx cctx newRoot
   result = processWidgetResult comp newState wctx ctx newComposite widgetResult
 
-compositeNextFocusable :: CompositeState s e -> PathContext -> WidgetInstance sp ep -> Maybe Path
-compositeNextFocusable CompositeState{..} ctx widgetComposite =
-  _widgetNextFocusable (_instanceWidget _compositeRoot) (childContext ctx) _compositeRoot
+compositeNextFocusable :: CompositeState s e -> WidgetContext sp ep -> PathContext -> WidgetInstance sp ep -> Maybe Path
+compositeNextFocusable CompositeState{..} wctx ctx widgetComposite = _widgetNextFocusable widget cwctx cctx _compositeRoot where
+  widget = _instanceWidget _compositeRoot
+  cwctx = convertWidgetContext wctx _compositeGlobalKeys _compositeModel
+  cctx = childContext ctx
 
-compositeFind :: CompositeState s e -> Path -> Point -> WidgetInstance sp ep -> Maybe Path
-compositeFind CompositeState{..} path point widgetComposite
+compositeFind :: CompositeState s e -> WidgetContext sp ep -> Path -> Point -> WidgetInstance sp ep -> Maybe Path
+compositeFind CompositeState{..} wctx path point widgetComposite
   | validStep = fmap (0 <|) childPath
   | otherwise = Nothing
   where
+    widget = _instanceWidget _compositeRoot
+    cwctx = convertWidgetContext wctx _compositeGlobalKeys _compositeModel
     validStep = Seq.null path || Seq.index path 0 == 0
     newPath = Seq.drop 1 path
-    childPath = _widgetFind (_instanceWidget _compositeRoot) newPath point _compositeRoot
+    childPath = _widgetFind widget cwctx newPath point _compositeRoot
 
 compositeHandleEvent :: (Eq s, Typeable s, Typeable e) => Composite s e ep -> CompositeState s e -> WidgetContext sp ep -> PathContext -> SystemEvent -> WidgetInstance sp ep -> Maybe (WidgetResult sp ep)
 compositeHandleEvent comp state wctx ctx evt widgetComposite = fmap processEvent result where

src/Monomer/Widget/PathContext.hs

@@ -13,7 +13,6 @@ import Monomer.Common.Tree (Path, PathStep)
 
 data PathContext = PathContext {
   _pathFocused :: Path,
---  _pathStart :: Path,
   _pathTarget :: Path,
   _pathCurrent :: Path
 } deriving (Show, Eq)

src/Monomer/Widget/Types.hs

@@ -98,9 +98,9 @@ data Widget s e =
     _widgetMerge :: WidgetContext s e -> PathContext -> WidgetInstance s e -> WidgetInstance s e -> WidgetResult s e,
     -- | Returns the list of focusable paths, if any
     --
-    _widgetNextFocusable :: PathContext -> WidgetInstance s e -> Maybe Path,
+    _widgetNextFocusable :: WidgetContext s e -> PathContext -> WidgetInstance s e -> Maybe Path,
     -- | Returns the path of the child item with the given coordinates, starting on the given path
-    _widgetFind :: Path -> Point -> WidgetInstance s e -> Maybe Path,
+    _widgetFind :: WidgetContext s e -> Path -> Point -> WidgetInstance s e -> Maybe Path,
     -- | Handles an event
     --
     -- Current user state

tasks.md

@@ -123,6 +123,7 @@
   - Try to unify path handling on widgetFind and widgetNextFocusable
     - This is also needed for _widgetPreferredSize and _widgetResize
     - Generalize the "startFrom" concept of _widgetFind (and also validate it's actually well/fully implemented)
+  - Make sure enabled/visible attributes are being used
   - Add testing
     - Delayed until this point to try to settle down interfaces
     - Validate stack assigns space correctly