From ff6c008d7884975f3dc0295a75b9383fd2c3a2ed Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 6 Nov 2021 11:44:14 -0400 Subject: feat(gs/xanthous): Default to the current save file When saving, default to the save file that was loaded for the game if any. To support this, this also makes text prompts support a default, which will be used if no value is input. Change-Id: I72a826499d6e987b939e3465a2d29167e53416be Reviewed-on: https://cl.tvl.fyi/c/depot/+/3801 Reviewed-by: grfn Tested-by: BuildkiteCI --- users/grfn/xanthous/src/Xanthous/Game/Arbitrary.hs | 1 + users/grfn/xanthous/src/Xanthous/Game/Draw.hs | 8 +++- users/grfn/xanthous/src/Xanthous/Game/Lenses.hs | 1 + users/grfn/xanthous/src/Xanthous/Game/Prompt.hs | 52 +++++++++++++++------- users/grfn/xanthous/src/Xanthous/Game/State.hs | 4 ++ 5 files changed, 48 insertions(+), 18 deletions(-) (limited to 'users/grfn/xanthous/src/Xanthous/Game') diff --git a/users/grfn/xanthous/src/Xanthous/Game/Arbitrary.hs b/users/grfn/xanthous/src/Xanthous/Game/Arbitrary.hs index bb9b64b0b303..679bfe54597f 100644 --- a/users/grfn/xanthous/src/Xanthous/Game/Arbitrary.hs +++ b/users/grfn/xanthous/src/Xanthous/Game/Arbitrary.hs @@ -43,6 +43,7 @@ instance Arbitrary GameState where _debugState <- arbitrary let _autocommand = NoAutocommand _memo <- arbitrary + _savefile <- arbitrary pure $ GameState {..} diff --git a/users/grfn/xanthous/src/Xanthous/Game/Draw.hs b/users/grfn/xanthous/src/Xanthous/Game/Draw.hs index 25b1b92e215c..b9590ba40438 100644 --- a/users/grfn/xanthous/src/Xanthous/Game/Draw.hs +++ b/users/grfn/xanthous/src/Xanthous/Game/Draw.hs @@ -43,8 +43,12 @@ drawPromptState :: GamePromptState m -> Widget ResourceName drawPromptState NoPrompt = emptyWidget drawPromptState (WaitingPrompt msg (Prompt _ pt ps pri _)) = case (pt, ps, pri) of - (SStringPrompt, StringPromptState edit, _) -> - txtWrap msg <+> txt " " <+> renderEditor (txt . fold) True edit + (SStringPrompt, StringPromptState edit, mDef) -> + txtWrap msg + <+> txt " " + <+> txt (maybe "" (\def -> "(default: " <> def <> ")") mDef) + <+> txt " " + <+> renderEditor (txt . fold) True edit (SDirectionPrompt, DirectionPromptState, _) -> txtWrap msg (SMenu, _, menuItems) -> txtWrap msg diff --git a/users/grfn/xanthous/src/Xanthous/Game/Lenses.hs b/users/grfn/xanthous/src/Xanthous/Game/Lenses.hs index fd60e3637cc9..c692a3b47944 100644 --- a/users/grfn/xanthous/src/Xanthous/Game/Lenses.hs +++ b/users/grfn/xanthous/src/Xanthous/Game/Lenses.hs @@ -65,6 +65,7 @@ initialStateFromSeed seed = _debugState = DebugState { _allRevealed = False } + _savefile = Nothing _autocommand = NoAutocommand _memo = emptyMemoState in GameState {..} diff --git a/users/grfn/xanthous/src/Xanthous/Game/Prompt.hs b/users/grfn/xanthous/src/Xanthous/Game/Prompt.hs index 0674d853beb7..2d6c0a280f41 100644 --- a/users/grfn/xanthous/src/Xanthous/Game/Prompt.hs +++ b/users/grfn/xanthous/src/Xanthous/Game/Prompt.hs @@ -16,6 +16,8 @@ module Xanthous.Game.Prompt , PromptInput , Prompt(..) , mkPrompt + , mkStringPrompt + , mkStringPromptWithDefault , mkMenu , mkPointOnMapPrompt , mkFirePrompt @@ -215,9 +217,10 @@ instance Show (MenuOption a) where show (MenuOption m _) = show m type family PromptInput (pt :: PromptType) :: Type where - PromptInput ('Menu a) = Map Char (MenuOption a) - PromptInput 'PointOnMap = Position -- Character pos - PromptInput 'Fire = (Position, Tiles) -- Nearest enemy, range + PromptInput ('Menu a) = Map Char (MenuOption a) + PromptInput 'PointOnMap = Position -- Character pos + PromptInput 'Fire = (Position, Tiles) -- Nearest enemy, range + PromptInput 'StringPrompt = Maybe Text -- Default value PromptInput _ = () data Prompt (m :: Type -> Type) where @@ -286,13 +289,27 @@ mkPrompt -> SPromptType pt -- ^ The type of the prompt -> (PromptResult pt -> m ()) -- ^ Function to call when the prompt is complete -> Prompt m -mkPrompt c pt@SStringPrompt cb = - let ps = StringPromptState $ editorText Resource.Prompt (Just 1) "" - in Prompt c pt ps () cb mkPrompt c pt@SDirectionPrompt cb = Prompt c pt DirectionPromptState () cb mkPrompt c pt@SContinue cb = Prompt c pt ContinuePromptState () cb mkPrompt c pt@SConfirm cb = Prompt c pt ConfirmPromptState () cb +mkStringPrompt + :: PromptCancellable -- ^ Is the prompt cancellable or not? + -> (PromptResult 'StringPrompt -> m ()) -- ^ Function to call when the prompt is complete + -> Prompt m +mkStringPrompt c = + let ps = StringPromptState $ editorText Resource.Prompt (Just 1) "" + in Prompt c SStringPrompt ps Nothing + +mkStringPromptWithDefault + :: PromptCancellable -- ^ Is the prompt cancellable or not? + -> Text -- ^ Default value for the prompt + -> (PromptResult 'StringPrompt -> m ()) -- ^ Function to call when the prompt is complete + -> Prompt m +mkStringPromptWithDefault c def = + let ps = StringPromptState $ editorText Resource.Prompt (Just 1) "" + in Prompt c SStringPrompt ps (Just def) + mkMenu :: forall a m. PromptCancellable @@ -321,19 +338,22 @@ isCancellable (Prompt Cancellable _ _ _ _) = True isCancellable (Prompt Uncancellable _ _ _ _) = False submitPrompt :: Applicative m => Prompt m -> m () -submitPrompt (Prompt _ pt ps _ cb) = - case (pt, ps) of - (SStringPrompt, StringPromptState edit) -> - cb . StringResult . mconcat . getEditContents $ edit - (SDirectionPrompt, DirectionPromptState) -> +submitPrompt (Prompt _ pt ps pri cb) = + case (pt, ps, pri) of + (SStringPrompt, StringPromptState edit, mDef) -> + let inputVal = mconcat . getEditContents $ edit + val | null inputVal, Just def <- mDef = def + | otherwise = inputVal + in cb $ StringResult val + (SDirectionPrompt, DirectionPromptState, _) -> pure () -- Don't use submit with a direction prompt - (SContinue, ContinuePromptState) -> + (SContinue, ContinuePromptState, _) -> cb ContinueResult - (SMenu, MenuPromptState) -> + (SMenu, MenuPromptState, _) -> pure () -- Don't use submit with a menu prompt - (SPointOnMap, PointOnMapPromptState pos) -> + (SPointOnMap, PointOnMapPromptState pos, _) -> cb $ PointOnMapResult pos - (SConfirm, ConfirmPromptState) -> + (SConfirm, ConfirmPromptState, _) -> cb $ ConfirmResult True - (SFire, FirePromptState pos) -> + (SFire, FirePromptState pos, _) -> cb $ FireResult pos diff --git a/users/grfn/xanthous/src/Xanthous/Game/State.hs b/users/grfn/xanthous/src/Xanthous/Game/State.hs index 10883ce06e40..3025eb15be5a 100644 --- a/users/grfn/xanthous/src/Xanthous/Game/State.hs +++ b/users/grfn/xanthous/src/Xanthous/Game/State.hs @@ -16,6 +16,7 @@ module Xanthous.Game.State , promptState , characterEntityID , autocommand + , savefile , memo , GamePromptState(..) @@ -512,6 +513,9 @@ data GameState = GameState , _debugState :: !DebugState , _autocommand :: !AutocommandState + -- | The path to the savefile that was loaded for this game, if any + , _savefile :: !(Maybe FilePath) + , _memo :: MemoState } deriving stock (Show, Generic) -- cgit 1.4.1