86 lines
2.8 KiB
Haskell
86 lines
2.8 KiB
Haskell
module Dodge.Save (
|
|
saveWorldInSlot,
|
|
loadSaveSlot,
|
|
doQuicksave,
|
|
doQuickload,
|
|
-- saveLevelStartSlot,
|
|
writeSaveSlot,
|
|
readSaveSlot,
|
|
reloadLevelStart,
|
|
) where
|
|
|
|
|
|
import Control.Monad
|
|
import Data.Maybe
|
|
import Dodge.WorldLoad
|
|
import Dodge.Path.Translate
|
|
import Data.Graph.Inductive (labEdges, labNodes)
|
|
import Dodge.Zoning.Pathing
|
|
import Data.Foldable
|
|
import Dodge.Wall.Zone
|
|
import Dodge.Concurrent
|
|
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 qualified Data.ByteString as BSS
|
|
import Dodge.Data.Universe
|
|
--import qualified Data.Set as S
|
|
import System.Directory
|
|
--import Data.Sequence ((|>))
|
|
|
|
|
|
writeSaveSlot :: SaveSlot -> Universe -> IO (Universe -> Maybe Universe)
|
|
writeSaveSlot ss u = do
|
|
putStrLn $ "Saving " ++ saveSlotPath ss
|
|
createDirectoryIfMissing True "generated/saves"
|
|
BS.writeFile (saveSlotPath ss) $
|
|
--AEP.encodePretty'
|
|
-- (AEP.Config (AEP.Spaces 2) compare AEP.Generic False)
|
|
encode
|
|
(u ^. uvWorld . cWorld)
|
|
return Just
|
|
|
|
readSaveSlot :: SaveSlot -> IO (Universe -> Maybe Universe)
|
|
readSaveSlot ss = do
|
|
fExists <- doesFileExist $ saveSlotPath ss
|
|
unless fExists $ error "Tried to read non-existant save file"
|
|
mcw <- decodeFileStrict $ saveSlotPath ss
|
|
flip (maybe (error "Tried to read incorrectly encoded save file")) mcw $ \cw ->
|
|
return $ \uv -> Just
|
|
$ uv & uvWorld . cWorld .~ cw
|
|
& uvWorld %~ initWallZoning
|
|
& uvWorld . pnZoning .~ foldl' (flip zonePn) mempty
|
|
(labNodes $ path uv)
|
|
& uvWorld . peZoning .~ foldl' (flip zonePe) mempty
|
|
(map fromEdgeTuple $ labEdges $ path uv)
|
|
& uvScreenLayers .~ []
|
|
& postUniverseLoadSideEffect
|
|
where
|
|
path uv = uv ^. uvWorld . cWorld . pathGraph
|
|
|
|
saveSlotPath :: SaveSlot -> String
|
|
saveSlotPath (SaveSlotNum i) = "generated/saves/" ++ show i
|
|
saveSlotPath QuicksaveSlot = "generated/saves/QuickSave"
|
|
saveSlotPath (LevelStartSlot i) = "generated/saves/LevelStart" ++ show i
|
|
|
|
saveWorldInSlot :: SaveSlot -> Universe -> Universe
|
|
saveWorldInSlot slot u = u & addSideEffect (writeSaveSlot slot u) "SAVING"
|
|
|
|
reloadLevelStart :: Universe -> Universe
|
|
reloadLevelStart = loadSaveSlot (LevelStartSlot 0)
|
|
|
|
loadSaveSlot :: SaveSlot -> Universe -> Universe
|
|
loadSaveSlot slot = blockingLoad ("DESERIALISING "++ show slot) $ readSaveSlot slot
|
|
|
|
doQuicksave :: Universe -> Universe
|
|
doQuicksave u = u
|
|
& uvRAMSave ?~ _uvWorld u
|
|
& saveWorldInSlot QuicksaveSlot
|
|
|
|
doQuickload :: Universe -> Universe
|
|
doQuickload u = fromMaybe (loadSaveSlot QuicksaveSlot u) $ do
|
|
w <- u ^. uvRAMSave
|
|
return $ u & uvWorld .~ w
|