Work on mouse selection in options menu

src/Dodge/Update/Input/ScreenLayer.hs

@@ -2,6 +2,9 @@ module Dodge.Update.Input.ScreenLayer (
     updateUseInputOnScreen,
 ) where
 
+import Linear
+import Dodge.Data.ScreenPos
+import Control.Monad
 import qualified Data.Map.Strict as M
 import Data.Maybe
 import Dodge.Base.Window
@@ -76,31 +79,48 @@ mouseOverSelectionList ::
     ScreenLayer ->
     Universe ->
     Universe
-mouseOverSelectionList ldps screen u
-    | x > xl && x < xr
-        && ylower == yupper
-        && (mmoving || (_scDisplayTime screen <= 1)) -- slight hack
-        && ylower >= 0
-        && ylower < ymax
-        && isselectable =
-        u & uvScreenLayers . _head . scSelectionList . slSelPos ?~ yupper
-    | otherwise = u
+mouseOverSelectionList ldps screen u = fromMaybe u $ do
+    yi <- ldpVerticalSelection (u ^. uvConfig) ldps (u ^. uvWorld . input . mousePos)
+    guard $ (mmoving || (_scDisplayTime screen <= 1))
+        && isselectable yi
+        && yi >= 0
+        && yi < ymax
+--      && x > xl && x < xr
+    return $ u & uvScreenLayers . _head . scSelectionList . slSelPos ?~ yi
+--    | x > xl && x < xr
+--        && ylower == yupper
+--        && (mmoving || (_scDisplayTime screen <= 1)) -- slight hack
+--        && isselectable =
+--        u & uvScreenLayers . _head . scSelectionList . slSelPos ?~ yupper
+--    | otherwise = u
   where
     sl = _scSelectionList screen
-    isselectable =
+    isselectable yi =
         fromMaybe False $
-            u ^? uvScreenLayers . _head . scSelectionList . slItems . ix yupper . siIsSelectable
+            u ^? uvScreenLayers . _head . scSelectionList . slItems . ix yi . siIsSelectable
     ymax = maybe 0 length $ sl ^? slItems
     mmoving = u ^. uvWorld . input . mouseMoving
-    ylower = ceiling $ (hh - (75 + y + _ldpPosY ldps)) / 50
-    yupper = floor $ (hh - (15 + y + _ldpPosY ldps)) / 50
-    xl = _ldpPosX ldps - hw
-    xr = xl + _ldpScale ldps * 26 * 9
+--    ylower = ceiling $ (hh - (75 + y + _ldpPosY ldps)) / 50
+--    yupper = floor $ (hh - (15 + y + _ldpPosY ldps)) / 50
+--    xl = _ldpPosX ldps - hw
+--    xr = xl + _ldpScale ldps * 26 * 9
     V2 x y = u ^. uvWorld . input . mousePos
     cfig = u ^. uvConfig
     hh = halfHeight cfig
     hw = halfWidth cfig
 
+ldpVerticalSelection :: Configuration -> ListDisplayParams -> Point2 -> Maybe Int
+ldpVerticalSelection cfig ldp (V2 _ y) | yupper == ylower = Just yupper
+    | otherwise = Nothing
+  where
+    winy = cfig ^. windowY
+    ygap = ldp ^. ldpVerticalGap
+    yoff = ygap + 20 * ldp ^. ldpScale
+    top :: Float
+    top = fromIntegral winy * (ldp ^. ldpPos . spScreenOff . _y) + ldp ^. ldpPos . spPixelOff . _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