Work on saving/loading concurrently

src/Dodge/Menu.hs

@@ -1,11 +1,14 @@
 module Dodge.Menu (
-    scodeToChar,
     pauseMenu,
     gameOverMenu,
+    splashMenu,
 ) where
 
+import Control.Monad
+import Dodge.Concurrent
 import Dodge.Config.Update
 import Dodge.Data.Universe
+import Dodge.Menu.Option
 import Dodge.Menu.OptionType
 import Dodge.Menu.PushPop
 import Dodge.PreloadData
@@ -19,15 +22,25 @@ import SDL
 import System.Clipboard
 import Text.Read
 
-slTitleOptionsEff :: String -> [MenuOption] -> (Universe -> IO (Maybe Universe)) -> ScreenLayer
-slTitleOptionsEff title ops eff =
-    OptionScreen
-        { _scTitle = const title
-        , _scOptions = ops
-        , _scDefaultEff = eff
-        , _scOptionFlag = NormalOptions
-        , _scOptionsOffset = 0
-        }
+splashMenu :: ScreenLayer
+splashMenu =
+    slTitleOptionsEff "AMNESIS" splashMenuOptions (return . Just)
+        & scOptionFlag .~ SplashOptions
+
+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 (pushScreen optionMenu) (opText "OPTIONS")
+        , Toggle (pushScreen displayControls) (opText "VIEW CONTROLS")
+        , Toggle (return . Just) (opText "VIEW CURRENT SEED")
+        , Toggle (return . const Nothing) (opText "QUIT")
+        ]
+  where
+    opText = const . Left
 
 pauseMenu :: ScreenLayer
 pauseMenu = slTitleOptionsEff "PAUSED" pauseMenuOptions (return . unpause)
@@ -35,17 +48,31 @@ pauseMenu = slTitleOptionsEff "PAUSED" pauseMenuOptions (return . unpause)
 pauseMenuOptions :: [MenuOption]
 pauseMenuOptions =
     basicKeyOptions
-        [ Toggle (return . Just . startNewGame) (opText "NEW LEVEL")
+        [ Toggle popScreen (opText "CONTINUE")
+        , Toggle (return . Just . startNewGameInSlot 0) (opText "NEW GAME")
         , Toggle (return . Just . reloadLevelStart) (opText "RESTART")
-        , Toggle (pushScreen $ seedStartMenu "START FROM SEED") (opText "START FROM SEED")
+        , Toggle (pushScreen $ seedStartMenu "START FROM SEED") (opText "NEW FROM SEED")
         , Toggle (pushScreen optionMenu) (opText "OPTIONS")
-        , Toggle (pushScreen displayControls) (opText "CONTROLS")
+        , Toggle (pushScreen displayControls) (opText "VIEW CONTROLS")
+        , Toggle (return . Just) (opText "VIEW CURRENT SEED")
+        , Toggle saveQuit (opText "SAVE AND QUIT")
         ]
         ++ [ InvisibleToggle ScancodeEscape (return . const Nothing)
            ]
   where
     opText = const . Left
 
+saveQuit :: Universe -> IO (Maybe Universe)
+saveQuit u =
+    return $
+        Just $
+            u & tryConcEffect True "SAVING" (saveQuitConc u)
+
+saveQuitConc :: Universe -> IO (Universe -> Maybe Universe)
+saveQuitConc u = do
+    void $ writeSaveSlot (SaveSlotNum 0) u
+    return $ const Nothing
+
 seedStartMenu :: String -> ScreenLayer
 seedStartMenu str = slTitleOptionsEff str seedStartOptions popScreen
 
@@ -62,7 +89,7 @@ trySeedFromClipboard u = do
         Nothing ->
             pushScreen
                 (seedStartMenu "CLIPBOARD UNUSABLE, NEED INTEGER")
-                (u & menuLayers %~ tail)
+                (u & uvScreenLayers %~ tail)
         Just i -> return . Just $ startSeedGame 0 i u
 
 slTitleOptions :: String -> [MenuOption] -> ScreenLayer
@@ -172,23 +199,22 @@ graphicsMenuOptions =
 
 gameOverMenu :: ScreenLayer
 gameOverMenu =
-    OptionScreen
-        { _scTitle = const "GAME OVER"
-        , _scOptions = pauseMenuOptions
-        , _scDefaultEff = return . Just
-        , _scOptionFlag = GameOverOptions
-        , _scOptionsOffset = 0
-        }
+    slTitleOptionsEff "GAME OVER" pauseMenuOptions (return . Just)
+        & scOptionFlag .~ GameOverOptions
 
--- | hacky - no longer used
-scodeToChar :: Scancode -> Char
-scodeToChar = toEnum . (+ 61) . fromIntegral . unwrapScancode
+--    OptionScreen
+--        { _scTitle = const "GAME OVER"
+--        , _scOptions = pauseMenuOptions
+--        , _scDefaultEff = return . Just
+--        , _scOptionFlag = GameOverOptions
+--        , _scOptionsOffset = 0
+--        }
 
 --charToScode :: Char -> Scancode
 --charToScode = Scancode . fromIntegral . (\x -> x - 61) . fromEnum
 
 unpause :: Universe -> Maybe Universe
-unpause w = Just . resumeSound $ w & menuLayers .~ []
+unpause w = Just . resumeSound $ w & uvScreenLayers .~ []
 
 displayControls :: ScreenLayer
 displayControls = ColumnsScreen (const "CONTROLS") listControls