diff options
author | Gregor Kleen <gkleen@yggdrasil.li> | 2016-06-04 18:06:36 +0200 |
---|---|---|
committer | Gregor Kleen <gkleen@yggdrasil.li> | 2016-06-04 18:06:36 +0200 |
commit | fbaf4d9da45f714c32f410d3b5785fd06504325a (patch) | |
tree | 053712472ca7e73f70a43c66b8d4b718591c8584 /src/Main.hs | |
parent | 048779ac250b0cb463839edd8f46d9785fb3f9e5 (diff) | |
download | 2017-01-16_17:13:37-fbaf4d9da45f714c32f410d3b5785fd06504325a.tar 2017-01-16_17:13:37-fbaf4d9da45f714c32f410d3b5785fd06504325a.tar.gz 2017-01-16_17:13:37-fbaf4d9da45f714c32f410d3b5785fd06504325a.tar.bz2 2017-01-16_17:13:37-fbaf4d9da45f714c32f410d3b5785fd06504325a.tar.xz 2017-01-16_17:13:37-fbaf4d9da45f714c32f410d3b5785fd06504325a.zip |
archetypes & cleanup
Diffstat (limited to 'src/Main.hs')
-rw-r--r-- | src/Main.hs | 20 |
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 | |||
32 | import Control.Monad.State.Strict | 32 | import Control.Monad.State.Strict |
33 | 33 | ||
34 | import Sequence.Types | 34 | import Sequence.Types |
35 | import Sequence.Contact.Archetypes | ||
35 | import Sequence.Utils | 36 | import Sequence.Utils |
36 | import Sequence.Formula | 37 | import Sequence.Formula |
37 | 38 | ||
38 | import Text.Layout.Table | 39 | import Text.Layout.Table |
39 | 40 | ||
41 | import Text.Read (readMaybe) | ||
42 | |||
40 | main :: IO () | 43 | main :: IO () |
41 | main = do | 44 | main = 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 |
97 | setFocus :: Completable EntityIdentifier -> Sh GameState () | 102 | setFocus :: Completable EntityIdentifier -> Sh GameState () |
98 | setFocus = withArg $ \ident -> gFocus .= Just ident | 103 | setFocus = withArg $ \ident -> gFocus ?= ident |
99 | 104 | ||
100 | -- Drop information | 105 | -- Drop information |
101 | remove :: Sh GameState () | 106 | remove :: 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 | ||
116 | spawnEntity :: Completable Entity -> Sh GameState () | ||
117 | spawnEntity = withArg $ \entity -> do | ||
118 | identifier <- use gNextId' | ||
119 | modify $ insertEntity entity | ||
120 | gFocus ?= identifier | ||
121 | |||
122 | nameEntity :: String -> Sh GameState () | ||
123 | nameEntity ('#':_) = shellPutErrLn "We do not allow names that might shadow explicit access to entities via their number (‘#<n>’)" | ||
124 | nameEntity name = withFocus $ \ident -> modifying gEntityNames $ Bimap.insert ident (name ^. entityName) | ||