summaryrefslogtreecommitdiff
path: root/src/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Main.hs')
-rw-r--r--src/Main.hs34
1 files changed, 29 insertions, 5 deletions
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
19import Data.Map.Strict (Map) 19import Data.Map.Strict (Map)
20import qualified Data.Map.Strict as Map 20import qualified Data.Map.Strict as Map
21 21
22import Data.Bimap (Bimap)
23import qualified Data.Bimap as Bimap
24
25import Data.List
26
22import Data.List 27import Data.List
23import Data.Maybe 28import Data.Maybe
24 29
@@ -43,10 +48,14 @@ main = do
43 , commandStyle = OnlyCommands 48 , commandStyle = OnlyCommands
44 , shellCommands = [ exitCommand "exit" 49 , shellCommands = [ exitCommand "exit"
45 , helpCommand "help" 50 , helpCommand "help"
51 , cmd "entities" listEntities "List all entities"
52 , cmd "tip" focusTip "Focus the entity at the top of the queue"
53 , cmd "focus" setFocus "Focus a specific entity"
54 , cmd "blur" blur "Focus no entity"
55 , cmd "remove" remove "Remove the focused entity from the queue"
46 , cmd "factions" listFactions "List all inhabited factions" 56 , cmd "factions" listFactions "List all inhabited factions"
47 , cmd "members" listFaction "List all members of a faction" 57 , cmd "members" listFaction "List all members of a faction"
48 , cmd "entities" listEntities "List all entities" 58 , cmd "align" alignEntity "Align the focused entity to a faction – creating it, if necessary"
49 , cmd "align" alignEntity "Align an entity to a faction creating it, if necessary"
50 ] 59 ]
51 } 60 }
52 void $ runShell description haskelineBackend (def :: GameState) 61 void $ runShell description haskelineBackend (def :: GameState)
@@ -77,6 +86,21 @@ listFactions = use inhabitedFactions >>= mapM_ (shellPutStrLn . view faction')
77listEntities :: Sh GameState () 86listEntities :: Sh GameState ()
78listEntities = use (gEntities . to Map.keys) >>= mapM_ (shellPutStrLn <=< toName) 87listEntities = use (gEntities . to Map.keys) >>= mapM_ (shellPutStrLn <=< toName)
79 88
80alignEntity :: Completable EntityIdentifier -> Completable Faction -> Sh GameState () 89alignEntity :: Completable Faction -> Sh GameState ()
81alignEntity ident' nFaction' = flip withArg nFaction' $ \nFaction -> flip withArg ident' $ \ident -> do 90alignEntity = withArg $ \nFaction -> withFocus $ \ident -> gEntities %= Map.adjust (set eFaction nFaction) ident
82 gEntities %= Map.adjust (set eFaction nFaction) ident 91
92focusTip, blur :: Sh GameState ()
93focusTip = gFocus <~ use tip
94blur = gFocus .= Nothing
95
96setFocus :: Completable EntityIdentifier -> Sh GameState ()
97setFocus = withArg $ \ident -> gFocus .= Just ident
98
99remove :: Sh GameState ()
100remove = withFocus $ \ident -> do
101 name <- toName ident
102 confirmation <- askBool ("Are you sure you want to remove ‘" ++ name ++ "’? ") False
103 when confirmation $ do
104 gEntities %= Map.delete ident
105 gEntityNames %= Bimap.delete ident
106 blur