module Dodge.Save ( saveWorldInSlot, loadSaveSlot, doQuicksave, -- saveLevelStartSlot, writeSaveSlot, readSaveSlot, reloadLevelStart, ) where 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 "saveSlot" 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 if fExists then do cwstr <- decodeFileStrict $ saveSlotPath ss case cwstr of Nothing -> putStrLn "loadSaveSlot failed to read saved file" >> return removescreenlayers Just cw -> return $ \uv -> Just $ uv & uvWorld . cWorld .~ cw & uvScreenLayers .~ [] else putStrLn "loadSaveSlot failed to find saved file" >> return removescreenlayers where removescreenlayers = Just . (uvScreenLayers .~ []) 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 & uvSideEffects %~ (|> NewSideEffect (writeSaveSlot slot u) "SAVING") saveWorldInSlot slot u = u & addSideEffect (writeSaveSlot slot u) "SAVING" reloadLevelStart :: Universe -> Universe reloadLevelStart = loadSaveSlot (LevelStartSlot 0) loadSaveSlot :: SaveSlot -> Universe -> Universe loadSaveSlot slot = addSideEffect (readSaveSlot slot) "LOADING" 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) . )