Move towards moving menu selection list position to mouse context

src/Dodge/Data/Input.hs

@@ -20,7 +20,8 @@ data MouseContext
     = NoMouseContext
     | MouseAiming
     | MouseInGame
-    | MouseMenuClick
+    | MouseMenuClick {_mcoMenuClick :: Int}
+    | MouseMenuCursor
     | OverInvSelect { _mcoInvSelect :: (Int,Int)}
     | OverInvFilt { _mcoInvFilt :: (Int,Int)}
     | OverCombSelect { _mcoCombSelect :: (Int,Int)}

src/Dodge/Render/Picture.hs

@@ -80,7 +80,8 @@ mouseCursorType :: Universe -> Picture
 mouseCursorType u = case u ^. uvWorld . input . mouseContext of
     NoMouseContext -> drawEmptySet 5
     MouseAiming -> rotate a (drawPlus 5)
-    MouseMenuClick -> drawMenuClick 5
+    MouseMenuClick {} -> drawMenuClick 5
+    MouseMenuCursor -> drawMenuCursor 5
     MouseInGame -> drawPlus 5
     OverInvSelect {} -> drawSelect 5
     OverInvFilt {} -> drawCombFilter 5
@@ -119,13 +120,30 @@ drawPlus :: Float -> Picture
 drawPlus x = fold [line [V2 (- x) 0, V2 x 0], line [V2 0 (- x), V2 0 x]]
 
 drawMenuClick :: Float -> Picture
-drawMenuClick x = line 
-    [ V2 0 0
-    , V2 x (-x)
-    , V2 0 (-x)
-    , V2 0 0
+drawMenuClick z = fold
+    [ line [V2 y 0, V2 x 0]
+    , line [V2 ny 0, V2 nx 0]
+    , line [V2 0 ny , V2 0 nx]
+    , line [V2 0 y , V2 0 x]
     ]
+  where
+    x = 0.5 * z
+    y = x + z
+    ny = - y
+    nx = - x
 
+drawMenuCursor :: Float -> Picture
+drawMenuCursor z = fold
+    [ line [V2 y 0, V2 x 0]
+    , line [V2 ny 0, V2 nx 0]
+    , line [V2 0 ny , V2 0 nx]
+    , line [V2 0 y , V2 0 x]
+    ]
+  where
+    x = z
+    y = x + z
+    ny = - y
+    nx = - x
 drawCombFilterJump :: Float -> Picture
 drawCombFilterJump x = rotate (0.25*pi) 
     $ fold [line [V2 0 0, V2 x 0], line [V2 0 0, V2 0 x]]

src/Dodge/Update.hs

@@ -6,6 +6,7 @@ Description : Simulation update
 -}
 module Dodge.Update (updateUniverse) where
 
+import Dodge.Update.Input.ScreenLayer
 import Color
 import Control.Applicative
 import Control.Monad
@@ -53,7 +54,6 @@ import Dodge.TractorBeam.Update
 import Dodge.Update.Camera
 import Dodge.Update.Cloud
 import Dodge.Update.Input.InGame
-import Dodge.Update.Input.ScreenLayer
 import Dodge.Update.Scroll
 import Dodge.Update.WallDamage
 import Dodge.WallCreatureCollisions
@@ -286,7 +286,6 @@ functionalUpdate u =
         . over uvWorld updateCloseObjects
         . over uvWorld updateWheelEvents
         . over uvWorld (updateMouseInventorySelection (u ^. uvConfig))
---        . updateMouseContext (u ^. uvConfig)
         . over uvWorld zoneClouds
         . over uvWorld zoneCreatures
         -- . over uvWorld updateInventorySelectionList
@@ -397,12 +396,26 @@ updateMouseContext cfig u =
             (overmenu <|> overinv <|> overcomb <|> overterm)
   where
     overmenu = do
-        screenlayer <- u ^? uvScreenLayers . ix 0
-        return MouseMenuClick
+        screen <- u ^? uvScreenLayers . ix 0
+        return $ case screen ^. scOptions of
+            [] -> NoMouseContext
+            _ -> fromMaybe MouseMenuCursor $ do 
+                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)
+                guard (yi >= 0 && yi < ymax)
+                return $ if isselectable yi
+                    then MouseMenuClick yi
+                    else NoMouseContext
+    isselectable yi =
+        fromMaybe False $
+            u ^? uvScreenLayers . _head . scSelectionList . slItems . ix yi . siIsSelectable
+--    mmoving = u ^. uvWorld . input . mouseMoving
     w = u ^. uvWorld
     aimcontext
         | ButtonRight `M.member` (w ^. input . mouseButtons) = MouseAiming
-        | otherwise = NoMouseContext
+        | otherwise = MouseInGame
     mpos = w ^. input . mousePos
     overinv = do
         sss <- w ^? hud . hudElement . diSections

src/Dodge/Update/Input/ScreenLayer.hs

@@ -1,5 +1,6 @@
 module Dodge.Update.Input.ScreenLayer (
     updateUseInputOnScreen,
+    ldpVerticalSelection,
 ) where
 
 import Data.Char