More work on menus
This commit is contained in:
@@ -62,7 +62,6 @@ data ScreenLayer
|
||||
, _scOptionFlag :: OptionScreenFlag
|
||||
, _scSelectionList :: SelectionList (Universe -> Universe)
|
||||
, _scAvailableLines :: Int
|
||||
-- , _scShownItems :: [(SelectionItem,SelectionItemIndex)]
|
||||
, _scListDisplayParams :: ListDisplayParams
|
||||
}
|
||||
| ColumnsScreen
|
||||
|
||||
+27
-16
@@ -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
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user