From 34612822ae3d75aaaf54e73210ae2183b45a0c1f Mon Sep 17 00:00:00 2001 From: justin Date: Wed, 25 May 2022 23:06:47 +0100 Subject: [PATCH] Cleanup menu options --- src/Dodge/Data.hs | 4 +-- src/Dodge/Menu.hs | 68 ++++++++++++++++++------------------ src/Dodge/Menu/OptionType.hs | 8 ++--- 3 files changed, 39 insertions(+), 41 deletions(-) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index db2103e1d..ba785422d 100644 --- a/src/Dodge/Data.hs +++ b/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 diff --git a/src/Dodge/Menu.hs b/src/Dodge/Menu.hs index 6e3b62279..636059c8f 100644 --- a/src/Dodge/Menu.hs +++ b/src/Dodge/Menu.hs @@ -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 diff --git a/src/Dodge/Menu/OptionType.hs b/src/Dodge/Menu/OptionType.hs index 0e8163553..f8bf5715c 100644 --- a/src/Dodge/Menu/OptionType.hs +++ b/src/Dodge/Menu/OptionType.hs @@ -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