focus

1 files changed, 16 insertions, 1 deletions

diff --git a/src/Sequence/Utils.hs b/src/Sequence/Utils.hs
index aa92081..aea853d 100644
--- a/src/Sequence/Utils.hs
+++ b/src/Sequence/Utils.hs
@@ -1,7 +1,9 @@
 {-# LANGUAGE ViewPatterns, FlexibleContexts, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, UndecidableInstances #-}
 
 module Sequence.Utils
-  ( withArg, toName, fromName
+  ( withArg, withFocus
+  , askBool
+  , toName, fromName
   ) where
 
 import Sequence.Types
@@ -28,6 +30,7 @@ import Data.List
 
 import System.Console.Shell
 import System.Console.Shell.ShellMonad
+import System.Console.Shell.Backend.Haskeline
 
 
 class Argument a st | a -> st where
@@ -38,6 +41,18 @@ withArg f (Completable str) = arg str >>= \a -> case a of
   Nothing -> shellPutErrLn $ "Could not parse ‘" ++ str ++ "’"
   Just a  -> f a
 
+withFocus :: (EntityIdentifier -> Sh GameState ()) -> Sh GameState ()
+withFocus f = use gFocus >>= \focus -> case focus of
+  Nothing -> shellPutErrLn $ "Currently not focusing any entity"
+  Just id -> f id
+
+askBool :: String -> Bool -> Sh st Bool
+askBool prompt initial = liftIO $ runShell (initialShellDescription { shellCommands = [cmd "y" yes "yes", cmd "n" no "no"], commandStyle = SingleCharCommands, prompt = const $ return prompt, historyEnabled = False }) haskelineBackend initial
+  where
+    yes, no :: Sh Bool ()
+    yes = put True
+    no  = put False
+
 unaligned = view faction' def
   
 toName :: MonadState GameState m => EntityIdentifier -> m String