Confirm before quitting
Prompt to confirm before quitting the game with the Quit command
This commit is contained in:
parent
f701a0be40
commit
a58966d43f
3 changed files with 28 additions and 3 deletions
|
@ -129,7 +129,7 @@ handleNoPromptEvent (VtyEvent (EvKey k mods))
|
|||
handleNoPromptEvent _ = continue
|
||||
|
||||
handleCommand :: Command -> AppM (Next GameState)
|
||||
handleCommand Quit = halt
|
||||
handleCommand Quit = confirm_ ["quit", "confirm"] (liftIO exitSuccess) >> continue
|
||||
handleCommand (Move dir) = do
|
||||
newPos <- uses characterPosition $ move dir
|
||||
collisionAt newPos >>= \case
|
||||
|
@ -282,6 +282,12 @@ handlePromptEvent _ (Prompt Cancellable _ _ _ _) (VtyEvent (EvKey KEsc []))
|
|||
handlePromptEvent _ pr (VtyEvent (EvKey KEnter []))
|
||||
= submitPrompt pr >> clearPrompt
|
||||
|
||||
handlePromptEvent _ pr@(Prompt _ SConfirm _ _ _) (VtyEvent (EvKey (KChar 'y') []))
|
||||
= submitPrompt pr >> clearPrompt
|
||||
|
||||
handlePromptEvent _ (Prompt _ SConfirm _ _ _) (VtyEvent (EvKey (KChar 'n') []))
|
||||
= clearPrompt
|
||||
|
||||
handlePromptEvent
|
||||
msg
|
||||
(Prompt c SStringPrompt (StringPromptState edit) pri cb)
|
||||
|
@ -297,8 +303,6 @@ handlePromptEvent _ (Prompt _ SDirectionPrompt _ _ cb)
|
|||
= cb (DirectionResult dir) >> clearPrompt
|
||||
handlePromptEvent _ (Prompt _ SDirectionPrompt _ _ _) _ = continue
|
||||
|
||||
handlePromptEvent _ (Prompt _ SContinue _ _ _) _ = continue
|
||||
|
||||
handlePromptEvent _ (Prompt _ SMenu _ items' cb) (VtyEvent (EvKey (KChar chr) []))
|
||||
| Just (MenuOption _ res) <- items' ^. at chr
|
||||
= cb (MenuResult res) >> clearPrompt
|
||||
|
@ -315,6 +319,11 @@ handlePromptEvent
|
|||
>> continue
|
||||
handlePromptEvent _ (Prompt _ SPointOnMap _ _ _) _ = continue
|
||||
|
||||
handlePromptEvent
|
||||
_
|
||||
(Prompt Cancellable _ _ _ _)
|
||||
(VtyEvent (EvKey (KChar 'q') []))
|
||||
= clearPrompt
|
||||
handlePromptEvent _ _ _ = continue
|
||||
|
||||
clearPrompt :: AppM (Next GameState)
|
||||
|
@ -361,6 +370,18 @@ prompt_
|
|||
-> AppM ()
|
||||
prompt_ msg = prompt msg $ object []
|
||||
|
||||
confirm
|
||||
:: ToJSON params
|
||||
=> [Text] -- ^ Message key
|
||||
-> params
|
||||
-> AppM ()
|
||||
-> AppM ()
|
||||
confirm msgPath params
|
||||
= prompt @'Confirm msgPath params Cancellable . const
|
||||
|
||||
confirm_ :: [Text] -> AppM () -> AppM ()
|
||||
confirm_ msgPath = confirm msgPath $ object []
|
||||
|
||||
menu :: forall (a :: Type) (params :: Type).
|
||||
(ToJSON params)
|
||||
=> [Text] -- ^ Message key
|
||||
|
|
|
@ -69,6 +69,7 @@ instance NFData (SPromptType pt) where
|
|||
|
||||
class SingPromptType pt where singPromptType :: SPromptType pt
|
||||
instance SingPromptType 'StringPrompt where singPromptType = SStringPrompt
|
||||
instance SingPromptType 'Confirm where singPromptType = SConfirm
|
||||
instance SingPromptType 'DirectionPrompt where singPromptType = SDirectionPrompt
|
||||
instance SingPromptType 'PointOnMap where singPromptType = SPointOnMap
|
||||
instance SingPromptType 'Continue where singPromptType = SContinue
|
||||
|
|
|
@ -12,6 +12,9 @@ save:
|
|||
location:
|
||||
"Enter filename to save to: "
|
||||
|
||||
quit:
|
||||
confirm: Really quit without saving?
|
||||
|
||||
entities:
|
||||
description: You see here {{entityDescriptions}}
|
||||
|
||||
|
|
Loading…
Reference in a new issue