focus

2 files changed, 19 insertions, 2 deletions

diff --git a/src/Sequence/Types.hs b/src/Sequence/Types.hs
index fd8d7ab..8895569 100644
--- a/src/Sequence/Types.hs
+++ b/src/Sequence/Types.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, ViewPatterns, OverloadedStrings, TemplateHaskell, GeneralizedNewtypeDeriving #-}
 
 module Sequence.Types
-  ( GameState(..), gEntities, gEntityNames
+  ( GameState(..), gEntities, gEntityNames, gFocus
   , Faction, faction, faction'
   , SeqVal(..), seqVal
   , Entity(..), eFaction, eSeqVal
@@ -81,6 +81,7 @@ makeLenses ''EntityIdentifier
 data GameState = GameState
                  { _gEntities    :: Map EntityIdentifier Entity
                  , _gEntityNames :: Bimap EntityIdentifier EntityName
+                 , _gFocus       :: Maybe EntityIdentifier
                  }
 makeLenses ''GameState
 
@@ -88,6 +89,7 @@ instance Default GameState where
   def = GameState
         { _gEntities = def
         , _gEntityNames = Bimap.empty
+        , _gFocus = Nothing
         }
 
 inhabitedFactions :: Getter GameState [Faction]
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