From f37d0f75c0b4a77c8e35192c24c6fdb6f2bc4619 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Fri, 29 Nov 2019 14:33:52 -0500 Subject: Implement saving+loading the game Implement ToJSON and FromJSON for all of the various pieces of the game state, and add a pair of functions saveGame/loadGame implementing a prism to save the game as zlib-compressed JSON. To test this, there's now Arbitrary, CoArbitrary, and Function instances for all the parts of the game state - to get around circular imports with the concrete entities this unfortunately is happening via orphan instances, plus an hs-boot file to break a circular import that was just a little too hard to remove by moving things around. Ugh. --- src/Xanthous/App.hs | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) (limited to 'src/Xanthous/App.hs') diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs index 2f27948cde..71bf40c427 100644 --- a/src/Xanthous/App.hs +++ b/src/Xanthous/App.hs @@ -8,12 +8,13 @@ import qualified Brick import Brick.Widgets.Edit (handleEditorEvent) import Graphics.Vty.Attributes (defAttr) import Graphics.Vty.Input.Events (Event(EvKey), Key(..)) -import Control.Monad.State (get, MonadState) +import Control.Monad.State (get, gets, MonadState) import Control.Monad.Random (MonadRandom) import Control.Monad.State.Class (modify) import Data.Aeson (object, ToJSON) import qualified Data.Aeson as A import qualified Data.Vector as V +import qualified Data.Yaml as Yaml import System.Exit -------------------------------------------------------------------------------- import Xanthous.Command @@ -23,7 +24,6 @@ import Xanthous.Data , positioned , Position , Ticks - , Position'(Position) , (|*|) ) import Xanthous.Data.EntityMap (EntityMap) @@ -192,6 +192,18 @@ handleCommand Eat = do stepGame -- TODO continue +handleCommand Save = do + -- TODO default save locations / config file? + prompt_ @'StringPrompt ["save", "location"] Cancellable + $ \(StringResult filename) -> do + src <- gets saveGame + lift . liftIO $ do + writeFile (unpack filename) $ toStrict src + exitSuccess + + continue + + handleCommand ToggleRevealAll = do val <- debugState . allRevealed <%= not say ["debug", "toggleRevealAll"] $ object [ "revealAll" A..= val ] -- cgit 1.4.1