From 1d9dd3e4e0d006ebce2b0ac04faec905d719bb1b Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 28 Nov 2021 14:42:08 +0000 Subject: [PATCH] Move saved worlds outside of world into universe --- appDodge/Main.hs | 1 + src/Dodge/Data.hs | 4 ++-- src/Dodge/Default/World.hs | 2 +- src/Dodge/Event/Keyboard.hs | 4 ++-- src/Dodge/Initialisation.hs | 6 +++--- src/Dodge/Menu.hs | 2 +- src/Dodge/Save.hs | 18 ++++++++---------- src/Dodge/Update.hs | 2 +- 8 files changed, 19 insertions(+), 20 deletions(-) diff --git a/appDodge/Main.hs b/appDodge/Main.hs index 7e16225da..391cfa145 100644 --- a/appDodge/Main.hs +++ b/appDodge/Main.hs @@ -62,6 +62,7 @@ firstWorldLoad theConfig = do & config .~ theConfig ,_preloadData = pdata ,_menuLayers = [] + ,_savedWorlds = M.empty } theUpdateStep :: Universe -> IO Universe diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 7dc4bf42e..845b40a4e 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -56,6 +56,7 @@ data Universe = Universe { _uvWorld :: World , _preloadData :: PreloadData , _menuLayers :: [ScreenLayer] + , _savedWorlds :: M.Map SaveSlot World } data World = World { _keys :: !(S.Set Scancode) @@ -116,7 +117,6 @@ data World = World , _gameRooms :: [GameRoom] -- consider using and IntMap , _keyConfig :: KeyConfigSDL , _config :: Configuration - , _savedWorlds :: M.Map SaveSlot World , _rewindWorlds :: [World] , _rewinding :: Bool , _frameClock :: Int @@ -131,7 +131,7 @@ data ScreenLayer = OptionScreen { _scTitle :: Universe -> String , _scOptions :: [MenuOption] - , _scDefaultEff :: Universe -> Maybe Universe + , _scDefaultEff :: Universe -> Maybe Universe -- IO (Maybe Universe)? , _scOptionFlag :: OptionScreenFlag } | ColumnsScreen String [(String,String)] diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 40381694b..df6d6294d 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -54,7 +54,7 @@ defaultWorld = World , _playingSounds = M.empty , _corpses = Zone IM.empty , _decorations = IM.empty - , _savedWorlds = M.empty + --, _savedWorlds = M.empty -- , _menuLayers = [] , _worldFlags = S.empty , _clickMousePos = V2 0 0 diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index 68f29aa3e..f473d35ca 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -33,8 +33,8 @@ handleKeyboardEvent kev u = case keyboardEventKeyMotion kev of handlePressedKey :: Bool -> Scancode -> Universe -> Maybe Universe handlePressedKey True _ w = Just w -handlePressedKey _ ScancodeF5 w = Just $ over uvWorld doQuicksave w -handlePressedKey _ ScancodeF9 w = Just $ over uvWorld (loadSaveSlot QuicksaveSlot) w +handlePressedKey _ ScancodeF5 w = Just $ doQuicksave w +handlePressedKey _ ScancodeF9 w = Just $ loadSaveSlot QuicksaveSlot w handlePressedKey _ ScancodeSemicolon w = Just $ gotoTerminal w handlePressedKey _ scode w | null (_menuLayers w) = uvWorld (handlePressedKeyInGame scode) w diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index 496b02daa..21cd471f6 100644 --- a/src/Dodge/Initialisation.hs +++ b/src/Dodge/Initialisation.hs @@ -3,7 +3,7 @@ import Dodge.Default.World import Dodge.Save import Dodge.Data import Dodge.Creature -import Dodge.Story +--import Dodge.Story import Dodge.WorldEvent.Cloud import Dodge.SoundLogic import Geometry.Data @@ -27,8 +27,8 @@ initialWorld = defaultWorld , _mousePos = V2 0 0 , _testString = testStringInit , _yourID = 0 - , _worldEvents = saveWorldInEmptySlot LevelStartSlot - . soundStart BackgroundSound (V2 0 0) foamSprayFadeOutS Nothing + , _sideEffects = return .saveWorldInEmptySlot LevelStartSlot + , _worldEvents = soundStart BackgroundSound (V2 0 0) foamSprayFadeOutS Nothing . foldr ((.) . makeStartCloudAt) id [V3 x y 5 | x <- [-5,-4..5] , y <- [-5,-4..5]] , _pressPlates = IM.empty , _buttons = IM.empty diff --git a/src/Dodge/Menu.hs b/src/Dodge/Menu.hs index 4a5e0b95e..f1e805c68 100644 --- a/src/Dodge/Menu.hs +++ b/src/Dodge/Menu.hs @@ -152,7 +152,7 @@ pauseMenu = OptionScreen pauseMenuOptions :: [MenuOption] pauseMenuOptions = [ Toggle ScancodeN startNewGame (const "NEW LEVEL") - , Toggle ScancodeR (uvWorld (Just . loadSaveSlot LevelStartSlot)) (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) diff --git a/src/Dodge/Save.hs b/src/Dodge/Save.hs index 5d99ea971..81b43fac2 100644 --- a/src/Dodge/Save.hs +++ b/src/Dodge/Save.hs @@ -11,23 +11,21 @@ import Data.Maybe import Control.Lens import qualified Data.Set as S -clearSaves :: World -> World +clearSaves :: Universe -> Universe clearSaves = savedWorlds .~ M.empty -saveWorldInEmptySlot :: SaveSlot -> World -> World +saveWorldInEmptySlot :: SaveSlot -> Universe -> Universe saveWorldInEmptySlot slot w = case M.lookup slot $ _savedWorlds w of - Nothing -> w & savedWorlds %~ M.insert slot (clearKeys w) + Nothing -> w & savedWorlds %~ M.insert slot (clearKeys (_uvWorld w)) _ -> w -saveWorldInSlot :: SaveSlot -> World -> World -saveWorldInSlot slot w = w & savedWorlds %~ M.insert slot (clearSaves $ clearKeys w) +saveWorldInSlot :: SaveSlot -> Universe -> Universe +saveWorldInSlot slot w = w & savedWorlds %~ M.insert slot (clearKeys (_uvWorld 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 +loadSaveSlot :: SaveSlot -> Universe -> Universe +loadSaveSlot slot u = maybe u (\w -> u & uvWorld .~ w) $ M.lookup slot (_savedWorlds u) -doQuicksave :: World -> World +doQuicksave :: Universe -> Universe doQuicksave = saveWorldInSlot QuicksaveSlot clearKeys :: World -> World diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index a651e41a9..ef8199a82 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -11,7 +11,7 @@ import Dodge.Hammer import Dodge.Block import Dodge.Distortion import Dodge.SoundLogic -import Dodge.Menu +--import Dodge.Menu import Dodge.Base import Dodge.Zone import Dodge.WallCreatureCollisions