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

Move towards serializing saves/loads faster

Browse Source
This commit is contained in:
justin
2022-08-19 11:12:43 +01:00
parent c74d3b04bf
commit 9df0fa8692
38 changed files with 542 additions and 384 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Menu.hs
+19 -14
View File
@@ -21,6 +21,7 @@ import Padding
import SDL
import System.Clipboard
import Text.Read
import Data.Maybe
splashMenu :: ScreenLayer
splashMenu =
@@ -30,17 +31,21 @@ splashMenu =
splashMenuOptions :: [MenuOption]
splashMenuOptions =
basicKeyOptions
[ Toggle (return . Just . loadSaveSlot (SaveSlotNum 0)) (opText "CONTINUE")
, Toggle (return . Just . startNewGameInSlot 0) (opText "NEW GAME")
, Toggle (return . Just . reloadLevelStart) (opText "RESTART")
, Toggle (pushScreen $ seedStartMenu "START FROM SEED") (opText "NEW FROM SEED")
[ 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 (pushScreen $ seedStartMenu "START FROM SEED") (opText "NEW WITH SPECIFIC SEED")
, Toggle (pushScreen optionMenu) (opText "OPTIONS")
, Toggle (pushScreen displayControls) (opText "VIEW CONTROLS")
, Toggle (return . Just) (opText "VIEW CURRENT SEED")
, Toggle (return . Just) (displaywhenseed "VIEW LAST SEED")
, Toggle (return . const Nothing) (opText "QUIT")
]
where
opText = const . Left
opText = const . MODString
displaycontinue u | _uvCanContinue u = MODString "CONTINUE"
| otherwise = MODBlockedString "CONTINUE"
displaywhenseed str u | isNothing (_uvMSeed u) = MODBlockedString str
| otherwise = MODString str
pauseMenu :: ScreenLayer
pauseMenu = slTitleOptionsEff "PAUSED" pauseMenuOptions (return . unpause)
@@ -60,7 +65,7 @@ pauseMenuOptions =
++ [ InvisibleToggle ScancodeEscape (return . const Nothing)
]
where
opText = const . Left
opText = const . MODString
saveQuit :: Universe -> IO (Maybe Universe)
saveQuit u =
@@ -78,7 +83,7 @@ seedStartMenu str = slTitleOptionsEff str seedStartOptions popScreen
seedStartOptions :: [MenuOption]
seedStartOptions =
[ Toggle trySeedFromClipboard (const $ Left "PASTE NUMBER FROM CLIPBOARD") ScancodeA
[ Toggle trySeedFromClipboard (const $ MODString "PASTE NUMBER FROM CLIPBOARD") ScancodeA
-- , Toggle ScancodeI (return . Just . loadSaveSlot LevelStartSlot) (const "INSERT NUMBER")
]
@@ -101,10 +106,10 @@ optionMenu = slTitleOptionsEff "OPTIONS" optionsOptions popScreen
optionsOptions :: [MenuOption]
optionsOptions =
basicKeyOptions
[ makeSubmenuOption soundMenu $ Left "VOLUME"
, makeSubmenuOption graphicsMenu $ Left "GRAPHICS"
, makeSubmenuOption gameplayMenu $ Left "GAMEPLAY"
, makeSubmenuOption debugMenu $ Left "DEBUG OPTIONS"
[ makeSubmenuOption soundMenu $ MODString "VOLUME"
, makeSubmenuOption graphicsMenu $ MODString "GRAPHICS"
, makeSubmenuOption gameplayMenu $ MODString "GAMEPLAY"
, makeSubmenuOption debugMenu $ MODString "DEBUG OPTIONS"
]
debugMenu :: ScreenLayer
@@ -124,7 +129,7 @@ debugMenuOptions =
f bd =
Toggle
(return . Just . (uvConfig . debug_booleans . at bd %~ toggleJust))
(Right . g bd . (^? uvConfig . debug_booleans . ix bd))
(uncurry MODStringOption . g bd . (^? uvConfig . debug_booleans . ix bd))
g bd Nothing = (show bd, "False")
g bd _ = (show bd, "True")
@@ -176,7 +181,7 @@ soundMenuOptions =
(change dec stype)
scod2
(change inc stype)
(\w -> Right (str, leftPad 2 '.' $ show (round $ 10 * voltype (_uvConfig w) :: Int)))
(\w -> MODStringOption str (leftPad 2 '.' $ show (round $ 10 * voltype (_uvConfig w) :: Int)))
change g vt uv = sw uv >> return (Just $ uv & uvConfig . vt %~ g)
dec x = max 0 (x - 0.1)
inc x = min 1 (x + 0.1)