More work on menus

This commit is contained in:
2022-12-24 11:15:00 +00:00
parent a97c5ec8ef
commit acb085e3b4
3 changed files with 30 additions and 18 deletions
-1
View File
@@ -62,7 +62,6 @@ data ScreenLayer
, _scOptionFlag :: OptionScreenFlag
, _scSelectionList :: SelectionList (Universe -> Universe)
, _scAvailableLines :: Int
-- , _scShownItems :: [(SelectionItem,SelectionItemIndex)]
, _scListDisplayParams :: ListDisplayParams
}
| ColumnsScreen
+27 -16
View File
@@ -28,46 +28,57 @@ initializeOptionMenu title ops defstr eff u =
{ _scTitle = title
, _scOptions = ops
, _scOffset = 0
, _scPositionedMenuOption = case defstr of
Nothing -> NoPositionedMenuOption
Just str -> BottomMenuOption $ (Toggle eff . const . MODString) str
, _scPositionedMenuOption = pmo
, _scOptionFlag = NormalOptions
, _scSelectionList = makeOptionsSelectionList 10 (Just 0) u ops
, _scSelectionList = makeOptionsSelectionList 10 (Just 0) u ops pmo
, _scAvailableLines = getAvailableListLines optionListDisplayParams (u ^. uvConfig)
, _scListDisplayParams = optionListDisplayParams
}
where
pmo = case defstr of
Nothing -> NoPositionedMenuOption
Just str -> BottomMenuOption $ (Toggle eff . const . MODString) str
refreshOptionsSelectionList :: Universe -> Universe
refreshOptionsSelectionList u = u & uvScreenLayers . ix 0 %~ f
where
f sl = case sl of
OptionScreen {_scOptions = mops
, _scPositionedMenuOption = pmo
, _scAvailableLines = maxlines}
-> sl & scSelectionList . slItems .~ optionsToSelections maxlines u mops
-> sl & scSelectionList . slItems .~ optionsToSelections maxlines u mops pmo
_ -> sl
makeOptionsSelectionList :: Int -> Maybe Int -> Universe -> [MenuOption] -> SelectionList (Universe -> Universe)
makeOptionsSelectionList maxlines mselpos u mos = SelectionList
{ _slItems = optionsToSelections maxlines u mos
makeOptionsSelectionList :: Int -> Maybe Int -> Universe -> [MenuOption] -> PositionedMenuOption
-> SelectionList (Universe -> Universe)
makeOptionsSelectionList maxlines mselpos u mos pmo = SelectionList
{ _slItems = optionsToSelections maxlines u mos pmo
, _slSelPos = mselpos
, _slLength = length $ optionsToSelections maxlines u mos
, _slLength = length $ optionsToSelections maxlines u mos pmo
}
optionsToSelections :: Int -> Universe -> [MenuOption] -> [SelectionItem (Universe -> Universe)]
optionsToSelections maxlines u allops = sits
optionsToSelections :: Int -> Universe -> [MenuOption] -> PositionedMenuOption -> [SelectionItem (Universe -> Universe)]
optionsToSelections maxlines u allops pmo = sits
where
offset = u ^?! uvScreenLayers . _head . scOffset
ops | maxlines >= length allops = allops
| otherwise = take (maxlines - 1) allops ++ [cycleOptionsOption]
| otherwise = take (maxlines - 2) (drop offset allops) ++ [cycleOptionsOption]
maxOptionLength = 3 + maximum (0 : map (optionValueOffset u) ops)
colstrs = map (menuOptionToString u maxOptionLength) ops
sits = map (menuOptionToSelectionItem u maxOptionLength) ops
sits = case pmo of
NoPositionedMenuOption -> map (menuOptionToSelectionItem u maxOptionLength) ops
TopMenuOption mo -> map (menuOptionToSelectionItem u maxOptionLength) (mo : ops)
BottomMenuOption mo -> map (menuOptionToSelectionItem u maxOptionLength) (ops ++ [mo])
cycleOptionsOption = Toggle cycleOptions (const (MODString "MORE OPTIONS"))
cycleOptions :: Universe -> Universe
cycleOptions u = fromMaybe u $ do
screen <- u ^? uvScreenLayers . ix 0
screen <- u ^? uvScreenLayers . _head
maxlines <- screen ^? scAvailableLines
return u
numoptions <- fmap length $ screen ^? scOptions
return $ u & uvScreenLayers . _head . scOffset %~ f numoptions (maxlines - 2)
where
f n l curoff | l + curoff >= n = 0
| otherwise = l + curoff
colStrToSelItem :: (Color,String) -> SelectionItem (Universe -> Universe)
colStrToSelItem (col,str) = SelectionItem
+3 -1
View File
@@ -7,6 +7,7 @@ Description : Simulation update
module Dodge.Update (updateUniverse) where
--import Dodge.Menu.Option
import Dodge.Menu.Option
import Dodge.SelectionList
import Dodge.Data.SelectionList
import Dodge.InputFocus
@@ -141,7 +142,8 @@ optionScreenUpdate :: ScreenLayer -> [MenuOption] -> PositionedMenuOption -> Opt
-> SelectionList (Universe -> Universe)
-> Universe -> Universe
optionScreenUpdate screen mos mop _ ldps sl u =
optionScreenDefEff mop
refreshOptionsSelectionList
. optionScreenDefEff mop
. mouseClickOptionsList mos screen
. mouseOverSelectionList ldps sl
. menuWheelEvents