Handle menu selection with mouse context, remove wheel scroll control

src/Dodge/Update/Input/ScreenLayer.hs

@@ -41,10 +41,10 @@ optionScreenUpdate :: Universe -> Universe
 optionScreenUpdate u =
     (uvScreenLayers . ix 0 . scDisplayTime +~ 1)
         . refreshOptionsSelectionList
-        . mouseOverSelectionList
+--        . mouseOverSelectionList
         . optionScreenDefaultEffect
         . mouseClickOptionsList
-        . menuWheelEvents
+--        . menuWheelEvents
         . over (uvScreenLayers . _head) (setSelectionListRestriction (u ^. uvConfig))
         $ u
 
@@ -61,32 +61,32 @@ mouseClickOptionsList u = fromMaybe u $ do
     sl <- u ^? uvScreenLayers . ix 0 . scSelectionList
     Just $ case u ^. uvWorld . input . mouseButtons . at ButtonLeft of
         Just 0 -> fromMaybe u $ do
-            i <- sl ^. slSelPos
+            i <- u ^? uvWorld . input . mouseContext . mcoMenuClick
             f <- sl ^? slItems . ix i . siPayload . _1
             return $ f u
         _ -> case u ^. uvWorld . input . mouseButtons . at ButtonRight of
             Just 0 -> fromMaybe u $ do
-                i <- sl ^. slSelPos
+                i <- u ^? uvWorld . input . mouseContext . mcoMenuClick
                 f <- sl ^? slItems . ix i . siPayload . _2
                 return $ f u
             _ -> u
 
-mouseOverSelectionList :: Universe -> Universe
-mouseOverSelectionList u = fromMaybe u $ do
-    screen <- u ^? uvScreenLayers . ix 0
-    ldps <- screen ^? scListDisplayParams
-    let ymax = maybe 0 length $ screen ^? scSelectionList . slItems
-    yi <- ldpVerticalSelection (u ^. uvConfig) ldps (u ^. uvWorld . input . mousePos)
-    guard $ mmoving || (_scDisplayTime screen <= 1)
-    let myi = do
-            guard (yi >= 0 && yi < ymax && isselectable yi)
-            return yi
-    return $ u & uvScreenLayers . _head . scSelectionList . slSelPos .~ myi
-  where
-    isselectable yi =
-        fromMaybe False $
-            u ^? uvScreenLayers . _head . scSelectionList . slItems . ix yi . siIsSelectable
-    mmoving = u ^. uvWorld . input . mouseMoving
+--mouseOverSelectionList :: Universe -> Universe
+--mouseOverSelectionList u = fromMaybe u $ do
+--    screen <- u ^? uvScreenLayers . ix 0
+--    ldps <- screen ^? scListDisplayParams
+--    let ymax = maybe 0 length $ screen ^? scSelectionList . slItems
+--    yi <- ldpVerticalSelection (u ^. uvConfig) ldps (u ^. uvWorld . input . mousePos)
+--    guard $ mmoving || (_scDisplayTime screen <= 1)
+--    let myi = do
+--            guard (yi >= 0 && yi < ymax && isselectable yi)
+--            return yi
+--    return $ u & uvScreenLayers . _head . scSelectionList . slSelPos .~ myi
+--  where
+--    isselectable yi =
+--        fromMaybe False $
+--            u ^? uvScreenLayers . _head . scSelectionList . slItems . ix yi . siIsSelectable
+--    mmoving = u ^. uvWorld . input . mouseMoving
 
 ldpVerticalSelection :: Configuration -> ListDisplayParams -> Point2 -> Maybe Int
 ldpVerticalSelection cfig ldp (V2 _ y)
@@ -101,23 +101,23 @@ ldpVerticalSelection cfig ldp (V2 _ y)
     yupper = floor $ (top - (y + ygap)) / yoff
     ylower = ceiling ((top - y) / yoff) - 1
 
-menuWheelEvents :: Universe -> Universe
-menuWheelEvents u = foldr ($) u (replicate (abs y) (menuWheelStep (signum y)))
-  where
-    y = u ^. uvWorld . input . scrollAmount
+--menuWheelEvents :: Universe -> Universe
+--menuWheelEvents u = foldr ($) u (replicate (abs y) (menuWheelStep (signum y)))
+--  where
+--    y = u ^. uvWorld . input . scrollAmount
 
--- you probably want i to be 1 or -1
-menuWheelStep :: Int -> Universe -> Universe
-menuWheelStep i u = fromMaybe u $ do
-    sl <- u ^? uvScreenLayers . _head . scSelectionList
-    selpos <- sl ^? slSelPos . _Just
-    ymax <- fmap length (sl ^? slItems)
-    let newpos = (selpos - i) `mod` ymax
-    itm <- sl ^? slItems . ix newpos
-    let newu = u & uvScreenLayers . _head . scSelectionList . slSelPos . _Just %~ const newpos
-    if _siIsSelectable itm
-        then Just newu
-        else Just $ menuWheelStep i newu
+---- you probably want i to be 1 or -1
+--menuWheelStep :: Int -> Universe -> Universe
+--menuWheelStep i u = fromMaybe u $ do
+--    sl <- u ^? uvScreenLayers . _head . scSelectionList
+--    selpos <- sl ^? slSelPos . _Just
+--    ymax <- fmap length (sl ^? slItems)
+--    let newpos = (selpos - i) `mod` ymax
+--    itm <- sl ^? slItems . ix newpos
+--    let newu = u & uvScreenLayers . _head . scSelectionList . slSelPos . _Just %~ const newpos
+--    if _siIsSelectable itm
+--        then Just newu
+--        else Just $ menuWheelStep i newu
 
 setSelectionListRestriction :: Configuration -> ScreenLayer -> ScreenLayer
 setSelectionListRestriction cfig screen = fromMaybe screen $ do