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 , _scOptionFlag :: OptionScreenFlag
, _scSelectionList :: SelectionList (Universe -> Universe) , _scSelectionList :: SelectionList (Universe -> Universe)
, _scAvailableLines :: Int , _scAvailableLines :: Int
-- , _scShownItems :: [(SelectionItem,SelectionItemIndex)]
, _scListDisplayParams :: ListDisplayParams , _scListDisplayParams :: ListDisplayParams
} }
| ColumnsScreen | ColumnsScreen
+27 -16
View File
@@ -28,46 +28,57 @@ initializeOptionMenu title ops defstr eff u =
{ _scTitle = title { _scTitle = title
, _scOptions = ops , _scOptions = ops
, _scOffset = 0 , _scOffset = 0
, _scPositionedMenuOption = case defstr of , _scPositionedMenuOption = pmo
Nothing -> NoPositionedMenuOption
Just str -> BottomMenuOption $ (Toggle eff . const . MODString) str
, _scOptionFlag = NormalOptions , _scOptionFlag = NormalOptions
, _scSelectionList = makeOptionsSelectionList 10 (Just 0) u ops , _scSelectionList = makeOptionsSelectionList 10 (Just 0) u ops pmo
, _scAvailableLines = getAvailableListLines optionListDisplayParams (u ^. uvConfig) , _scAvailableLines = getAvailableListLines optionListDisplayParams (u ^. uvConfig)
, _scListDisplayParams = optionListDisplayParams , _scListDisplayParams = optionListDisplayParams
} }
where
pmo = case defstr of
Nothing -> NoPositionedMenuOption
Just str -> BottomMenuOption $ (Toggle eff . const . MODString) str
refreshOptionsSelectionList :: Universe -> Universe refreshOptionsSelectionList :: Universe -> Universe
refreshOptionsSelectionList u = u & uvScreenLayers . ix 0 %~ f refreshOptionsSelectionList u = u & uvScreenLayers . ix 0 %~ f
where where
f sl = case sl of f sl = case sl of
OptionScreen {_scOptions = mops OptionScreen {_scOptions = mops
, _scPositionedMenuOption = pmo
, _scAvailableLines = maxlines} , _scAvailableLines = maxlines}
-> sl & scSelectionList . slItems .~ optionsToSelections maxlines u mops -> sl & scSelectionList . slItems .~ optionsToSelections maxlines u mops pmo
_ -> sl _ -> sl
makeOptionsSelectionList :: Int -> Maybe Int -> Universe -> [MenuOption] -> SelectionList (Universe -> Universe) makeOptionsSelectionList :: Int -> Maybe Int -> Universe -> [MenuOption] -> PositionedMenuOption
makeOptionsSelectionList maxlines mselpos u mos = SelectionList -> SelectionList (Universe -> Universe)
{ _slItems = optionsToSelections maxlines u mos makeOptionsSelectionList maxlines mselpos u mos pmo = SelectionList
{ _slItems = optionsToSelections maxlines u mos pmo
, _slSelPos = mselpos , _slSelPos = mselpos
, _slLength = length $ optionsToSelections maxlines u mos , _slLength = length $ optionsToSelections maxlines u mos pmo
} }
optionsToSelections :: Int -> Universe -> [MenuOption] -> [SelectionItem (Universe -> Universe)] optionsToSelections :: Int -> Universe -> [MenuOption] -> PositionedMenuOption -> [SelectionItem (Universe -> Universe)]
optionsToSelections maxlines u allops = sits optionsToSelections maxlines u allops pmo = sits
where where
offset = u ^?! uvScreenLayers . _head . scOffset
ops | maxlines >= length allops = allops 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) maxOptionLength = 3 + maximum (0 : map (optionValueOffset u) ops)
colstrs = map (menuOptionToString u maxOptionLength) ops sits = case pmo of
sits = map (menuOptionToSelectionItem u maxOptionLength) ops 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")) cycleOptionsOption = Toggle cycleOptions (const (MODString "MORE OPTIONS"))
cycleOptions :: Universe -> Universe cycleOptions :: Universe -> Universe
cycleOptions u = fromMaybe u $ do cycleOptions u = fromMaybe u $ do
screen <- u ^? uvScreenLayers . ix 0 screen <- u ^? uvScreenLayers . _head
maxlines <- screen ^? scAvailableLines 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 :: (Color,String) -> SelectionItem (Universe -> Universe)
colStrToSelItem (col,str) = SelectionItem colStrToSelItem (col,str) = SelectionItem
+3 -1
View File
@@ -7,6 +7,7 @@ Description : Simulation update
module Dodge.Update (updateUniverse) where module Dodge.Update (updateUniverse) where
--import Dodge.Menu.Option --import Dodge.Menu.Option
import Dodge.Menu.Option
import Dodge.SelectionList import Dodge.SelectionList
import Dodge.Data.SelectionList import Dodge.Data.SelectionList
import Dodge.InputFocus import Dodge.InputFocus
@@ -141,7 +142,8 @@ optionScreenUpdate :: ScreenLayer -> [MenuOption] -> PositionedMenuOption -> Opt
-> SelectionList (Universe -> Universe) -> SelectionList (Universe -> Universe)
-> Universe -> Universe -> Universe -> Universe
optionScreenUpdate screen mos mop _ ldps sl u = optionScreenUpdate screen mos mop _ ldps sl u =
optionScreenDefEff mop refreshOptionsSelectionList
. optionScreenDefEff mop
. mouseClickOptionsList mos screen . mouseClickOptionsList mos screen
. mouseOverSelectionList ldps sl . mouseOverSelectionList ldps sl
. menuWheelEvents . menuWheelEvents