Unify save states

src/Dodge/Data.hs

@@ -78,10 +78,8 @@ data World = World
     , _pathGraph            :: ~(Gr Point2 Float)
     , _pathGraphP           :: ~[(Point2,Point2)]
     , _pathPoints           :: ~(IM.IntMap (IM.IntMap [(Int,Point2)]))
-    , _storedLevel          :: Maybe World
+    , _savedWorlds          :: M.Map SaveSlot World
-    , _quicksaveLevel       :: Maybe World
     , _menuLayers           :: [ScreenLayer]
---    , _worldState           :: M.Map WorldState Bool
     , _worldTriggers        :: S.Set WorldTrigger
     , _carteDisplay         :: !Bool
     , _carteCenter          :: !Point2
@@ -103,6 +101,9 @@ data World = World
     , _frameClock           :: Int
     , _worldBounds          :: Bounds
     }
+data SaveSlot = QuicksaveSlot | LevelStartSlot
+  deriving (Eq,Ord)
+
 data OptionScreenFlag = NormalOptions | GameOverOptions
 data ScreenLayer
     = OptionScreen

src/Dodge/Default/World.hs

@@ -52,10 +52,8 @@ defaultWorld = World
     , _playingSounds = M.empty
     , _corpses = Zone IM.empty
     , _decorations = IM.empty
-    , _storedLevel = Nothing
+    , _savedWorlds = M.empty
-    , _quicksaveLevel = Nothing
     , _menuLayers = []
---    , _worldState = M.empty
     , _worldTriggers = S.empty
     , _clickMousePos = V2 0 0
     , _pathGraph = Data.Graph.Inductive.Graph.empty

src/Dodge/Event/Keyboard.hs

@@ -33,7 +33,7 @@ handleKeyboardEvent kev w = case keyboardEventKeyMotion kev of
 handlePressedKey :: Bool -> Scancode -> World -> Maybe World
 handlePressedKey True _     w   = Just w
 handlePressedKey _    ScancodeF5 w = Just $ doQuicksave w
-handlePressedKey _    ScancodeF9 w = Just $ maybe w doQuicksave (_quicksaveLevel w)
+handlePressedKey _    ScancodeF9 w = Just $ loadSaveSlot QuicksaveSlot w
 handlePressedKey _    ScancodeSemicolon w = Just $ gotoTerminal w
 handlePressedKey _    scode w
     | null (_menuLayers w)      = handlePressedKeyInGame scode w

src/Dodge/Initialisation.hs

@@ -50,13 +50,12 @@ initialWorld = defaultWorld
     , _mousePos = V2 0 0
     , _testString = testStringInit
     , _yourID = 0
-    , _worldEvents = storeLevel . soundStart BackgroundSound (V2 0 0) foamSprayFadeOutS Nothing 
+    , _worldEvents = saveWorldInEmptySlot LevelStartSlot . soundStart BackgroundSound (V2 0 0) foamSprayFadeOutS Nothing 
         . foldr ((.) . makeStartCloudAt) id [V3 x y 5 | x <- [-5,-3..5] , y <- [-5,-3..5]]
     , _pressPlates = IM.empty
     , _buttons = IM.empty
     , _toPlaySounds = M.empty
     , _decorations = IM.empty
-    , _storedLevel = Nothing
     , _menuLayers = [TerminalScreen 300 rezText']
     }
 testStringInit :: World -> [String]

src/Dodge/Menu.hs

@@ -151,7 +151,7 @@ pauseMenu = OptionScreen
 pauseMenuOptions :: [MenuOption]
 pauseMenuOptions =
     [ Toggle ScancodeN startNewGame (const "NEW LEVEL")
-    , Toggle ScancodeR (Just . loadStoredLevel) (const "RESTART")
+    , Toggle ScancodeR (Just . loadSaveSlot LevelStartSlot) (const "RESTART")
     , Toggle ScancodeO (pushScreen optionMenu ) (const "OPTIONS")
     , Toggle ScancodeC (pushScreen displayControls) (const "CONTROLS")
     , InvisibleToggle ScancodeEscape (const Nothing)

src/Dodge/Save.hs

@@ -1,25 +1,34 @@
 module Dodge.Save
-    ( storeLevel
+    ( saveWorldInEmptySlot
-    , loadStoredLevel
+    , loadSaveSlot
     , doQuicksave
     )
   where
 import Dodge.Data
 
+import qualified Data.Map.Strict as M
 import Data.Maybe
 import Control.Lens
 import qualified Data.Set as S
 
-storeLevel :: World -> World
+clearSaves :: World -> World
-storeLevel w = case _storedLevel w of
+clearSaves = savedWorlds .~ M.empty
-    Nothing -> w & storedLevel ?~ clearKeys w
+
+saveWorldInEmptySlot :: SaveSlot -> World -> World
+saveWorldInEmptySlot slot w = case M.lookup slot $ _savedWorlds w of
+    Nothing -> w & savedWorlds %~ M.insert slot (clearKeys w)
     _       -> w
 
-loadStoredLevel :: World -> World
+saveWorldInSlot :: SaveSlot -> World -> World
-loadStoredLevel w = fromMaybe w $ _storedLevel w <&> quicksaveLevel .~ _quicksaveLevel w
+saveWorldInSlot slot w = w & savedWorlds %~ M.insert slot (clearSaves $ clearKeys w)
+
+loadSaveSlot :: SaveSlot -> World -> World
+loadSaveSlot slot w = fromMaybe w 
+    $ M.lookup slot (_savedWorlds w) 
+        <&> savedWorlds .~ _savedWorlds w -- keep saves from current point, not from save point
 
 doQuicksave :: World -> World
-doQuicksave w = w & quicksaveLevel ?~ clearKeys w
+doQuicksave = saveWorldInSlot QuicksaveSlot
 
 clearKeys :: World -> World
 clearKeys = (keys .~ S.empty) . (mouseButtons .~ S.empty)