Add graphics menu options

src/Dodge/Event/Menu.hs

@@ -19,32 +19,37 @@ handlePressedKeyInMenu :: MenuLayer -> Scancode -> World -> Maybe World
 handlePressedKeyInMenu mState scode w = case mState of
     LevelMenu _ -> case scode of
         ScancodeEscape  -> Nothing
-            ScancodeO       -> goToOptionMenu w
+        ScancodeO       -> pushMenu OptionMenu w
-            ScancodeC       -> goToControls w
+        ScancodeC       -> pushMenu ControlList w
         _               -> startLevel w
     PauseMenu   -> case scode of
         ScancodeEscape  -> Nothing
         ScancodeR       -> return $ fromMaybe w $ _storedLevel w
         ScancodeN       -> startNewGame
-            ScancodeO       -> goToOptionMenu w
+        ScancodeO       -> pushMenu OptionMenu w
-            ScancodeC       -> goToControls w
+        ScancodeC       -> pushMenu ControlList w
         _               -> unpause w
     GameOverMenu -> case scode of
         ScancodeEscape  -> Nothing
         ScancodeR       -> Just $ fromMaybe w $ _storedLevel w
         ScancodeN       -> startNewGame
-            ScancodeO       -> goToOptionMenu w
+        ScancodeO       -> pushMenu OptionMenu w
-            ScancodeC       -> goToControls w
+        ScancodeC       -> pushMenu ControlList w
         _               -> Just 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
-            _               -> Just $ w & menuLayers %~ tail
+        _               -> popMenu $ w & sideEffects %~ (saveConfig (_config 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) : )

src/Dodge/Render/MenuScreen.hs

@@ -19,45 +19,37 @@ menuScreen
     -> Picture
 menuScreen cfig hw hh mLays = case mLays of
     [] -> blank 
-    (LevelMenu x:_) -> pictures 
+    (LevelMenu x:_) -> optionsList hw hh ("LEVEL"++show x) [] 
-        [color (withAlpha 0.5 black) $ polygon $ screenBox hw hh
+    (PauseMenu:_)   -> optionsList hw hh "PAUSED"
-        ,tst (-100) 100 0.4 ("LEVEL "++show x)
+        ["n - NEW LEVEL"
+        ,"r - RESTART"
+        ,"o - OPTIONS"
+        ,"c - CONTROLS"
         ]
-    (PauseMenu:_)   -> pictures 
+    (GameOverMenu:_) -> optionsList hw hh "GAME OVER" 
-        [color (withAlpha 0.5 black) $ polygon $ screenBox hw hh
+        ["n - NEW LEVEL"
-        ,tst (-100) 100 0.4 "PAUSED"
+        ,"r - RESTART"
-        ,tst (-100) 50 0.2 "n - new level"
+        ,"o - OPTIONS"
-        ,tst (-100) 0 0.2 "r - restart"
+        ,"c - CONTROLS"
-        ,tst (-100) (-50) 0.2 "o - options"
-        ,tst (-100) (-100) 0.2 "c - controls"
         ]
-    (GameOverMenu:_) -> pictures 
+    (OptionMenu : _) -> optionsList hw hh "OPTIONS" 
-        [color (withAlpha 0.5 black) $ polygon $ screenBox hw hh
+        ["v - VOLUME"
-        ,tst (-100) 100 0.4 "GAME OVER"
+        ,"g - GRAPHICS"
-        ,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 : _) -> pictures 
+    (SoundOptionMenu : _) -> optionsList hw hh "OPTIONS:VOLUME" 
-        [color (withAlpha 0.5 black) $ polygon $ screenBox hw hh
+        ["y - MASTER VOLUME + u : " ++ mavol
-        ,tst (-100) 100 0.4 "OPTIONS"
+        ,"h - SOUND  VOLUME + j : " ++ snvol
-        ,tst (-180) 50 0.2    $ "y - master volume + u : " ++ mavol
+        ,"n - MUSIC  VOLUME + m : " ++ muvol
-        ,tst (-180) 0 0.2     $ "h - sound  volume + j : " ++ snvol
+        ]
-        ,tst (-180) (-50) 0.2 $ "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
+    (ConfigSaveScreen : _) -> optionsList hw hh "SAVING..." []
-        [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
-        ]
     _ -> 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    -- ^ Half screen width
-    -> Float
+    -> Float    -- ^ Half screen height
     -> [(Float,Float)]
 screenBox halfW halfH = 
     [  (halfW, halfH)