From 5a8555d5a09f43b24cc2eb7744af66a9660e0e07 Mon Sep 17 00:00:00 2001 From: jgk Date: Wed, 28 Apr 2021 14:10:47 +0200 Subject: [PATCH] Add graphics menu options --- src/Dodge/Event/Menu.hs | 55 ++++++++++++++------------ src/Dodge/Render/MenuScreen.hs | 70 ++++++++++++++++++---------------- 2 files changed, 69 insertions(+), 56 deletions(-) diff --git a/src/Dodge/Event/Menu.hs b/src/Dodge/Event/Menu.hs index 9e5db6011..3409e5e42 100644 --- a/src/Dodge/Event/Menu.hs +++ b/src/Dodge/Event/Menu.hs @@ -18,33 +18,38 @@ import SDL handlePressedKeyInMenu :: MenuLayer -> Scancode -> World -> Maybe World handlePressedKeyInMenu mState scode w = case mState of LevelMenu _ -> case scode of - ScancodeEscape -> Nothing - ScancodeO -> goToOptionMenu w - ScancodeC -> goToControls w - _ -> startLevel w + 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 -> goToOptionMenu w - ScancodeC -> goToControls w - _ -> unpause w + 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 -> goToOptionMenu w - ScancodeC -> goToControls w - _ -> Just w + ScancodeEscape -> Nothing + ScancodeR -> Just $ fromMaybe w $ _storedLevel w + ScancodeN -> startNewGame + ScancodeO -> pushMenu OptionMenu w + ScancodeC -> pushMenu ControlList w + _ -> Just w OptionMenu -> 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 - _ -> Just $ w & menuLayers %~ tail - & sideEffects %~ (saveConfig (_config w) :) + 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 + _ -> popMenu w ControlList -> Just $ w & menuLayers %~ tail _ -> Just w where @@ -53,6 +58,8 @@ handlePressedKeyInMenu mState scode w = case mState of 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 goToOptionMenu w = Just $ w & menuLayers %~ (OptionMenu :) goToControls w = Just $ w & menuLayers %~ (ControlList :) sw = w & sideEffects %~ (setVol (_config w) : ) diff --git a/src/Dodge/Render/MenuScreen.hs b/src/Dodge/Render/MenuScreen.hs index c6cce8dfc..c77b0889f 100644 --- a/src/Dodge/Render/MenuScreen.hs +++ b/src/Dodge/Render/MenuScreen.hs @@ -19,45 +19,37 @@ menuScreen -> Picture menuScreen cfig hw hh mLays = case mLays of [] -> blank - (LevelMenu x:_) -> pictures - [color (withAlpha 0.5 black) $ polygon $ screenBox hw hh - ,tst (-100) 100 0.4 ("LEVEL "++show x) + (LevelMenu x:_) -> optionsList hw hh ("LEVEL"++show x) [] + (PauseMenu:_) -> optionsList hw hh "PAUSED" + ["n - NEW LEVEL" + ,"r - RESTART" + ,"o - OPTIONS" + ,"c - CONTROLS" ] - (PauseMenu:_) -> pictures - [color (withAlpha 0.5 black) $ polygon $ screenBox hw hh - ,tst (-100) 100 0.4 "PAUSED" - ,tst (-100) 50 0.2 "n - new level" - ,tst (-100) 0 0.2 "r - restart" - ,tst (-100) (-50) 0.2 "o - options" - ,tst (-100) (-100) 0.2 "c - controls" + (GameOverMenu:_) -> optionsList hw hh "GAME OVER" + ["n - NEW LEVEL" + ,"r - RESTART" + ,"o - OPTIONS" + ,"c - CONTROLS" ] - (GameOverMenu:_) -> pictures - [color (withAlpha 0.5 black) $ polygon $ screenBox hw hh - ,tst (-100) 100 0.4 "GAME OVER" - ,tst (-100) 50 0.2 "n - new level" - ,tst (-100) 0 0.2 "r - restart" - ,tst (-100) (-50) 0.2 "o - options" - ,tst (-100) (-100) 0.2 "c - controls" + (OptionMenu : _) -> optionsList hw hh "OPTIONS" + ["v - VOLUME" + ,"g - GRAPHICS" ] - (OptionMenu : _) -> pictures - [color (withAlpha 0.5 black) $ polygon $ screenBox hw hh - ,tst (-100) 100 0.4 "OPTIONS" - ,tst (-180) 50 0.2 $ "y - master volume + u : " ++ mavol - ,tst (-180) 0 0.2 $ "h - sound volume + j : " ++ snvol - ,tst (-180) (-50) 0.2 $ "n - music volume + m : " ++ muvol + (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" ] (ControlList : _) -> pictures [color (withAlpha 0.5 black) $ polygon $ screenBox hw hh ,tst (-100) 100 0.4 "CONTROLS" ,controlsList ] - (ConfigSaveScreen : _) -> pictures - [color (withAlpha 0.5 black) $ polygon $ screenBox hw hh - ,tst (-100) 100 0.4 "OPTIONS" - ,tst (-180) 50 0.2 $ "y - master volume + u : " ++ mavol - ,tst (-180) 0 0.2 $ "h - sound volume + j : " ++ snvol - ,tst (-180) (-50) 0.2 $ "n - music volume + m : " ++ muvol - ] + (ConfigSaveScreen : _) -> optionsList hw hh "SAVING..." [] _ -> blank where tst x y sc t = translate x y $ scale sc sc $ color white $ text t @@ -66,6 +58,20 @@ menuScreen cfig hw hh mLays = case mLays of muvol = f $ _volume_music $ cfig f x = show $ round $ 10 * x +optionsList + :: Float -- ^ Half screen width + -> Float -- ^ Half screen height + -> String -- ^ Title + -> [String] -- ^ Options + -> Picture +optionsList hw hh tit ops = pictures $ + [color (withAlpha 0.5 black) $ polygon $ screenBox hw hh + ,placeString (-hw + 30) (hh - 50) 0.4 tit] + ++ + zipWith (\ s vpos -> placeString (-hw + 50) vpos 0.2 s) ops [hh-100,hh-150 ..] + where + placeString x y sc t = translate x y $ scale sc sc $ color white $ text t + controlsList = pictures $ concat $ zipWith butAndEff [("wasd", "movement") ,("[rmb]", "aim") @@ -85,8 +91,8 @@ controlsList = pictures $ concat $ zipWith butAndEff ] screenBox - :: Float - -> Float + :: Float -- ^ Half screen width + -> Float -- ^ Half screen height -> [(Float,Float)] screenBox halfW halfH = [ (halfW, halfH)