More work on menus
This commit is contained in:
@@ -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
@@ -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
@@ -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
|
||||||
|
|||||||
Reference in New Issue
Block a user