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/Main.hs | 34 +++++++++++++++++++++++++++++-----
 1 file changed, 29 insertions(+), 5 deletions(-)

(limited to 'src/Main.hs')

diff --git a/src/Main.hs b/src/Main.hs
index ea663e8..258e230 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -19,6 +19,11 @@ import qualified Data.CaseInsensitive
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 
+import Data.Bimap (Bimap)
+import qualified Data.Bimap as Bimap
+
+import Data.List
+
 import Data.List
 import Data.Maybe
 
@@ -43,10 +48,14 @@ main = do
                   , commandStyle = OnlyCommands
                   , shellCommands = [ exitCommand "exit"
                                     , helpCommand "help"
+                                    , cmd "entities" listEntities "List all entities"
+                                    , cmd "tip" focusTip "Focus the entity at the top of the queue"
+                                    , cmd "focus" setFocus "Focus a specific entity"
+                                    , cmd "blur" blur "Focus no entity"
+                                    , cmd "remove" remove "Remove the focused entity from the queue"
                                     , cmd "factions" listFactions "List all inhabited factions"
                                     , cmd "members" listFaction "List all members of a faction"
-                                    , cmd "entities" listEntities "List all entities"
-                                    , cmd "align" alignEntity "Align an entity to a faction creating it, if necessary"
+                                    , cmd "align" alignEntity "Align the focused entity to a faction – creating it, if necessary"
                                     ]
                   }
   void $ runShell description haskelineBackend (def :: GameState)
@@ -77,6 +86,21 @@ listFactions = use inhabitedFactions >>= mapM_ (shellPutStrLn . view faction')
 listEntities :: Sh GameState ()
 listEntities = use (gEntities . to Map.keys) >>= mapM_ (shellPutStrLn <=< toName)
 
-alignEntity :: Completable EntityIdentifier -> Completable Faction -> Sh GameState ()
-alignEntity ident' nFaction' = flip withArg nFaction' $ \nFaction -> flip withArg ident' $ \ident -> do
-  gEntities %= Map.adjust (set eFaction nFaction) ident
+alignEntity :: Completable Faction -> Sh GameState ()
+alignEntity = withArg $ \nFaction -> withFocus $ \ident -> gEntities %= Map.adjust (set eFaction nFaction) ident
+
+focusTip, blur :: Sh GameState ()
+focusTip = gFocus <~ use tip
+blur     = gFocus .= Nothing
+
+setFocus :: Completable EntityIdentifier -> Sh GameState ()
+setFocus = withArg $ \ident -> gFocus .= Just ident
+
+remove :: Sh GameState ()
+remove = withFocus $ \ident -> do
+  name <- toName ident
+  confirmation <- askBool ("Are you sure you want to remove ‘" ++ name ++ "’? ") False
+  when confirmation $ do
+    gEntities %= Map.delete ident
+    gEntityNames %= Bimap.delete ident
+    blur
-- 
cgit v1.2.3