Unify menu event handling and display

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