74 lines
2.3 KiB
Haskell
74 lines
2.3 KiB
Haskell
module Dodge.Save (
|
|
saveWorldInSlot,
|
|
loadSaveSlot,
|
|
doQuicksave,
|
|
-- saveLevelStartSlot,
|
|
writeSaveSlot,
|
|
readSaveSlot,
|
|
reloadLevelStart,
|
|
) where
|
|
import Control.Lens
|
|
import Dodge.Data.SaveSlot
|
|
import Data.Aeson
|
|
import qualified Data.Aeson.Encode.Pretty as AEP
|
|
import qualified Data.ByteString.Lazy as BS
|
|
import Dodge.Data.Universe
|
|
--import qualified Data.Set as S
|
|
import System.Directory
|
|
|
|
writeSaveSlot :: SaveSlot -> Universe -> IO (Universe -> Universe)
|
|
writeSaveSlot ss u = do
|
|
createDirectoryIfMissing True "saveSlot"
|
|
BS.writeFile (saveSlotPath ss) $
|
|
AEP.encodePretty'
|
|
(AEP.Config (AEP.Spaces 2) compare AEP.Generic False)
|
|
(u ^. uvWorld . cWorld)
|
|
return id
|
|
|
|
--writeFile (saveSlotPath ss) (show $ u ^. uvWorld . cWorld)
|
|
|
|
readSaveSlot :: SaveSlot -> IO (Universe -> Universe)
|
|
readSaveSlot ss = do
|
|
fExists <- doesFileExist $ saveSlotPath ss
|
|
if fExists
|
|
then do
|
|
cwstr <- decodeFileStrict $ saveSlotPath ss
|
|
case cwstr of
|
|
Nothing -> putStrLn "loadSaveSlot failed to read saved file" >> return id
|
|
Just cw -> return $ \uv -> uv & uvWorld . cWorld .~ cw
|
|
else putStrLn "loadSaveSlot failed to find saved file" >> return id
|
|
|
|
saveSlotPath :: SaveSlot -> String
|
|
saveSlotPath (SaveSlotNum i) = "saveSlot/" ++ show i
|
|
saveSlotPath QuicksaveSlot = "saveSlot/QuickSave"
|
|
saveSlotPath (LevelStartSlot i) = "saveSlot/LevelStart" ++ show i
|
|
|
|
saveWorldInSlot :: SaveSlot -> Universe -> Universe
|
|
saveWorldInSlot slot u = u & uvConcEffects ?~
|
|
writeSaveSlot slot u
|
|
|
|
reloadLevelStart :: Universe -> Universe
|
|
reloadLevelStart u = case u ^. uvWorld . gameSlot of
|
|
GameNum i -> loadSaveSlot (LevelStartSlot i) u
|
|
_ -> u
|
|
|
|
loadSaveSlot :: SaveSlot -> Universe -> Universe
|
|
loadSaveSlot slot = (uvConcEffects ?~ readSaveSlot slot)
|
|
. (uvWorld . gameSlot .~ GameLoading slot)
|
|
-- maybe
|
|
-- u
|
|
-- (\w -> u & menuLayers .~ [] & uvWorld .~ w)
|
|
-- $ M.lookup slot (_savedWorlds u)
|
|
|
|
doQuicksave :: Universe -> Universe
|
|
doQuicksave = saveWorldInSlot QuicksaveSlot
|
|
|
|
--clearKeys :: World -> World
|
|
--clearKeys = (keys .~ mempty) . (mouseButtons .~ mempty)
|
|
|
|
--saveLevelStartSlot :: Universe -> Universe
|
|
----saveLevelStartSlot = id
|
|
--saveLevelStartSlot = saveWorldInSlot LevelStartSlot
|
|
|
|
--saveLevelStartSlot = sideEffects %~ (fmap (undefined) . )
|