summaryrefslogtreecommitdiff
path: root/src/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Main.hs')
-rw-r--r--src/Main.hs15
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
32import Control.Monad.State.Strict 32import Control.Monad.State.Strict
33 33
34import Sequence.Types 34import Sequence.Types
35import Sequence.Contact.Types
35import Sequence.Contact.Archetypes 36import Sequence.Contact.Archetypes
37import Sequence.Contact.Tests
36import Sequence.Utils 38import Sequence.Utils
37import Sequence.Formula 39import 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
97focusTip, blur :: Sh GameState () 100focusTip, blur :: Sh GameState ()
98focusTip = gFocus <~ use tip 101focusTip = gFocus <~ preuse tip
99blur = gFocus .= Nothing 102blur = gFocus .= Nothing
100 103
101-- Manual focus 104-- Manual focus
@@ -122,3 +125,13 @@ spawnEntity = withArg $ \entity -> do
122nameEntity :: String -> Sh GameState () 125nameEntity :: String -> Sh GameState ()
123nameEntity ('#':_) = shellPutErrLn "We do not allow names that might shadow explicit access to entities via their number (‘#<n>’)" 126nameEntity ('#':_) = 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) 127nameEntity name = withFocus $ \ident -> modifying gEntityNames $ Bimap.insert ident (name ^. entityName)
128
129rollTest :: Completable (FormulaM Stats Test) -> Sh GameState ()
130rollTest = withArg $ enactTest' >=> maybe (return ()) (shellPutStrLn . show)
131
132enactTest' :: (FormulaM Stats Test) -> Sh GameState (Maybe TestResult)
133enactTest' test = withFocus' $ \focus -> do
134 (newStats, result) <- evalFormula (view eStats focus) (enactTest =<< test)
135 gFocus'.eStats .= newStats
136 return result
137