diff options
Diffstat (limited to 'src/Main.hs')
-rw-r--r-- | src/Main.hs | 34 |
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 | |||
19 | import Data.Map.Strict (Map) | 19 | import Data.Map.Strict (Map) |
20 | import qualified Data.Map.Strict as Map | 20 | import qualified Data.Map.Strict as Map |
21 | 21 | ||
22 | import Data.Bimap (Bimap) | ||
23 | import qualified Data.Bimap as Bimap | ||
24 | |||
25 | import Data.List | ||
26 | |||
22 | import Data.List | 27 | import Data.List |
23 | import Data.Maybe | 28 | import 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') | |||
77 | listEntities :: Sh GameState () | 86 | listEntities :: Sh GameState () |
78 | listEntities = use (gEntities . to Map.keys) >>= mapM_ (shellPutStrLn <=< toName) | 87 | listEntities = use (gEntities . to Map.keys) >>= mapM_ (shellPutStrLn <=< toName) |
79 | 88 | ||
80 | alignEntity :: Completable EntityIdentifier -> Completable Faction -> Sh GameState () | 89 | alignEntity :: Completable Faction -> Sh GameState () |
81 | alignEntity ident' nFaction' = flip withArg nFaction' $ \nFaction -> flip withArg ident' $ \ident -> do | 90 | alignEntity = withArg $ \nFaction -> withFocus $ \ident -> gEntities %= Map.adjust (set eFaction nFaction) ident |
82 | gEntities %= Map.adjust (set eFaction nFaction) ident | 91 | |
92 | focusTip, blur :: Sh GameState () | ||
93 | focusTip = gFocus <~ use tip | ||
94 | blur = gFocus .= Nothing | ||
95 | |||
96 | setFocus :: Completable EntityIdentifier -> Sh GameState () | ||
97 | setFocus = withArg $ \ident -> gFocus .= Just ident | ||
98 | |||
99 | remove :: Sh GameState () | ||
100 | remove = 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 | ||