justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Work on selection lists and option menus

Browse Source
This commit is contained in:
justin
2022-12-23 22:43:30 +00:00
parent b072dc9e9a
commit 5356d21778
5 changed files with 49 additions and 33 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Update.hs
+6 -16
View File
@@ -115,7 +115,7 @@ mouseOverSelectionList ldps sl u
&& ylower >= 0 && ylower < ymax = u & uvScreenLayers . _head . scSelectionList . slSelPos ?~ yupper
| otherwise = u
where
ymax = maybe 0 length $ u ^? uvScreenLayers . _head . scSelectionList . slItems
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
@@ -128,23 +128,13 @@ mouseOverSelectionList ldps sl u
setSelectionListRestriction' :: Configuration -> ScreenLayer -> ScreenLayer
setSelectionListRestriction' cfig screen = fromMaybe screen $ do
sl <- screen ^? scSelectionList
ldps <- screen ^? scListDisplayParams
return $ screen & scAvailableLines %~ const (setSelectionListRestriction ldps cfig sl)
setSelectionListRestriction :: ListDisplayParams -> Configuration -> SelectionList -> Int
setSelectionListRestriction ldps cfig sl = nlines
where
nlines = floor ((dToBot - vgap) / itmHeight)
vgap = ldps ^. ldpVerticalGap
itmHeight = 10 * ldps ^. ldpScale + vgap
dToBot = cfig ^. windowY - (ldps ^. ldpPosY + dFromScreenBot)
dFromScreenBot = 5 -- fromMaybe 0 $ sl ^? slSizeRestriction . ssrType . ssrFromScreenBottom
return $ screen & scAvailableLines %~ const (getAvailableListLines ldps cfig)
updateUseInput :: Universe -> Universe
updateUseInput u = case u ^? uvScreenLayers . _head of
Just (InputScreen thetext _) -> doInputScreenInput thetext u
Just screen@OptionScreen{_scOptions = mos, _scMaybeOption = mop, _scOptionFlag = flag, _scSelectionList = sellist, _scListDisplayParams = ldps}
Just screen@OptionScreen{_scOptions = mos, _scPositionedMenuOption = mop, _scOptionFlag = flag, _scSelectionList = sellist, _scListDisplayParams = ldps}
-> optionScreenUpdate screen mos mop flag ldps sellist u
-- Just ColumnsScreen{} -> u & uvScreenLayers %~ tail
_ -> case u ^? uvWorld . cWorld . lWorld . hud . hudElement . subInventory of
@@ -153,7 +143,7 @@ updateUseInput u = case u ^? uvScreenLayers . _head of
where
pkeys = u ^. uvWorld . input . pressedKeys
optionScreenUpdate :: ScreenLayer -> [MenuOption] -> Maybe MenuOption -> OptionScreenFlag
optionScreenUpdate :: ScreenLayer -> [MenuOption] -> PositionedMenuOption -> OptionScreenFlag
-> ListDisplayParams
-> SelectionList
-> Universe -> Universe
@@ -168,9 +158,9 @@ optionScreenUpdate screen mos mop _ ldps sl u =
where
cfig = u ^. uvConfig
optionScreenDefEff :: Maybe MenuOption -> Universe -> Universe
optionScreenDefEff :: PositionedMenuOption -> Universe -> Universe
optionScreenDefEff f u = case u ^. uvWorld . input . pressedKeys . at ScancodeEscape of
Just InitialPress -> fromMaybe id (f ^? _Just . moEff) u
Just InitialPress -> fromMaybe id (f ^? pmoMenuOption . moEff) u
_ -> u
updateUniverseLast :: Universe -> Universe