From 054405244f67ec492541ed45e413765d0fd548dd Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 4 Nov 2022 09:14:32 +0000 Subject: [PATCH] Continue work on menu screens --- src/Dodge/Data/Universe.hs | 4 ---- src/Dodge/Event/Menu.hs | 33 --------------------------------- src/Dodge/Menu.hs | 12 +++++------- src/Dodge/Menu/Option.hs | 7 ++----- src/Dodge/Render/MenuScreen.hs | 7 ++----- src/Dodge/Update.hs | 31 +++++++++++++++++++------------ 6 files changed, 28 insertions(+), 66 deletions(-) delete mode 100644 src/Dodge/Event/Menu.hs diff --git a/src/Dodge/Data/Universe.hs b/src/Dodge/Data/Universe.hs index 568da4123..ee4418474 100644 --- a/src/Dodge/Data/Universe.hs +++ b/src/Dodge/Data/Universe.hs @@ -87,10 +87,6 @@ data MenuOption , _moEff2 :: Universe -> Universe , _moString :: Universe -> MenuOptionDisplay } - | InvisibleToggle - { _moChar :: Scancode - , _moEff :: Universe -> Universe - } data IntID a = IntID Int a diff --git a/src/Dodge/Event/Menu.hs b/src/Dodge/Event/Menu.hs deleted file mode 100644 index fd1a35ef3..000000000 --- a/src/Dodge/Event/Menu.hs +++ /dev/null @@ -1,33 +0,0 @@ -module Dodge.Event.Menu ( - --optionListToEffects, -) where - -import Control.Lens -import Data.Maybe -import Dodge.Data.Universe -import Dodge.WindowLayout -import SDL - ---optionListToEffects :: --- (Universe -> Universe) -> --- Scancode -> --- [MenuOption] -> --- Universe -> --- Universe ---optionListToEffects defaulteff sc mops u = case sc of --- ScancodeSpace -> --- (uvScreenLayers . ix 0 . scOptionsOffset %~ (f . (+ mlines))) --- u --- _ -> --- ( fromMaybe defaulteff --- . lookup sc --- . concatMap menuOptionToEffects --- $ mops --- ) --- u --- where --- f x --- | x > length mops = 0 --- | otherwise = x --- mlines = availableMenuLines $ _uvConfig u - diff --git a/src/Dodge/Menu.hs b/src/Dodge/Menu.hs index 24d7e7949..8af2a19b8 100644 --- a/src/Dodge/Menu.hs +++ b/src/Dodge/Menu.hs @@ -19,7 +19,7 @@ import Dodge.StartNewGame import LensHelp import MaybeHelp import Padding -import SDL +--import SDL import System.Clipboard import Text.Read import Data.Maybe @@ -63,8 +63,6 @@ pauseMenuOptions = , Toggle id (opText "VIEW CURRENT SEED") , Toggle saveQuit (opText "SAVE AND QUIT") ] - ++ [ InvisibleToggle ScancodeEscape hardQuit - ] where opText = const . MODString @@ -162,12 +160,12 @@ soundMenu = soundMenuOptions :: [MenuOption] soundMenuOptions = - [ theoption ScancodeY volume_master ScancodeU "MASTER VOLUME" _volume_master - , theoption ScancodeH volume_sound ScancodeJ "EFFECTS VOLUME" _volume_sound - , theoption ScancodeN volume_music ScancodeM "MUSIC VOLUME" _volume_music + [ theoption volume_master "MASTER VOLUME" _volume_master + , theoption volume_sound "EFFECTS VOLUME" _volume_sound + , theoption volume_music "MUSIC VOLUME" _volume_music ] where - theoption scod1 stype scod2 str voltype = + theoption stype str voltype = Toggle2 (change dec stype) (change inc stype) diff --git a/src/Dodge/Menu/Option.hs b/src/Dodge/Menu/Option.hs index 09c57080d..0828e5aa2 100644 --- a/src/Dodge/Menu/Option.hs +++ b/src/Dodge/Menu/Option.hs @@ -36,11 +36,8 @@ makeOptionsSelectionList mselpos u mos = SelectionList optionsToSelections :: Universe -> [MenuOption] -> [SelectionItem] optionsToSelections u ops = map colStrToSelItem colstrs where - maxOptionLength = 3 + maximum (0 : map (optionValueOffset u) visibleops) - colstrs = zipWith (menuOptionToString u maxOptionLength) ['A'..] visibleops - visibleops = filter notInvisible ops - notInvisible InvisibleToggle{} = False - notInvisible _ = True + maxOptionLength = 3 + maximum (0 : map (optionValueOffset u) ops) + colstrs = zipWith (menuOptionToString u maxOptionLength) ['A'..] ops colStrToSelItem :: (Color,String) -> SelectionItem colStrToSelItem (col,str) = SelectionItem diff --git a/src/Dodge/Render/MenuScreen.hs b/src/Dodge/Render/MenuScreen.hs index 5f5359232..634025134 100644 --- a/src/Dodge/Render/MenuScreen.hs +++ b/src/Dodge/Render/MenuScreen.hs @@ -89,14 +89,11 @@ drawOptions u title ops off mselpos footer = maxOptionLength = 3 + maximum (0 : map (optionValueOffset u) ops') ops' = case availableMenuLines cfig of - x | x < length ops -> take (availableMenuLines cfig) (drop off visibleops) - _ -> visibleops + x | x < length ops -> take (availableMenuLines cfig) (drop off ops) + _ -> ops ops'' = case availableMenuLines cfig of x | x < length ops -> zipWith (menuOptionToString u maxOptionLength) ['A'..] ops' ++ [(white, "SPACE: MORE OPTIONS")] _ -> zipWith (menuOptionToString u maxOptionLength) ['A'..] ops' - visibleops = filter notInvisible ops - notInvisible InvisibleToggle{} = False - notInvisible _ = True hh = halfHeight cfig hw = halfWidth cfig cfig = _uvConfig u diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index d3af365fa..bcb6498bf 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -9,7 +9,6 @@ module Dodge.Update (updateUniverse) where import Dodge.Menu.Option import Dodge.Data.SelectionList import Dodge.InputFocus -import Dodge.Event.Menu import Color import Control.Applicative import Data.List @@ -92,16 +91,8 @@ gotoTerminal w = case _uvScreenLayers w of (InputScreen{} : _) -> w _ -> w & uvScreenLayers .:~ InputScreen T.empty "Enter command" -optionScreenUpdates :: Universe -> Universe -optionScreenUpdates u = case u ^? uvScreenLayers . _head of - Just (OptionScreen {_scOptions = mos, _scSelPos = mselpos}) -> - mouseClickSelectionList mos mselpos - $ mouseOverSelectionList - (makeOptionsSelectionList mselpos u mos) u - _ -> u - -mouseClickSelectionList :: [MenuOption] -> Maybe Int -> Universe -> Universe -mouseClickSelectionList mos mi u = case u ^. uvWorld . input . mouseButtons . at ButtonLeft of +mouseClickOptionsList :: [MenuOption] -> Maybe Int -> Universe -> Universe +mouseClickOptionsList mos mi u = case u ^. uvWorld . input . mouseButtons . at ButtonLeft of Just False -> fromMaybe u $ do i <- mi mo <- mos !? i @@ -127,7 +118,8 @@ mouseOverSelectionList sl u updateUseInput :: Universe -> Universe updateUseInput u = case u ^? uvScreenLayers . _head of Just (InputScreen thetext _) -> doInputScreenInput thetext u - Just OptionScreen{_scOptions = mos, _scDefaultEff = defeff} -> optionScreenUpdates . menuWheelEvents $ u + Just OptionScreen{_scOptions = mos, _scDefaultEff = defeff, _scOptionFlag = flag, _scSelPos = mselpos} + -> optionScreenUpdate mos defeff flag mselpos u -- foldl' (\u' scode -> optionListToEffects defeff scode mos u') u (M.keys $ M.filter (== InitialPress) pkeys) Just ColumnsScreen{} -> u & uvScreenLayers %~ tail _ -> case u ^? uvWorld . cWorld . lWorld . hud . hudElement . subInventory of @@ -136,6 +128,21 @@ updateUseInput u = case u ^? uvScreenLayers . _head of where pkeys = u ^. uvWorld . input . pressedKeys +optionScreenUpdate :: [MenuOption] -> (Universe -> Universe) -> OptionScreenFlag -> Maybe Int + -> Universe -> Universe +optionScreenUpdate mos defeff _ mselpos u = + optionScreenDefEff defeff + . mouseClickOptionsList mos mselpos + . mouseOverSelectionList + (makeOptionsSelectionList mselpos u mos) + $ menuWheelEvents + u + +optionScreenDefEff :: (Universe -> Universe) -> Universe -> Universe +optionScreenDefEff f u = case u ^. uvWorld . input . pressedKeys . at ScancodeEscape of + Just InitialPress -> f u + _ -> u + updateUniverseLast :: Universe -> Universe updateUniverseLast = over uvWorld (input . mouseButtons . each .~ True) -- to determine if the mouse button is held