From 111b86d2dfa5d493bda0e0cd8f5dd54176ae831c Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 3 Sep 2021 13:48:52 +0100 Subject: [PATCH] Unify menu event handling and display --- src/Dodge/Event/Menu.hs | 102 +++++++++++---------------------- src/Dodge/Menu.hs | 61 +++++++++++++++++++- src/Dodge/Render/MenuScreen.hs | 41 ++++--------- 3 files changed, 104 insertions(+), 100 deletions(-) diff --git a/src/Dodge/Event/Menu.hs b/src/Dodge/Event/Menu.hs index 256f9bd7c..1313e42a2 100644 --- a/src/Dodge/Event/Menu.hs +++ b/src/Dodge/Event/Menu.hs @@ -3,23 +3,23 @@ module Dodge.Event.Menu ) where import Dodge.Data import Dodge.Data.Menu -import Dodge.Base.Window -import Dodge.Floor -import Dodge.Initialisation +--import Dodge.Base.Window +--import Dodge.Floor +--import Dodge.Initialisation import Dodge.SoundLogic -import Dodge.Config.Data +--import Dodge.Config.Data import Dodge.Config.Update -import Dodge.Layout -import Preload.Update +--import Dodge.Layout +--import Preload.Update import Dodge.Debug.Terminal import Dodge.Menu -import Data.Maybe -import Data.Foldable +--import Data.Maybe +--import Data.Foldable --import qualified Data.Set as S import Control.Lens import SDL -import SDL.Internal.Numbered +--import SDL.Internal.Numbered handlePressedKeyInMenu :: MenuLayer -> Scancode -> World -> Maybe World handlePressedKeyInMenu mState scode w = case mState of @@ -30,76 +30,44 @@ handlePressedKeyInMenu mState scode w = case mState of ScancodeReturn -> popMenu $ applyTerminalString s w ScancodeBackspace -> popMenu w >>= pushMenu (Terminal $ dropLast s) _ -> popMenu w >>= pushMenu (Terminal $ s ++ [scodeToChar scode]) - LevelMenu _ -> case scode of - ScancodeEscape -> Nothing - ScancodeO -> pushMenu OptionMenu w - ScancodeC -> pushMenu ControlList w - _ -> startLevel w - PauseMenu -> case scode of - ScancodeEscape -> Nothing - ScancodeR -> return $ fromMaybe w $ _storedLevel w - ScancodeN -> startNewGame - ScancodeO -> pushMenu OptionMenu w - ScancodeC -> pushMenu ControlList w - _ -> unpause w - GameOverMenu -> case scode of - ScancodeEscape -> Nothing - ScancodeR -> Just $ fromMaybe w $ _storedLevel w - ScancodeN -> startNewGame - ScancodeO -> pushMenu OptionMenu w - ScancodeC -> pushMenu ControlList w - _ -> Just w - OptionMenu -> optionListToEffects optionsOptions popMenu scode w --- OptionMenu -> case scode of --- ScancodeV -> pushMenu SoundOptionMenu w --- ScancodeG -> pushMenu GraphicsOptionMenu w --- _ -> popMenu w - SoundOptionMenu -> case scode of - ScancodeY -> Just $ sw & config . volume_master %~ dec - ScancodeU -> Just $ sw & config . volume_master %~ inc - ScancodeH -> Just $ sw & config . volume_sound %~ dec - ScancodeJ -> Just $ sw & config . volume_sound %~ inc - ScancodeN -> Just $ sw & config . volume_music %~ dec - ScancodeM -> Just $ sw & config . volume_music %~ inc - _ -> popMenu $ w & sideEffects %~ (saveConfig (_config w) :) - GraphicsOptionMenu -> case scode of - ScancodeW -> Just $ w & config . wall_textured %~ not - ScancodeS -> Just $ updateFramebufferSize $ w & config . resolution_factor %~ cycleResolution - _ -> popMenu $ w & sideEffects %~ (saveConfig (_config w) :) + LevelMenu _ -> optionListToEffects levelMenuOptions startLevel scode w + PauseMenu -> optionListToEffects pauseMenuOptions unpause scode w + GameOverMenu -> optionListToEffects pauseMenuOptions pure scode w + OptionMenu -> optionListToEffects optionsOptions popMenu scode w + SoundOptionMenu -> optionListToEffects + soundMenuOptions + ( popMenu . writeConfig ) + scode + w + GraphicsOptionMenu -> optionListToEffects graphicsMenuOptions (popMenu . writeConfig) scode w ControlList -> Just $ w & menuLayers %~ tail _ -> Just w where + writeConfig = sideEffects %~ (saveConfig (_config w) :) unpause w' = Just . resumeSound $ w' {_menuLayers = []} startLevel = unpause . storeLevel - dec x = max 0 (x - 0.1) - inc x = min 1 (x + 0.1) - pushMenu ml w' = Just $ w' & menuLayers %~ (ml :) popMenu w' = Just $ w' & menuLayers %~ tail - sw = w & sideEffects %~ (setVol (_config w) : ) - startNewGame = Just $ w - & menuLayers .~ [WaitMessage "GENERATING..." 1] - & worldEvents .~ const aNewGame - aNewGame :: World - aNewGame = updateFramebufferSize $ generateLevelFromRoomList levx $ initialWorld - & randGen .~ _randGen w - & config .~ _config w dropLast (x:xs) = init (x:xs) dropLast _ = [] optionListToEffects :: [MenuOption] -> (World -> Maybe World) -> Scancode -> World -> Maybe World -optionListToEffects mos eff sc w = case find (\mo -> _moKey mo == sc) mos of +optionListToEffects mos eff sc w = case lookup sc listEffects of Nothing -> eff w - Just mo -> _moEffect mo w + Just eff' -> eff' w + where + listEffects = concatMap menuOptionToEffects mos - - -cycleResolution :: (Eq a, Num a, Num p) => a -> p -cycleResolution 1 = 2 -cycleResolution 2 = 4 -cycleResolution 4 = 1 -cycleResolution _ = 1 +menuOptionToEffects :: MenuOption -> [(Scancode,World -> Maybe World)] +menuOptionToEffects Toggle {_moKey = k, _moEff = eff} = [(k,eff)] +menuOptionToEffects InvisibleToggle {_moKey = k, _moEff = eff} = [(k,eff)] +menuOptionToEffects Toggle2 + { _moKey1 = k1 + , _moEff1 = eff1 + , _moKey2 = k2 + , _moEff2 = eff2 + } = [(k1,eff1) , (k2,eff2)] storeLevel :: World -> World storeLevel w = case _storedLevel w of - Nothing -> w & storedLevel ?~ w - _ -> w + Nothing -> w & storedLevel ?~ w + _ -> w diff --git a/src/Dodge/Menu.hs b/src/Dodge/Menu.hs index 09aca37a3..a8ea8e086 100644 --- a/src/Dodge/Menu.hs +++ b/src/Dodge/Menu.hs @@ -3,6 +3,7 @@ module Dodge.Menu import Dodge.Data import Dodge.Data.Menu import Dodge.Config.Data +import Dodge.Config.Update import SDL import SDL.Internal.Numbered import Dodge.Layout @@ -17,12 +18,19 @@ import Data.Maybe data MenuOption = Toggle { _moKey :: Scancode - , _moEffect :: World -> Maybe World + , _moEff :: World -> Maybe World + , _moString :: World -> String + } + | Toggle2 + { _moKey1 :: Scancode + , _moEff1 :: World -> Maybe World + , _moKey2 :: Scancode + , _moEff2 :: World -> Maybe World , _moString :: World -> String } | InvisibleToggle { _moKey :: Scancode - , _moEffect :: World -> Maybe World + , _moEff :: World -> Maybe World } optionsOptions :: [MenuOption] @@ -30,9 +38,57 @@ optionsOptions = [ Toggle ScancodeV (pushMenu SoundOptionMenu) (const "VOLUME") , Toggle ScancodeG (pushMenu GraphicsOptionMenu) (const "GRAPHICS") ] +levelMenuOptions :: [MenuOption] +levelMenuOptions = + [ InvisibleToggle ScancodeEscape (const Nothing) + , InvisibleToggle ScancodeO (pushMenu OptionMenu) + , InvisibleToggle ScancodeC (pushMenu ControlList) + ] +soundMenuOptions :: [MenuOption] +soundMenuOptions = + [ Toggle2 ScancodeY (master dec . sw) + ScancodeU (master inc . sw) (\w -> "MASTER VOLUME:" ++ mavol w) + , Toggle2 ScancodeH (soundEffs dec . sw) + ScancodeJ (soundEffs inc . sw) (\w -> "EFFECTS VOLUME:" ++ snvol w) + , Toggle2 ScancodeN (music dec . sw) + ScancodeM (music inc . sw) (\w -> "MUSIC VOLUME:" ++ muvol w) + ] + where + dec x = max 0 (x - 0.1) + inc x = min 1 (x + 0.1) + sw w = w & sideEffects %~ (setVol (_config w) : ) + master g = Just . (config . volume_master %~ g) + soundEffs g = Just . (config . volume_sound %~ g) + music g = Just . (config . volume_music %~ g) + cfig w = _config w + mavol w = f $ _volume_master $ cfig w + snvol w = f $ _volume_sound $ cfig w + muvol w = f $ _volume_music $ cfig w + f x = show (round $ 10 * x :: Int) +pushMenu :: MenuLayer -> World -> Maybe World pushMenu ml w' = Just $ w' & menuLayers %~ (ml :) +--soundOptions :: [MenuOption] +--soundOptions = +-- [ Toggle2 ScancodeY + +graphicsMenuOptions :: [MenuOption] +graphicsMenuOptions = + [ Toggle ScancodeW (Just . (config . wall_textured %~ not)) wtextstring + , Toggle ScancodeS upf resostring + ] + where + wtextstring w = "WALL TEXTURES:" ++ show (_wall_textured $ _config w) + resostring w = "RESOLUTION: 1/" ++ show (_resolution_factor $ _config w) + upf w = Just $ updateFramebufferSize $ w & config . resolution_factor %~ cycleResolution + +cycleResolution :: (Eq a, Num a, Num p) => a -> p +cycleResolution 1 = 2 +cycleResolution 2 = 4 +cycleResolution 4 = 1 +cycleResolution _ = 1 + pauseMenuOptions :: [MenuOption] pauseMenuOptions = [ Toggle ScancodeN startNewGame (const "NEW LEVEL") @@ -42,6 +98,7 @@ pauseMenuOptions = , InvisibleToggle ScancodeEscape (const Nothing) ] +startNewGame :: World -> Maybe World startNewGame w = Just $ w & menuLayers .~ [WaitMessage "GENERATING..." 1] & worldEvents .~ const aNewGame diff --git a/src/Dodge/Render/MenuScreen.hs b/src/Dodge/Render/MenuScreen.hs index 1350e7bb3..ee2aa0c4b 100644 --- a/src/Dodge/Render/MenuScreen.hs +++ b/src/Dodge/Render/MenuScreen.hs @@ -23,34 +23,12 @@ menuScreen -> [MenuLayer] -> Picture menuScreen w cfig hw hh mLays = case mLays of - (LevelMenu x:_) -> optionsList hw hh ("LEVEL"++show x) [] + (LevelMenu x:_) -> optionsFromList w hw hh ("LEVEL"++show x) levelMenuOptions (PauseMenu : _) -> optionsFromList w hw hh "PAUSED" pauseMenuOptions --- (PauseMenu:_) -> optionsList hw hh "PAUSED" --- ["N - NEW LEVEL" --- ,"R - RESTART" --- ,"O - OPTIONS" --- ,"C - CONTROLS" --- ] - (GameOverMenu:_) -> optionsList hw hh "GAME OVER" - ["N - NEW LEVEL" - ,"R - RESTART" - ,"O - OPTIONS" - ,"C - CONTROLS" - ] + (GameOverMenu : _) -> optionsFromList w hw hh "GAME OVER" pauseMenuOptions (OptionMenu : _) -> optionsFromList w hw hh "OPTIONS" optionsOptions --- (OptionMenu : _) -> optionsList hw hh "OPTIONS" --- ["V - VOLUME" --- ,"G - GRAPHICS" --- ] - (SoundOptionMenu : _) -> optionsList hw hh "OPTIONS:VOLUME" - ["Y - MASTER VOLUME + U : " ++ mavol - ,"H - SOUND VOLUME + J : " ++ snvol - ,"N - MUSIC VOLUME + M : " ++ muvol - ] - (GraphicsOptionMenu : _) -> optionsList hw hh "OPTIONS:GRAPHICS" - ["W - WALL TEXTURES:" ++ show (_wall_textured cfig) - ,"S - RESOLUTION: 1/" ++ show (_resolution_factor cfig) - ] + (SoundOptionMenu : _) -> optionsFromList w hw hh "OPTIONS:VOLUME" soundMenuOptions + (GraphicsOptionMenu : _) -> optionsFromList w hw hh "OPTIONS:GRAPHICS" graphicsMenuOptions (ControlList : _) -> pictures [color (withAlpha 0.5 black) $ polygon $ screenBox hw hh ,tst (-100) 100 0.4 "CONTROLS" @@ -62,10 +40,6 @@ menuScreen w cfig hw hh mLays = case mLays of _ -> blank where tst x y sc t = translate x y $ scale sc sc $ color white $ text t - mavol = f $ _volume_master cfig - snvol = f $ _volume_sound cfig - muvol = f $ _volume_music cfig - f x = show (round $ 10 * x :: Int) displayStringList :: Float -> Float -> [String] -> Picture displayStringList hw hh ss = pictures @@ -96,7 +70,12 @@ optionsFromList w hw hh tit ops = pictures $ darkenBackground = color (withAlpha 0.5 black) $ polygon $ screenBox hw hh theTitle = placeString (-hw + 30) (hh - 50) 0.4 tit menuOptionToString :: World -> MenuOption -> String -menuOptionToString w mo = (scodeToChar $ _moKey mo) : ':' : _moString mo w +menuOptionToString w mo@(Toggle{}) + = (scodeToChar $ _moKey mo) : ':' : _moString mo w +menuOptionToString w mo@(Toggle2{}) + = (scodeToChar $ _moKey1 mo) : '/' : (scodeToChar $ _moKey2 mo) : ':' : _moString mo w +menuOptionToString _ _ = "undefined option string" + optionsList :: Float -- ^ Half screen width