Move towards moving menu selection list position to mouse context

This commit is contained in:
2024-11-17 12:18:34 +00:00
parent e7ea5d7fa9
commit 53d8ca2861
6 changed files with 228 additions and 195 deletions
+18 -5
View File
@@ -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