feat(gs/xanthous): Allow disabling saving
Add a command-line parameter to disable the Save command, so people don't save and fill up my disk when I'm running this on the internet. Change-Id: I2408e60de2d99764ac53c21c3ea784282576d400 Reviewed-on: https://cl.tvl.fyi/c/depot/+/3808 Reviewed-by: grfn <grfn@gws.fyi> Tested-by: BuildkiteCI
This commit is contained in:
parent
e3724448a2
commit
9577d97a8f
4 changed files with 68 additions and 34 deletions
|
@ -1,3 +1,5 @@
|
|||
{-# LANGUAGE RecordWildCards #-}
|
||||
--------------------------------------------------------------------------------
|
||||
module Main ( main ) where
|
||||
--------------------------------------------------------------------------------
|
||||
import Xanthous.Prelude hiding (finally)
|
||||
|
@ -12,6 +14,7 @@ import System.Exit (die)
|
|||
--------------------------------------------------------------------------------
|
||||
import qualified Xanthous.Game as Game
|
||||
import Xanthous.Game.Env (GameEnv(..))
|
||||
import qualified Xanthous.Game.Env as Game
|
||||
import Xanthous.App
|
||||
import Xanthous.Generators.Level
|
||||
( GeneratorInput
|
||||
|
@ -26,9 +29,17 @@ import Xanthous.Data (Dimensions, Dimensions'(Dimensions))
|
|||
import Data.Array.IArray ( amap )
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
parseGameConfig :: Opt.Parser Game.Config
|
||||
parseGameConfig = Game.Config
|
||||
<$> Opt.switch
|
||||
( Opt.long "disable-saving"
|
||||
<> Opt.help "Disallow saving games"
|
||||
)
|
||||
|
||||
data RunParams = RunParams
|
||||
{ seed :: Maybe Int
|
||||
, characterName :: Maybe Text
|
||||
, gameConfig :: Game.Config
|
||||
}
|
||||
deriving stock (Show, Eq)
|
||||
|
||||
|
@ -46,6 +57,7 @@ parseRunParams = RunParams
|
|||
<> "will be prompted for at runtime"
|
||||
)
|
||||
))
|
||||
<*> parseGameConfig
|
||||
|
||||
data Command
|
||||
= Run RunParams
|
||||
|
@ -104,7 +116,7 @@ newGame rparams = do
|
|||
let initialState = Game.initialStateFromSeed gameSeed &~ do
|
||||
for_ (characterName rparams) $ \cn ->
|
||||
Game.character . Character.characterName ?= cn
|
||||
runGame NewGame initialState `finally` do
|
||||
runGame NewGame (gameConfig rparams) initialState `finally` do
|
||||
thanks
|
||||
when (isNothing $ seed rparams)
|
||||
. putStrLn
|
||||
|
@ -115,19 +127,19 @@ loadGame :: FilePath -> IO ()
|
|||
loadGame saveFile = do
|
||||
gameState <- maybe (die "Invalid save file!") pure . Game.loadGame . fromStrict
|
||||
=<< readFile @IO saveFile
|
||||
gameState `deepseq` runGame (LoadGame saveFile) gameState
|
||||
gameState `deepseq` runGame (LoadGame saveFile) Game.defaultConfig gameState
|
||||
|
||||
runGame :: RunType -> Game.GameState -> IO ()
|
||||
runGame rt gameState = do
|
||||
eventChan <- Brick.BChan.newBChan 10
|
||||
let gameEnv = GameEnv eventChan
|
||||
runGame :: RunType -> Game.Config -> Game.GameState -> IO ()
|
||||
runGame rt _config gameState = do
|
||||
_eventChan <- Brick.BChan.newBChan 10
|
||||
let gameEnv = GameEnv {..}
|
||||
app <- makeApp gameEnv rt
|
||||
let buildVty = Vty.mkVty Vty.defaultConfig
|
||||
initialVty <- buildVty
|
||||
_game' <- customMain
|
||||
initialVty
|
||||
buildVty
|
||||
(Just eventChan)
|
||||
(Just _eventChan)
|
||||
app
|
||||
gameState
|
||||
pure ()
|
||||
|
|
|
@ -332,31 +332,34 @@ handleCommand Fire = do
|
|||
let enemies = los >>= \(_, es) -> toList $ headMay es
|
||||
in enemies ^? folded . below _SomeEntity
|
||||
|
||||
handleCommand Save = do
|
||||
-- TODO default save locations / config file?
|
||||
use savefile >>= \case
|
||||
Just filepath ->
|
||||
stringPromptWithDefault_
|
||||
["save", "location"]
|
||||
Cancellable
|
||||
(pack filepath)
|
||||
promptCallback
|
||||
Nothing -> prompt_ @'StringPrompt ["save", "location"] Cancellable promptCallback
|
||||
continue
|
||||
where
|
||||
promptCallback :: PromptResult 'StringPrompt -> AppM ()
|
||||
promptCallback (StringResult filename) = do
|
||||
sf <- use savefile
|
||||
exists <- liftIO . doesFileExist $ unpack filename
|
||||
if exists && sf /= Just (unpack filename)
|
||||
then confirm ["save", "overwrite"] (object ["filename" A..= filename])
|
||||
$ doSave filename
|
||||
else doSave filename
|
||||
doSave filename = do
|
||||
src <- gets saveGame
|
||||
lift . liftIO $ do
|
||||
writeFile (unpack filename) $ toStrict src
|
||||
exitSuccess
|
||||
handleCommand Save =
|
||||
view (config . disableSaving) >>= \case
|
||||
True -> say_ ["save", "disabled"] >> continue
|
||||
False -> do
|
||||
-- TODO default save locations / config file?
|
||||
use savefile >>= \case
|
||||
Just filepath ->
|
||||
stringPromptWithDefault_
|
||||
["save", "location"]
|
||||
Cancellable
|
||||
(pack filepath)
|
||||
promptCallback
|
||||
Nothing -> prompt_ @'StringPrompt ["save", "location"] Cancellable promptCallback
|
||||
continue
|
||||
where
|
||||
promptCallback :: PromptResult 'StringPrompt -> AppM ()
|
||||
promptCallback (StringResult filename) = do
|
||||
sf <- use savefile
|
||||
exists <- liftIO . doesFileExist $ unpack filename
|
||||
if exists && sf /= Just (unpack filename)
|
||||
then confirm ["save", "overwrite"] (object ["filename" A..= filename])
|
||||
$ doSave filename
|
||||
else doSave filename
|
||||
doSave filename = do
|
||||
src <- gets saveGame
|
||||
lift . liftIO $ do
|
||||
writeFile (unpack filename) $ toStrict src
|
||||
exitSuccess
|
||||
|
||||
handleCommand GoUp = do
|
||||
hasStairs <- uses entitiesAtCharacter $ elem (SomeEntity UpStaircase)
|
||||
|
|
|
@ -1,8 +1,12 @@
|
|||
{-# LANGUAGE TemplateHaskell #-}
|
||||
--------------------------------------------------------------------------------
|
||||
module Xanthous.Game.Env
|
||||
( GameEnv(..)
|
||||
( Config(..)
|
||||
, defaultConfig
|
||||
, disableSaving
|
||||
, GameEnv(..)
|
||||
, eventChan
|
||||
, config
|
||||
) where
|
||||
--------------------------------------------------------------------------------
|
||||
import Xanthous.Prelude
|
||||
|
@ -11,9 +15,23 @@ import Brick.BChan (BChan)
|
|||
import Xanthous.Data.App (AppEvent)
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
data Config = Config
|
||||
{ _disableSaving :: Bool
|
||||
}
|
||||
deriving stock (Generic, Show, Eq)
|
||||
makeLenses ''Config
|
||||
{-# ANN Config ("HLint: ignore Use newtype instead of data" :: String) #-}
|
||||
|
||||
defaultConfig :: Config
|
||||
defaultConfig = Config
|
||||
{ _disableSaving = False
|
||||
}
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
data GameEnv = GameEnv
|
||||
{ _eventChan :: BChan AppEvent
|
||||
, _config :: Config
|
||||
}
|
||||
deriving stock (Generic)
|
||||
makeLenses ''GameEnv
|
||||
{-# ANN GameEnv ("HLint: ignore Use newtype instead of data" :: String) #-}
|
||||
|
|
|
@ -9,6 +9,7 @@ generic:
|
|||
continue: Press enter to continue...
|
||||
|
||||
save:
|
||||
disabled: "Sorry, saving is currently disabled"
|
||||
location: "Enter filename to save to: "
|
||||
overwrite: "A file named {{filename}} already exists. Would you like to overwrite it? "
|
||||
|
||||
|
|
Loading…
Reference in a new issue