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

Push more data out of selection list into menu screen

Browse Source
This commit is contained in:
justin
2022-12-22 11:12:41 +00:00
parent a8fa1e9949
commit 6ac4e5d669
5 changed files with 33 additions and 32 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Update.hs
+20 -14
View File
@@ -6,7 +6,6 @@ Description : Simulation update
-}
module Dodge.Update (updateUniverse) where
--import Dodge.Menu.Option
import Dodge.Menu.Option
import Dodge.SelectionList
import Dodge.Data.SelectionList
@@ -93,15 +92,17 @@ gotoTerminal w = case _uvScreenLayers w of
(InputScreen{} : _) -> w
_ -> w & uvScreenLayers .:~ InputScreen T.empty "Enter command"
mouseClickOptionsList :: [MenuOption] -> SelectionList -> Universe -> Universe
mouseClickOptionsList mos sl u = case u ^. uvWorld . input . mouseButtons . at ButtonLeft of
mouseClickOptionsList :: [MenuOption] -> ScreenLayer -> Universe -> Universe
mouseClickOptionsList mos screen u = fromMaybe u $ do
sl <- screen ^? scSelectionList
Just $ case u ^. uvWorld . input . mouseButtons . at ButtonLeft of
Just False -> fromMaybe u $ do
i <- sl ^. slSelPos
si <- sl ^? slShownItems . ix i . _2
return $ maybe u ($ u) $ case si of
ListedSelectionItem j -> fmap (refreshOptionsSelectionList .) (mos ^? ix j . moEff)
ScrollSelectionItem -> do
maxlines <- sl ^? slSizeRestriction . maxSelectionLines
maxlines <- screen ^? scAvailableLines
alllines <- sl ^? slLength
Just $ uvScreenLayers . _head . scOffset %~
(\x -> if x + maxlines - 2 >= alllines then 0 else x + maxlines - 2)
@@ -125,20 +126,25 @@ mouseOverSelectionList sl u
hh = halfHeight cfig
hw = halfWidth cfig
setSelectionListRestriction :: Configuration -> SelectionList -> SelectionList
setSelectionListRestriction cfig sl = sl & slSizeRestriction . maxSelectionLines %~ const nlines
setSelectionListRestriction' :: Configuration -> ScreenLayer -> ScreenLayer
setSelectionListRestriction' cfig screen = fromMaybe screen $ do
sl <- screen ^? scSelectionList
return $ screen & scAvailableLines %~ const (setSelectionListRestriction cfig sl)
setSelectionListRestriction :: Configuration -> SelectionList -> Int
setSelectionListRestriction cfig sl = nlines
where
nlines = floor ((dToBot - vgap) / itmHeight)
vgap = sl ^. slVerticalGap
itmHeight = 10 * sl ^. slScale + vgap
dToBot = cfig ^. windowY - (sl ^. slPosY + dFromScreenBot)
dFromScreenBot = fromMaybe 0 $ sl ^? slSizeRestriction . ssrType . ssrFromScreenBottom
dFromScreenBot = 5 -- fromMaybe 0 $ sl ^? slSizeRestriction . ssrType . ssrFromScreenBottom
updateUseInput :: Universe -> Universe
updateUseInput u = case u ^? uvScreenLayers . _head of
Just (InputScreen thetext _) -> doInputScreenInput thetext u
Just OptionScreen{_scOptions = mos, _scMaybeOption = mop, _scOptionFlag = flag, _scSelectionList = sellist}
-> optionScreenUpdate mos mop flag sellist u
Just screen@OptionScreen{_scOptions = mos, _scMaybeOption = mop, _scOptionFlag = flag, _scSelectionList = sellist}
-> optionScreenUpdate screen mos mop flag sellist u
-- Just ColumnsScreen{} -> u & uvScreenLayers %~ tail
_ -> case u ^? uvWorld . cWorld . lWorld . hud . hudElement . subInventory of
Just (DisplayTerminal tmid) | inTermFocus (_uvWorld u) -> updateKeysInTerminal tmid u
@@ -146,16 +152,16 @@ updateUseInput u = case u ^? uvScreenLayers . _head of
where
pkeys = u ^. uvWorld . input . pressedKeys
optionScreenUpdate :: [MenuOption] -> Maybe MenuOption -> OptionScreenFlag
optionScreenUpdate :: ScreenLayer -> [MenuOption] -> Maybe MenuOption -> OptionScreenFlag
-> SelectionList
-> Universe -> Universe
optionScreenUpdate mos mop _ sl u =
optionScreenUpdate screen mos mop _ sl u =
optionScreenDefEff mop
. mouseClickOptionsList mos sl
. mouseClickOptionsList mos screen
. mouseOverSelectionList sl
. menuWheelEvents
. over (uvScreenLayers . _head . scSelectionList) (setSelectionListRestriction cfig)
$ over (uvScreenLayers . _head) setShownSelectionItems
. over (uvScreenLayers . _head) (setSelectionListRestriction' cfig)
$ over (uvScreenLayers . _head) (setShownSelectionItems cfig)
u
where
cfig = u ^. uvConfig