diff --git a/src/Dodge/Menu.hs b/src/Dodge/Menu.hs index 70fa4dd71..4ebaa2a95 100644 --- a/src/Dodge/Menu.hs +++ b/src/Dodge/Menu.hs @@ -51,12 +51,13 @@ splashMenuOptions = | otherwise = MODString str pauseMenu :: Universe -> ScreenLayer -pauseMenu = initializeOptionMenu "PAUSED" pauseMenuOptions (Just "CONTINUE") unpause +pauseMenu = initializeOptionMenu' "PAUSED" pauseMenuOptions pmo + where + pmo = TopMenuOption $ Toggle unpause (const (MODString "CONTINUE")) pauseMenuOptions :: [MenuOption] pauseMenuOptions = - [ Toggle popScreen (opText "CONTINUE") - , Toggle (startNewGameInSlot 0) (opText "NEW GAME") + [ Toggle (startNewGameInSlot 0) (opText "NEW GAME") , Toggle reloadLevelStart (opText "RESTART") , Toggle (pushScreen $ seedStartMenu "START FROM SEED") (opText "NEW FROM SEED") , Toggle (pushScreen optionMenu) (opText "OPTIONS") diff --git a/src/Dodge/Menu/Option.hs b/src/Dodge/Menu/Option.hs index a186b7faf..21699b03e 100644 --- a/src/Dodge/Menu/Option.hs +++ b/src/Dodge/Menu/Option.hs @@ -22,8 +22,8 @@ optionListDisplayParams = ListDisplayParams , _ldpCursorType = BorderCursor (Set.fromList [North,South,West]) } -initializeOptionMenu :: String -> [MenuOption] -> Maybe String -> (Universe -> Universe) -> Universe -> ScreenLayer -initializeOptionMenu title ops defstr eff u = +initializeOptionMenu' :: String -> [MenuOption] -> PositionedMenuOption -> Universe -> ScreenLayer +initializeOptionMenu' title ops pmo u = OptionScreen { _scTitle = title , _scOptions = ops @@ -34,6 +34,9 @@ initializeOptionMenu title ops defstr eff u = , _scAvailableLines = getAvailableListLines optionListDisplayParams (u ^. uvConfig) , _scListDisplayParams = optionListDisplayParams } + +initializeOptionMenu :: String -> [MenuOption] -> Maybe String -> (Universe -> Universe) -> Universe -> ScreenLayer +initializeOptionMenu title ops defstr eff = initializeOptionMenu' title ops pmo where pmo = case defstr of Nothing -> NoPositionedMenuOption @@ -60,7 +63,7 @@ makeOptionsSelectionList maxlines mselpos u mos pmo = SelectionList optionsToSelections :: Int -> Universe -> [MenuOption] -> PositionedMenuOption -> [SelectionItem (Universe -> Universe)] optionsToSelections maxlines u allops pmo = sits where - offset = u ^?! uvScreenLayers . _head . scOffset + offset = fromMaybe 0 $ u ^? uvScreenLayers . _head . scOffset ops | maxlines >= length allops = allops | otherwise = take (maxlines - 2) (drop offset allops ++ repeat dummyMenuOption) ++ [cycleOptionsOption] maxOptionLength = 3 + maximum (0 : map (optionValueOffset u) ops) @@ -70,8 +73,8 @@ optionsToSelections maxlines u allops pmo = sits BottomMenuOption mo -> map (menuOptionToSelectionItem u maxOptionLength) (ops ++ [mo]) cycleOptionsOption = Toggle cycleOptions (const (MODString ("MORE OPTIONS " ++ show n ++ "/" ++ show m))) l = length allops - m = div (max 1 (l - 1)) (maxlines - 2) + 1 - n = div (offset + 1) (maxlines - 2) + 1 + m = div (l - 1) (max 1 (maxlines - 2)) + 1 + n = div (offset + 1) (max 1 (maxlines - 2)) + 1 dummyMenuOption :: MenuOption dummyMenuOption = Toggle id (const $ MODBlockedString "") diff --git a/src/Dodge/SelectionList.hs b/src/Dodge/SelectionList.hs index 81f1245e1..9a4f6b1ae 100644 --- a/src/Dodge/SelectionList.hs +++ b/src/Dodge/SelectionList.hs @@ -4,7 +4,7 @@ module Dodge.SelectionList where --import Dodge.WindowLayout import Dodge.Data.Universe import LensHelp -import Data.Maybe +--import Data.Maybe getAvailableListLines :: ListDisplayParams -> Configuration -> Int getAvailableListLines ldps cfig = nlines diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 4e0945458..f6019d7b9 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -93,8 +93,8 @@ gotoTerminal w = case _uvScreenLayers w of (InputScreen{} : _) -> w _ -> w & uvScreenLayers .:~ InputScreen T.empty "Enter command" -mouseClickOptionsList :: [MenuOption] -> ScreenLayer -> Universe -> Universe -mouseClickOptionsList mos screen u = fromMaybe u $ do +mouseClickOptionsList :: ScreenLayer -> Universe -> Universe +mouseClickOptionsList screen u = fromMaybe u $ do sl <- screen ^? scSelectionList Just $ case u ^. uvWorld . input . mouseButtons . at ButtonLeft of Just False -> fromMaybe u $ do @@ -128,8 +128,8 @@ setSelectionListRestriction' cfig screen = fromMaybe screen $ do updateUseInput :: Universe -> Universe updateUseInput u = case u ^? uvScreenLayers . _head of Just (InputScreen thetext _) -> doInputScreenInput thetext u - Just screen@OptionScreen{_scOptions = mos, _scPositionedMenuOption = mop, _scOptionFlag = flag, _scSelectionList = sellist, _scListDisplayParams = ldps} - -> optionScreenUpdate screen mos mop flag ldps sellist u + Just screen@OptionScreen{_scPositionedMenuOption = mop, _scOptionFlag = flag, _scSelectionList = sellist, _scListDisplayParams = ldps} + -> optionScreenUpdate screen mop flag ldps 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 @@ -137,14 +137,14 @@ updateUseInput u = case u ^? uvScreenLayers . _head of where pkeys = u ^. uvWorld . input . pressedKeys -optionScreenUpdate :: ScreenLayer -> [MenuOption] -> PositionedMenuOption -> OptionScreenFlag +optionScreenUpdate :: ScreenLayer -> PositionedMenuOption -> OptionScreenFlag -> ListDisplayParams -> SelectionList (Universe -> Universe) -> Universe -> Universe -optionScreenUpdate screen mos mop _ ldps sl u = +optionScreenUpdate screen mop _ ldps sl u = refreshOptionsSelectionList . optionScreenDefEff mop - . mouseClickOptionsList mos screen + . mouseClickOptionsList screen . mouseOverSelectionList ldps sl . menuWheelEvents . over (uvScreenLayers . _head) (setSelectionListRestriction' cfig)