justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Remove a lot of IO/maybe cruft

Browse Source
This commit is contained in:
justin
2022-10-30 16:11:30 +00:00
parent 624a4c3bcd
commit 219379393e
9 changed files with 85 additions and 93 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Menu.hs
+25 -27
View File
@@ -25,20 +25,20 @@ import Data.Maybe
splashMenu :: ScreenLayer
splashMenu =
slTitleOptionsEff "AMNESIS" splashMenuOptions (return . Just)
slTitleOptionsEff "AMNESIS" splashMenuOptions id
& scOptionFlag .~ SplashOptions
splashMenuOptions :: [MenuOption]
splashMenuOptions =
basicKeyOptions
[ Toggle (return . Just . loadSaveSlot (SaveSlotNum 0)) displaycontinue
, Toggle (return . Just . startNewGameInSlot 0) (opText "NEW WITH RANDOM SEED")
, Toggle (return . Just . reloadLevelStart) (displaywhenseed "NEW WITH LAST SEED")
[ Toggle ( loadSaveSlot (SaveSlotNum 0)) displaycontinue
, Toggle ( startNewGameInSlot 0) (opText "NEW WITH RANDOM SEED")
, Toggle ( reloadLevelStart) (displaywhenseed "NEW WITH LAST SEED")
, Toggle (pushScreen $ seedStartMenu "START FROM SEED") (opText "NEW WITH SPECIFIC SEED")
, Toggle (pushScreen optionMenu) (opText "OPTIONS")
, Toggle (pushScreen displayControls) (opText "VIEW CONTROLS")
, Toggle (return . Just) (displaywhenseed "VIEW LAST SEED")
, Toggle (return . const Nothing) (opText "QUIT")
, Toggle (id) (displaywhenseed "VIEW LAST SEED")
, Toggle (id) (opText "QUIT")
]
where
opText = const . MODString
@@ -48,30 +48,27 @@ splashMenuOptions =
| otherwise = MODString str
pauseMenu :: ScreenLayer
pauseMenu = slTitleOptionsEff "PAUSED" pauseMenuOptions (return . unpause)
pauseMenu = slTitleOptionsEff "PAUSED" pauseMenuOptions (unpause)
pauseMenuOptions :: [MenuOption]
pauseMenuOptions =
basicKeyOptions
[ Toggle popScreen (opText "CONTINUE")
, Toggle (return . Just . startNewGameInSlot 0) (opText "NEW GAME")
, Toggle (return . Just . reloadLevelStart) (opText "RESTART")
, Toggle (startNewGameInSlot 0) (opText "NEW GAME")
, Toggle (reloadLevelStart) (opText "RESTART")
, Toggle (pushScreen $ seedStartMenu "START FROM SEED") (opText "NEW FROM SEED")
, Toggle (pushScreen optionMenu) (opText "OPTIONS")
, Toggle (pushScreen displayControls) (opText "VIEW CONTROLS")
, Toggle (return . Just) (opText "VIEW CURRENT SEED")
, Toggle id (opText "VIEW CURRENT SEED")
, Toggle saveQuit (opText "SAVE AND QUIT")
]
++ [ InvisibleToggle ScancodeEscape (return . const Nothing)
++ [ InvisibleToggle ScancodeEscape id
]
where
opText = const . MODString
saveQuit :: Universe -> IO (Maybe Universe)
saveQuit u =
return $
Just $
u & addSideEffect (saveQuitConc u) "SAVING"
saveQuit :: Universe -> Universe
saveQuit u = u & addSideEffect (saveQuitConc u) "SAVING"
saveQuitConc :: Universe -> IO (Universe -> Maybe Universe)
saveQuitConc u = do
@@ -83,19 +80,19 @@ seedStartMenu str = slTitleOptionsEff str seedStartOptions popScreen
seedStartOptions :: [MenuOption]
seedStartOptions =
[ Toggle trySeedFromClipboard (const $ MODString "PASTE NUMBER FROM CLIPBOARD") ScancodeA
[ Toggle (uvIOEffects .~ trySeedFromClipboard) (const $ MODString "PASTE NUMBER FROM CLIPBOARD") ScancodeA
-- , Toggle ScancodeI (return . Just . loadSaveSlot LevelStartSlot) (const "INSERT NUMBER")
]
trySeedFromClipboard :: Universe -> IO (Maybe Universe)
trySeedFromClipboard :: Universe -> IO Universe
trySeedFromClipboard u = do
mcstr <- getClipboardString
case mcstr >>= readMaybe of
Nothing ->
pushScreen
return $ pushScreen
(seedStartMenu "CLIPBOARD UNUSABLE, NEED INTEGER")
(u & uvScreenLayers %~ tail)
Just i -> return . Just $ startSeedGame 0 i u
Just i -> return $ startSeedGame 0 i u
slTitleOptions :: String -> [MenuOption] -> ScreenLayer
slTitleOptions title ops = slTitleOptionsEff title ops (popScreen . writeConfig)
@@ -122,13 +119,13 @@ debugMenuOptions :: [MenuOption]
debugMenuOptions =
zipWith
($)
(map f [minBound ..] ++ [makeEnumOption debug_view_clip_bounds "SHOW ROOM CLIP" return])
(map f [minBound ..] ++ [makeEnumOption debug_view_clip_bounds "SHOW ROOM CLIP" id])
$ map Scancode [4 ..]
where
f :: DebugBool -> Scancode -> MenuOption
f bd =
Toggle
(return . Just . (uvConfig . debug_booleans . at bd %~ toggleJust))
((uvConfig . debug_booleans . at bd %~ toggleJust))
(uncurry MODStringOption . g bd . (^? uvConfig . debug_booleans . ix bd))
g bd Nothing = (show bd, "False")
g bd _ = (show bd, "True")
@@ -182,7 +179,8 @@ soundMenuOptions =
scod2
(change inc stype)
(\w -> MODStringOption str (leftPad 2 '.' $ show (round $ 10 * voltype (_uvConfig w) :: Int)))
change g vt uv = sw uv >> return (Just $ uv & uvConfig . vt %~ g)
change g vt uv = uv & uvConfig . vt %~ g
& uvIOEffects .~ \u -> sw uv >> return u
dec x = max 0 (x - 0.1)
inc x = min 1 (x + 0.1)
sw w = setVol (_uvConfig w)
@@ -196,7 +194,7 @@ graphicsMenu = slTitleOptions "OPTIONS:GRAPHICS" graphicsMenuOptions
graphicsMenuOptions :: [MenuOption]
graphicsMenuOptions =
basicKeyOptions
[ makeEnumOption graphics_resolution_factor "RESOLUTION" updateFramebufferSize
[ makeEnumOption graphics_resolution_factor "RESOLUTION" (uvIOEffects .~ updateFramebufferSize)
, makeBoolOption graphics_wall_textured "WALL TEXTURES"
, makeBoolOption graphics_object_shadows "OBJECT SHADOWS"
, makeBoolOption graphics_cloud_shadows "CLOUD SHADOWS"
@@ -204,7 +202,7 @@ graphicsMenuOptions =
gameOverMenu :: ScreenLayer
gameOverMenu =
slTitleOptionsEff "GAME OVER" pauseMenuOptions (return . Just)
slTitleOptionsEff "GAME OVER" pauseMenuOptions id
& scOptionFlag .~ GameOverOptions
-- OptionScreen
@@ -218,8 +216,8 @@ gameOverMenu =
--charToScode :: Char -> Scancode
--charToScode = Scancode . fromIntegral . (\x -> x - 61) . fromEnum
unpause :: Universe -> Maybe Universe
unpause w = Just . resumeSound $ w & uvScreenLayers .~ []
unpause :: Universe -> Universe
unpause w = resumeSound $ w & uvScreenLayers .~ []
displayControls :: ScreenLayer
displayControls = ColumnsScreen (const "CONTROLS") listControls