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