Allow for events to do io

src/Dodge/Menu.hs

@@ -13,20 +13,24 @@ import Dodge.Config.Update
 import SDL
 import SDL.Internal.Numbered
 --import Preload.Update
-import Dodge.Base.Window
 import Dodge.SoundLogic
 import Dodge.LevelGen
 
 import Control.Lens
 import System.Random
 
-optionMenu :: ScreenLayer
-optionMenu = OptionScreen
-    { _scTitle = const "OPTIONS"
-    , _scOptions = optionsOptions
-    , _scDefaultEff = popScreen
+titleOptions title ops = titleOptionsEff title ops (return . popScreen . writeConfig)
+
+titleOptionsEff title ops eff = OptionScreen
+    { _scTitle = const title
+    , _scOptions = ops
+    , _scDefaultEff = eff
     , _scOptionFlag = NormalOptions
     }
+
+optionMenu :: ScreenLayer
+optionMenu = titleOptionsEff "OPTIONS" optionsOptions (return . popScreen)
+
 optionsOptions :: [MenuOption]
 optionsOptions =
     [ anOption ScancodeV soundMenu      "VOLUME"
@@ -37,12 +41,9 @@ optionsOptions =
   where
     anOption scode submenu t = Toggle scode (pushScreen submenu) (const t)
 debugMenu :: ScreenLayer
-debugMenu  = OptionScreen
-    { _scTitle = const "OPTIONS:GAMEPLAY"
-    , _scOptions = debugMenuOptions
-    , _scDefaultEff = popScreen . writeConfig
-    , _scOptionFlag = NormalOptions
-    }
+debugMenu = titleOptions
+    "OPTIONS:GAMEPLAY" 
+    debugMenuOptions 
 debugMenuOptions :: [MenuOption]
 debugMenuOptions =
     [ doption ScancodeF debug_seconds_frame "SHOW SECONDS/FRAME" _debug_seconds_frame
@@ -55,12 +56,10 @@ debugMenuOptions =
     doption scode l t rec 
         = Toggle scode (Just . (config . l %~ not)) (\w -> t ++ ":" ++ show (rec $ _config w))
 gameplayMenu :: ScreenLayer
-gameplayMenu  = OptionScreen
-    { _scTitle = const "OPTIONS:GAMEPLAY"
-    , _scOptions = gameplayMenuOptions
-    , _scDefaultEff = popScreen . writeConfig
-    , _scOptionFlag = NormalOptions
-    }
+gameplayMenu  = titleOptions
+    "OPTIONS:GAMEPLAY"
+    gameplayMenuOptions
+
 gameplayMenuOptions :: [MenuOption]
 gameplayMenuOptions =
     [ option ScancodeR rotate_to_wall "ROTATE TO WALL" _rotate_to_wall
@@ -71,12 +70,10 @@ gameplayMenuOptions =
         (\w -> t ++ ":" ++ show (rec $ _config w))
 
 soundMenu :: ScreenLayer
-soundMenu = OptionScreen
-    { _scTitle = const "OPTIONS:VOLUME"
-    , _scOptions = soundMenuOptions
-    , _scDefaultEff = popScreen . writeConfig
-    , _scOptionFlag = NormalOptions
-    }
+soundMenu = titleOptions
+    "OPTIONS:VOLUME"
+    soundMenuOptions
+
 soundMenuOptions :: [MenuOption]
 soundMenuOptions =
     [ Toggle2 ScancodeY (master dec . sw)
@@ -89,7 +86,6 @@ soundMenuOptions =
   where
     dec x = max 0 (x - 0.1)
     inc x = min 1 (x + 0.1)
-    --sw w = w & sideEffects %~ (setVol (_config w) : )
     sw w = w & uvWorld . sideEffects %~ setVolThen (_config w)
     master g    = Just . (config . volume_master %~ g)
     soundEffs g = Just . (config . volume_sound %~ g)
@@ -110,12 +106,8 @@ writeConfig :: Universe -> Universe
 writeConfig w = w & uvWorld . sideEffects %~ saveConfig (_config w)
 
 graphicsMenu :: ScreenLayer
-graphicsMenu = OptionScreen
-    { _scTitle = const "OPTIONS:GRAPHICS"
-    , _scOptions = graphicsMenuOptions
-    , _scDefaultEff = popScreen . writeConfig
-    , _scOptionFlag = NormalOptions
-    }
+graphicsMenu = titleOptions "OPTIONS:GRAPHICS" graphicsMenuOptions
+
 graphicsMenuOptions :: [MenuOption]
 graphicsMenuOptions =
     [ Toggle ScancodeW (Just . (config . wall_textured %~ not))  wtextstring
@@ -138,17 +130,13 @@ gameOverMenu :: ScreenLayer
 gameOverMenu = OptionScreen
     { _scTitle = const "GAME OVER"
     , _scOptions = pauseMenuOptions
-    , _scDefaultEff = Just
+    , _scDefaultEff = return . Just
     , _scOptionFlag = GameOverOptions
     }
 
 pauseMenu :: ScreenLayer
-pauseMenu = OptionScreen
-    { _scTitle = const "PAUSED"
-    , _scOptions = pauseMenuOptions
-    , _scDefaultEff = unpause
-    , _scOptionFlag = NormalOptions
-    }
+pauseMenu = titleOptionsEff "PAUSED" pauseMenuOptions (return . unpause)
+
 pauseMenuOptions :: [MenuOption]
 pauseMenuOptions =
     [ Toggle ScancodeN startNewGame (const "NEW LEVEL")