diff --git a/src/Monomer/Core/WidgetTypes.hs b/src/Monomer/Core/WidgetTypes.hs index dab65dc5..e43055d6 100644 --- a/src/Monomer/Core/WidgetTypes.hs +++ b/src/Monomer/Core/WidgetTypes.hs @@ -174,7 +174,7 @@ data WidgetEnv s e = WidgetEnv { _weOverlayPath :: Maybe Path, _weDragStatus :: Maybe (Path, WidgetDragMsg), _weMainBtnPress :: Maybe (Path, Point), - _weCursor :: Maybe (CursorIcon, Path), + _weCursor :: Maybe (Path, CursorIcon), _weModel :: s, _weInputStatus :: InputStatus, _weTimestamp :: Timestamp, diff --git a/src/Monomer/Main/Handlers.hs b/src/Monomer/Main/Handlers.hs index 8e337976..f2eae83e 100644 --- a/src/Monomer/Main/Handlers.hs +++ b/src/Monomer/Main/Handlers.hs @@ -394,7 +394,7 @@ handleSetCursorIcon -> m (HandlerStep s e) handleSetCursorIcon wid icon previousStep = do cursors <- use L.cursorStack >>= dropNonParentWidgetId wid - L.cursorStack .= (icon, wid) : cursors + L.cursorStack .= (wid, icon) : cursors cursor <- (Map.! icon) <$> use L.cursorIcons SDLE.setCursor cursor @@ -407,10 +407,10 @@ handleResetCursorIcon -> m (HandlerStep s e) handleResetCursorIcon wid previousStep = do cursors <- use L.cursorStack >>= dropNonParentWidgetId wid - let newCursors = dropWhile ((==wid) . snd) cursors + let newCursors = dropWhile ((==wid) . fst) cursors let newCursorIcon | null newCursors = CursorArrow - | otherwise = fst . head $ newCursors + | otherwise = snd . head $ newCursors L.cursorStack .= newCursors cursor <- (Map.! newCursorIcon) <$> use L.cursorIcons SDLE.setCursor cursor @@ -751,8 +751,8 @@ cursorToSDL CursorDiagTR = SDLEnum.SDL_SYSTEM_CURSOR_SIZENESW dropNonParentWidgetId :: (MonomerM s m) => WidgetId - -> [(CursorIcon, WidgetId)] - -> m [(CursorIcon, WidgetId)] + -> [(WidgetId, a)] + -> m [(WidgetId, a)] dropNonParentWidgetId wid [] = return [] dropNonParentWidgetId wid (x:xs) = do path <- getWidgetIdPath wid @@ -761,7 +761,7 @@ dropNonParentWidgetId wid (x:xs) = do then return (x:xs) else dropNonParentWidgetId wid xs where - (cursor, cwid) = x + (cwid, _) = x isParentPath parent child = seqStartsWith parent child && parent /= child resetCursorIfOut diff --git a/src/Monomer/Main/Types.hs b/src/Monomer/Main/Types.hs index b4eda8be..ddbb729f 100644 --- a/src/Monomer/Main/Types.hs +++ b/src/Monomer/Main/Types.hs @@ -58,7 +58,7 @@ data MonomerCtx s = MonomerCtx { _mcHdpi :: Bool, _mcDpr :: Double, _mcInputStatus :: InputStatus, - _mcCursorStack :: [(CursorIcon, WidgetId)], + _mcCursorStack :: [(WidgetId, CursorIcon)], _mcFocusedPath :: Path, _mcHoveredPath :: Maybe Path, _mcOverlayWidgetId :: Maybe WidgetId, @@ -77,7 +77,7 @@ data MonomerCtx s = MonomerCtx { } data MonomerCtxPersist = MonomerCtxPersist { - _mcpCursorStack :: [(CursorIcon, WidgetId)], + _mcpCursorStack :: [(WidgetId, CursorIcon)], _mcpFocusedPath :: Path, _mcpHoveredPath :: Maybe Path, _mcpOverlayWidgetId :: Maybe WidgetId, diff --git a/src/Monomer/Main/Util.hs b/src/Monomer/Main/Util.hs index e924da71..a349dc66 100644 --- a/src/Monomer/Main/Util.hs +++ b/src/Monomer/Main/Util.hs @@ -82,11 +82,11 @@ getDraggedMsgInfo = do Just (DragAction wid msg) -> Just . (, msg) <$> getWidgetIdPath wid Nothing -> return Nothing -getCurrentCursor :: (MonomerM s m) => m (Maybe (CursorIcon, Path)) +getCurrentCursor :: (MonomerM s m) => m (Maybe (Path, CursorIcon)) getCurrentCursor = do cursorHead <- fmap headMay (use L.cursorStack) case cursorHead of - Just (icon, wid) -> do + Just (wid, icon) -> do path <- getWidgetIdPath wid - return $ Just (icon, path) + return $ Just (path, icon) otherwhise -> return Nothing diff --git a/src/Monomer/Widgets/Util/Style.hs b/src/Monomer/Widgets/Util/Style.hs index e231e21e..8ed597ae 100644 --- a/src/Monomer/Widgets/Util/Style.hs +++ b/src/Monomer/Widgets/Util/Style.hs @@ -164,7 +164,7 @@ handleCursorChange wenv target evt style cfg node = reqs where widgetId = node ^. L.info . L.widgetId isTarget = node ^. L.info . L.path == target hasCursor = isJust (style ^. L.cursorIcon) - (curIcon, _) = fromMaybe def (wenv ^. L.cursor) + (_, curIcon) = fromMaybe def (wenv ^. L.cursor) inOverlay = isNodeInOverlay wenv node outsideActiveOverlay = isJust (wenv ^. L.overlayPath) && not inOverlay newIcon