diff options
Diffstat (limited to 'src/Main.hs')
-rw-r--r-- | src/Main.hs | 15 |
1 files changed, 14 insertions, 1 deletions
diff --git a/src/Main.hs b/src/Main.hs index 9ea7a49..c6eee62 100644 --- a/src/Main.hs +++ b/src/Main.hs | |||
@@ -32,7 +32,9 @@ 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.Types | ||
35 | import Sequence.Contact.Archetypes | 36 | import Sequence.Contact.Archetypes |
37 | import Sequence.Contact.Tests | ||
36 | import Sequence.Utils | 38 | import Sequence.Utils |
37 | import Sequence.Formula | 39 | import Sequence.Formula |
38 | 40 | ||
@@ -62,6 +64,7 @@ main = do | |||
62 | , cmd "align" alignEntity "Align the focused entity to a faction – creating it, if necessary" | 64 | , 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" | 65 | , 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" | 66 | , cmd "spawn" spawnEntity "Create a new entity from an archetype focusing on it" |
67 | , cmd "roll" rollTest "Roll a test using the stats of the currently focused entity" | ||
65 | ] | 68 | ] |
66 | } | 69 | } |
67 | void $ runShell description haskelineBackend (def :: GameState) | 70 | void $ runShell description haskelineBackend (def :: GameState) |
@@ -95,7 +98,7 @@ alignEntity = withArg $ \nFaction -> withFocus $ \ident -> gEntities %= Map.adju | |||
95 | 98 | ||
96 | -- Automatic focus | 99 | -- Automatic focus |
97 | focusTip, blur :: Sh GameState () | 100 | focusTip, blur :: Sh GameState () |
98 | focusTip = gFocus <~ use tip | 101 | focusTip = gFocus <~ preuse tip |
99 | blur = gFocus .= Nothing | 102 | blur = gFocus .= Nothing |
100 | 103 | ||
101 | -- Manual focus | 104 | -- Manual focus |
@@ -122,3 +125,13 @@ spawnEntity = withArg $ \entity -> do | |||
122 | nameEntity :: String -> Sh GameState () | 125 | nameEntity :: String -> Sh GameState () |
123 | nameEntity ('#':_) = shellPutErrLn "We do not allow names that might shadow explicit access to entities via their number (‘#<n>’)" | 126 | 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) | 127 | nameEntity name = withFocus $ \ident -> modifying gEntityNames $ Bimap.insert ident (name ^. entityName) |
128 | |||
129 | rollTest :: Completable (FormulaM Stats Test) -> Sh GameState () | ||
130 | rollTest = withArg $ enactTest' >=> maybe (return ()) (shellPutStrLn . show) | ||
131 | |||
132 | enactTest' :: (FormulaM Stats Test) -> Sh GameState (Maybe TestResult) | ||
133 | enactTest' test = withFocus' $ \focus -> do | ||
134 | (newStats, result) <- evalFormula (view eStats focus) (enactTest =<< test) | ||
135 | gFocus'.eStats .= newStats | ||
136 | return result | ||
137 | |||