Cleanup menu options

src/Dodge/Data.hs

@@ -237,9 +237,9 @@ data ScreenLayer
         }
 data MenuOption 
     = Toggle
-        { _moKey    :: Scancode
+        { _moEff    :: Universe -> IO (Maybe Universe)
-        , _moEff    :: Universe -> IO (Maybe Universe)
         , _moString :: Universe -> Either String (String,String)
+        , _moKey    :: Scancode
         }
     | Toggle2
         { _moKey1   :: Scancode

src/Dodge/Menu.hs

@@ -33,13 +33,15 @@ slTitleOptionsEff title ops eff = OptionScreen
 pauseMenu :: ScreenLayer
 pauseMenu = slTitleOptionsEff "PAUSED" pauseMenuOptions (return . unpause)
 pauseMenuOptions :: [MenuOption]
-pauseMenuOptions =
+pauseMenuOptions = basicKeyOptions
-    [ Toggle ScancodeN (return . Just . startNewGame) (opText "NEW LEVEL")
+    [ Toggle (return . Just . startNewGame) (opText "NEW LEVEL")
-    , Toggle ScancodeR (return . Just . loadSaveSlot LevelStartSlot) (opText "RESTART")
+    , Toggle (return . Just . loadSaveSlot LevelStartSlot) (opText "RESTART")
-    , Toggle ScancodeS (pushScreen $ seedStartMenu "START FROM SEED") (opText "START FROM SEED")
+    , Toggle (pushScreen $ seedStartMenu "START FROM SEED") (opText "START FROM SEED")
-    , Toggle ScancodeO (pushScreen optionMenu ) (opText "OPTIONS")
+    , Toggle (pushScreen optionMenu ) (opText "OPTIONS")
-    , Toggle ScancodeC (pushScreen displayControls) (opText "CONTROLS")
+    , Toggle (pushScreen displayControls) (opText "CONTROLS")
-    , InvisibleToggle ScancodeEscape (return . const Nothing)
+    ]
+    ++
+    [ InvisibleToggle ScancodeEscape (return . const Nothing)
     ]
   where
     opText = const . Left
@@ -47,7 +49,7 @@ seedStartMenu :: String -> ScreenLayer
 seedStartMenu str = slTitleOptionsEff str seedStartOptions popScreen
 seedStartOptions :: [MenuOption]
 seedStartOptions =
-    [ Toggle ScancodeP trySeedFromClipboard (const $ Left "PASTE NUMBER FROM CLIPBOARD")
+    [ Toggle trySeedFromClipboard (const $ Left "PASTE NUMBER FROM CLIPBOARD") ScancodeA
 --    , Toggle ScancodeI (return . Just . loadSaveSlot LevelStartSlot) (const "INSERT NUMBER")
     ]
 
@@ -66,11 +68,11 @@ optionMenu :: ScreenLayer
 optionMenu = slTitleOptionsEff "OPTIONS" optionsOptions popScreen
 
 optionsOptions :: [MenuOption]
-optionsOptions =
+optionsOptions = basicKeyOptions
-    [ makeSubmenuOption ScancodeV soundMenu      $ Left "VOLUME"
+    [ makeSubmenuOption soundMenu      $ Left "VOLUME"
-    , makeSubmenuOption ScancodeG graphicsMenu   $ Left "GRAPHICS"
+    , makeSubmenuOption graphicsMenu   $ Left "GRAPHICS"
-    , makeSubmenuOption ScancodeP gameplayMenu   $ Left "GAMEPLAY"
+    , makeSubmenuOption gameplayMenu   $ Left "GAMEPLAY"
-    , makeSubmenuOption ScancodeD debugMenu      $ Left "DEBUG OPTIONS"
+    , makeSubmenuOption debugMenu      $ Left "DEBUG OPTIONS"
     ]
 debugMenu :: ScreenLayer
 debugMenu = slTitleOptions
@@ -78,31 +80,29 @@ debugMenu = slTitleOptions
     debugMenuOptions
 debugMenuOptions :: [MenuOption]
 debugMenuOptions = zipWith ($)
-    [ doption debug_seconds_frame "SHOW SECONDS/FRAME" _debug_seconds_frame
+    [ makeBoolOption debug_seconds_frame "SHOW SECONDS/FRAME" 
-    , doption debug_noclip "NOCLIP" _debug_noclip
+    , makeBoolOption debug_noclip "NOCLIP" 
-    , doption debug_cr_status "SHOW CREATURE STATUS" _debug_cr_status
+    , makeBoolOption debug_cr_status "SHOW CREATURE STATUS" 
-    , doption debug_cr_awareness "SHOW CREATURE AWARENESS" _debug_cr_awareness
+    , makeBoolOption debug_cr_awareness "SHOW CREATURE AWARENESS" 
-    , doption debug_view_boundaries "SHOW VIEW BOUNDARIES" _debug_view_boundaries
+    , makeBoolOption debug_view_boundaries "SHOW VIEW BOUNDARIES" 
-    , \sc -> makeEnumOption sc debug_view_clip_bounds "SHOW ROOM CLIP" return
+    , makeEnumOption debug_view_clip_bounds "SHOW ROOM CLIP" return
-    , doption debug_pathing "SHOW PATHING" _debug_pathing
+    , makeBoolOption debug_pathing "SHOW PATHING" 
-    , doption debug_show_sound     "SHOW VISUAL SOUNDS" _debug_show_sound
+    , makeBoolOption debug_show_sound     "SHOW VISUAL SOUNDS" 
-    , doption debug_mouse_position    "SHOW MOUSE POSITION" _debug_mouse_position
+    , makeBoolOption debug_mouse_position    "SHOW MOUSE POSITION" 
-    --, doption debug_walls "SHOW WALL INFO" _debug_walls
+    , makeBoolOption debug_walls "SHOW WALL INFO"
-    , \sc -> makeBoolOption sc debug_walls "SHOW WALL INFO"
     ]
     $ map Scancode [4 ..]
-  where
-    doption l t rec scode
-        = Toggle scode (return . Just . (config . l %~ not)) (\w -> Right (t ,show (rec $ _config w)))
 gameplayMenu :: ScreenLayer
 gameplayMenu  = slTitleOptions
     "OPTIONS:GAMEPLAY"
     gameplayMenuOptions
 
 gameplayMenuOptions :: [MenuOption]
-gameplayMenuOptions =
+gameplayMenuOptions = basicKeyOptions
-    [ makeBoolOption ScancodeR gameplay_rotate_to_wall "ROTATE TO WALL"
+    [ makeBoolOption gameplay_rotate_to_wall "ROTATE TO WALL"
     ]
+basicKeyOptions :: [Scancode -> c] -> [c]
+basicKeyOptions xs = zipWith ($) xs $ map Scancode [4 .. ]
 
 soundMenu :: ScreenLayer
 soundMenu = slTitleOptions
@@ -134,11 +134,11 @@ graphicsMenu :: ScreenLayer
 graphicsMenu = slTitleOptions "OPTIONS:GRAPHICS" graphicsMenuOptions
 
 graphicsMenuOptions :: [MenuOption]
-graphicsMenuOptions =
+graphicsMenuOptions = basicKeyOptions
-    [ makeEnumOption ScancodeS graphics_resolution_factor "RESOLUTION"    updateFramebufferSize
+    [ makeEnumOption graphics_resolution_factor "RESOLUTION"    updateFramebufferSize
-    , makeBoolOption ScancodeW graphics_wall_textured     "WALL TEXTURES"
+    , makeBoolOption graphics_wall_textured     "WALL TEXTURES"
-    , makeBoolOption ScancodeO graphics_object_shadows    "OBJECT SHADOWS"
+    , makeBoolOption graphics_object_shadows    "OBJECT SHADOWS"
-    , makeBoolOption ScancodeC graphics_cloud_shadows     "CLOUD SHADOWS"
+    , makeBoolOption graphics_cloud_shadows     "CLOUD SHADOWS"
     ]
 
 gameOverMenu :: ScreenLayer

src/Dodge/Menu/OptionType.hs

@@ -4,17 +4,15 @@ import Dodge.Data
 import Dodge.Menu.PushPop
 import Control.Lens
 
-makeBoolOption scode lns t = Toggle
+makeBoolOption lns t = Toggle
-    scode 
     (return . Just . (config . lns #%~ not)) 
     (\u -> Right (t , show (u ^# config . lns)))
 
-makeEnumOption scode lns str sideeff = Toggle
+makeEnumOption lns str sideeff = Toggle
-    scode
     (\u -> Just <$> sideeff (u & config . lns #%~ cycleEnum) )
     (\u -> Right (str , show (u ^# config . lns)) )
 
-makeSubmenuOption scode submenu t = Toggle scode (pushScreen submenu) (const t)
+makeSubmenuOption submenu t = Toggle (pushScreen submenu) (const t)
 
 cycleEnum :: (Eq a, Enum a,Bounded a) => a -> a
 cycleEnum x