Cleanup menu options

2022-05-25 23:06:47 +01:00
parent ba80bfd0ad
commit 34612822ae
3 changed files with 39 additions and 41 deletions
@@ -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
@@ -33,13 +33,15 @@ slTitleOptionsEff title ops eff = OptionScreen
 pauseMenu :: ScreenLayer
 pauseMenu = slTitleOptionsEff "PAUSED" pauseMenuOptions (return . unpause)
 pauseMenuOptions :: [MenuOption]
-pauseMenuOptions =
-    [ Toggle ScancodeN (return . Just . startNewGame) (opText "NEW LEVEL")
-    , Toggle ScancodeR (return . Just . loadSaveSlot LevelStartSlot) (opText "RESTART")
-    , Toggle ScancodeS (pushScreen $ seedStartMenu "START FROM SEED") (opText "START FROM SEED")
-    , Toggle ScancodeO (pushScreen optionMenu ) (opText "OPTIONS")
-    , Toggle ScancodeC (pushScreen displayControls) (opText "CONTROLS")
-    , InvisibleToggle ScancodeEscape (return . const Nothing)
+pauseMenuOptions = basicKeyOptions
+    [ Toggle (return . Just . startNewGame) (opText "NEW LEVEL")
+    , Toggle (return . Just . loadSaveSlot LevelStartSlot) (opText "RESTART")
+    , Toggle (pushScreen $ seedStartMenu "START FROM SEED") (opText "START FROM SEED")
+    , Toggle (pushScreen optionMenu ) (opText "OPTIONS")
+    , Toggle (pushScreen displayControls) (opText "CONTROLS")
+    ]
+    ++
+    [ 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 =
-    [ makeSubmenuOption ScancodeV soundMenu      $ Left "VOLUME"
-    , makeSubmenuOption ScancodeG graphicsMenu   $ Left "GRAPHICS"
-    , makeSubmenuOption ScancodeP gameplayMenu   $ Left "GAMEPLAY"
-    , makeSubmenuOption ScancodeD debugMenu      $ Left "DEBUG OPTIONS"
+optionsOptions = basicKeyOptions
+    [ makeSubmenuOption soundMenu      $ Left "VOLUME"
+    , makeSubmenuOption graphicsMenu   $ Left "GRAPHICS"
+    , makeSubmenuOption gameplayMenu   $ Left "GAMEPLAY"
+    , 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
-    , doption debug_noclip "NOCLIP" _debug_noclip
-    , doption debug_cr_status "SHOW CREATURE STATUS" _debug_cr_status
-    , doption debug_cr_awareness "SHOW CREATURE AWARENESS" _debug_cr_awareness
-    , doption debug_view_boundaries "SHOW VIEW BOUNDARIES" _debug_view_boundaries
-    , \sc -> makeEnumOption sc debug_view_clip_bounds "SHOW ROOM CLIP" return
-    , doption debug_pathing "SHOW PATHING" _debug_pathing
-    , doption debug_show_sound     "SHOW VISUAL SOUNDS" _debug_show_sound
-    , doption debug_mouse_position    "SHOW MOUSE POSITION" _debug_mouse_position
-    --, doption debug_walls "SHOW WALL INFO" _debug_walls
-    , \sc -> makeBoolOption sc debug_walls "SHOW WALL INFO"
+    [ makeBoolOption debug_seconds_frame "SHOW SECONDS/FRAME" 
+    , makeBoolOption debug_noclip "NOCLIP" 
+    , makeBoolOption debug_cr_status "SHOW CREATURE STATUS" 
+    , makeBoolOption debug_cr_awareness "SHOW CREATURE AWARENESS" 
+    , makeBoolOption debug_view_boundaries "SHOW VIEW BOUNDARIES" 
+    , makeEnumOption debug_view_clip_bounds "SHOW ROOM CLIP" return
+    , makeBoolOption debug_pathing "SHOW PATHING" 
+    , makeBoolOption debug_show_sound     "SHOW VISUAL SOUNDS" 
+    , makeBoolOption debug_mouse_position    "SHOW MOUSE POSITION" 
+    , makeBoolOption 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 =
-    [ makeBoolOption ScancodeR gameplay_rotate_to_wall "ROTATE TO WALL"
+gameplayMenuOptions = basicKeyOptions
+    [ 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 =
-    [ makeEnumOption ScancodeS graphics_resolution_factor "RESOLUTION"    updateFramebufferSize
-    , makeBoolOption ScancodeW graphics_wall_textured     "WALL TEXTURES"
-    , makeBoolOption ScancodeO graphics_object_shadows    "OBJECT SHADOWS"
-    , makeBoolOption ScancodeC graphics_cloud_shadows     "CLOUD SHADOWS"
+graphicsMenuOptions = basicKeyOptions
+    [ makeEnumOption graphics_resolution_factor "RESOLUTION"    updateFramebufferSize
+    , makeBoolOption graphics_wall_textured     "WALL TEXTURES"
+    , makeBoolOption graphics_object_shadows    "OBJECT SHADOWS"
+    , makeBoolOption graphics_cloud_shadows     "CLOUD SHADOWS"
    ]

 gameOverMenu :: ScreenLayer
@@ -4,17 +4,15 @@ import Dodge.Data
 import Dodge.Menu.PushPop
 import Control.Lens

-makeBoolOption scode lns t = Toggle
-    scode 
+makeBoolOption lns t = Toggle
    (return . Just . (config . lns #%~ not)) 
    (\u -> Right (t , show (u ^# config . lns)))

-makeEnumOption scode lns str sideeff = Toggle
-    scode
+makeEnumOption lns str sideeff = Toggle
    (\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