From e82a3a8c147b34b75a203f66f974f5b3ec21d98c Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Fri, 3 Jun 2016 01:51:28 +0200
Subject: focus

---
 src/Sequence/Utils.hs | 17 ++++++++++++++++-
 1 file changed, 16 insertions(+), 1 deletion(-)

(limited to 'src/Sequence/Utils.hs')

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
-- 
cgit v1.2.3