Fix mouse selection in menus

This commit is contained in:
2023-05-10 12:37:36 +01:00
parent cc42a5e124
commit 69fbf5926a
5 changed files with 16 additions and 24 deletions
+11 -6
View File
@@ -3,6 +3,7 @@ module Dodge.ListDisplayParams
, secondColumnParams
, subInvX
, defaultListDisplayParams
, optionListDisplayParams
) where
import Dodge.Data.ScreenPos
@@ -51,12 +52,6 @@ subInvX = 9 * fromIntegral topInvW + 50
topInvW :: Int
topInvW = 15
--thirdColumnParams :: ListDisplayParams
--thirdColumnParams =
-- defaultListDisplayParams
-- & ldpPosX .~ 9 * fromIntegral topInvW + 275
-- & ldpPosY .~ 60
determineInvSelCursorWidth :: World -> Int
determineInvSelCursorWidth w = case _rbOptions w of
NoRightButtonOptions -> topInvW
@@ -69,3 +64,13 @@ determineInvSelCursorWidth w = case _rbOptions w of
hasnosubinv = case w ^? hud . hudElement . subInventory of
Just NoSubInventory -> True
_ -> False
optionListDisplayParams :: ListDisplayParams
optionListDisplayParams =
defaultListDisplayParams
& ldpPos . spPixelOff .~ V2 11 (-70)
& ldpScale .~ 2
& ldpVerticalGap .~ 0
& ldpWidth .~ FixedSelectionWidth 25
& ldpCursorSides .~ [North, South, West]
+1 -1
View File
@@ -1,7 +1,7 @@
module Dodge.Menu.Loading where
import Dodge.ListDisplayParams
import Dodge.Default.SelectionList
import Dodge.Menu.Option
import Dodge.Data.Universe
loadingScreen :: String -> ScreenLayer
-12
View File
@@ -1,10 +1,8 @@
module Dodge.Menu.Option where
import Dodge.ListDisplayParams
import Dodge.Data.ScreenPos
import Control.Applicative
import Data.Maybe
import Dodge.Data.CardinalPoint
import Dodge.Data.SelectionList
import Dodge.Data.Universe
import Dodge.Default.SelectionList
@@ -12,16 +10,6 @@ import Dodge.SelectionList
import LensHelp
import Padding
import Picture.Base
import Linear
optionListDisplayParams :: ListDisplayParams
optionListDisplayParams =
defaultListDisplayParams
& ldpPos . spPixelOff .~ V2 50 (-50)
& ldpScale .~ 2
& ldpVerticalGap .~ 0
& ldpWidth .~ FixedSelectionWidth 25
& ldpCursorSides .~ [North, South, West]
initializeOptionMenu :: String -> [MenuOption] -> PositionedMenuOption -> Universe -> ScreenLayer
initializeOptionMenu title ops pmo u =
+3 -4
View File
@@ -1,7 +1,6 @@
module Dodge.ScreenPos where
import Control.Lens
import Dodge.Base.Window
import Dodge.Data.Config
import Dodge.Data.ScreenPos
import Geometry.Data
@@ -13,9 +12,9 @@ fromTopLeft (V2 x y) = ScreenPos (V2 (-0.5) 0.5) (V2 x (- y))
translateScreenPos :: Configuration -> ScreenPos -> Picture -> Picture
translateScreenPos cfig sp = translate x y
where
V2 x y = sp ^. spScreenOff * V2 hw hh + sp ^. spPixelOff
hw = halfWidth cfig
hh = halfHeight cfig
V2 x y = sp ^. spScreenOff * V2 w h + sp ^. spPixelOff
w = fromIntegral $ cfig ^. windowX
h = fromIntegral $ cfig ^. windowY
screenPosAbs :: Configuration -> ScreenPos -> Point2
screenPosAbs = undefined
+1 -1
View File
@@ -104,7 +104,7 @@ mouseOverSelectionList ldps screen u = fromMaybe u $ do
-- 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
V2 _ y = u ^. uvWorld . input . mousePos
cfig = u ^. uvConfig
hh = halfHeight cfig
hw = halfWidth cfig