summaryrefslogtreecommitdiff
path: root/src/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Main.hs')
-rw-r--r--src/Main.hs20
1 files changed, 18 insertions, 2 deletions
diff --git a/src/Main.hs b/src/Main.hs
index 8f955bb..9ea7a49 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -32,11 +32,14 @@ import Data.Function
32import Control.Monad.State.Strict 32import Control.Monad.State.Strict
33 33
34import Sequence.Types 34import Sequence.Types
35import Sequence.Contact.Archetypes
35import Sequence.Utils 36import Sequence.Utils
36import Sequence.Formula 37import Sequence.Formula
37 38
38import Text.Layout.Table 39import Text.Layout.Table
39 40
41import Text.Read (readMaybe)
42
40main :: IO () 43main :: IO ()
41main = do 44main = do
42 historyFile <- getUserCacheFile "sequence" "history" 45 historyFile <- getUserCacheFile "sequence" "history"
@@ -44,7 +47,7 @@ main = do
44 let 47 let
45 description = initialShellDescription 48 description = initialShellDescription
46 { historyFile = Just historyFile 49 { historyFile = Just historyFile
47 , prompt = \st -> return $ maybe "" (++ " ") ((evalState ?? st) . toName <$> view tip st) ++ "→ " 50 , prompt = \st -> return $ maybe "" (++ " ") ((evalState ?? st) . toName <$> view gFocus st) ++ "→ "
48 , beforePrompt = gets stateOutline >>= (\str -> if null str then return () else shellPutStrLn str) 51 , beforePrompt = gets stateOutline >>= (\str -> if null str then return () else shellPutStrLn str)
49 , commandStyle = OnlyCommands 52 , commandStyle = OnlyCommands
50 , shellCommands = [ exitCommand "exit" 53 , shellCommands = [ exitCommand "exit"
@@ -57,6 +60,8 @@ main = do
57 , cmd "factions" listFactions "List all inhabited factions" 60 , cmd "factions" listFactions "List all inhabited factions"
58 , cmd "members" listFaction "List all members of a faction" 61 , cmd "members" listFaction "List all members of a faction"
59 , cmd "align" alignEntity "Align the focused entity to a faction – creating it, if necessary" 62 , cmd "align" alignEntity "Align the focused entity to a faction – creating it, if necessary"
63 , cmd "name" nameEntity "Name the current entity overriding previous name assignments"
64 , cmd "spawn" spawnEntity "Create a new entity from an archetype focusing on it"
60 ] 65 ]
61 } 66 }
62 void $ runShell description haskelineBackend (def :: GameState) 67 void $ runShell description haskelineBackend (def :: GameState)
@@ -95,7 +100,7 @@ blur = gFocus .= Nothing
95 100
96-- Manual focus 101-- Manual focus
97setFocus :: Completable EntityIdentifier -> Sh GameState () 102setFocus :: Completable EntityIdentifier -> Sh GameState ()
98setFocus = withArg $ \ident -> gFocus .= Just ident 103setFocus = withArg $ \ident -> gFocus ?= ident
99 104
100-- Drop information 105-- Drop information
101remove :: Sh GameState () 106remove :: Sh GameState ()
@@ -106,3 +111,14 @@ remove = withFocus $ \ident -> do
106 gEntities %= Map.delete ident 111 gEntities %= Map.delete ident
107 gEntityNames %= Bimap.delete ident 112 gEntityNames %= Bimap.delete ident
108 blur 113 blur
114
115-- Manage Entity
116spawnEntity :: Completable Entity -> Sh GameState ()
117spawnEntity = withArg $ \entity -> do
118 identifier <- use gNextId'
119 modify $ insertEntity entity
120 gFocus ?= identifier
121
122nameEntity :: String -> Sh GameState ()
123nameEntity ('#':_) = shellPutErrLn "We do not allow names that might shadow explicit access to entities via their number (‘#<n>’)"
124nameEntity name = withFocus $ \ident -> modifying gEntityNames $ Bimap.insert ident (name ^. entityName)