summaryrefslogtreecommitdiff
path: root/src/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Main.hs')
-rw-r--r--src/Main.hs17
1 files changed, 15 insertions, 2 deletions
diff --git a/src/Main.hs b/src/Main.hs
index 2d9f876..3b7b3f5 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -274,10 +274,10 @@ spawnFaction cFaction num cEntity nameTemplate
274 274
275-- Dice rolls 275-- Dice rolls
276rollTest :: Completable (FormulaM Stats Test) -> Sh GameState () 276rollTest :: Completable (FormulaM Stats Test) -> Sh GameState ()
277rollTest = withArg $ maybe (return ()) outputResult <=< enactTest' 277rollTest = withArg $ maybe (return ()) ((>>) <$> outputResult <*> applyEffect) <=< enactTest'
278 where 278 where
279 outputResult :: (String, TestResult) -> Sh GameState () 279 outputResult :: (String, TestResult) -> Sh GameState ()
280 outputResult (test, ppResult -> result) = do 280 outputResult (test, view (rRoll . to ppResult) -> result) = do
281 focusId <- use gFocus 281 focusId <- use gFocus
282 case focusId of 282 case focusId of
283 Nothing -> shellPutStrLn result 283 Nothing -> shellPutStrLn result
@@ -295,6 +295,19 @@ rollTest = withArg $ maybe (return ()) outputResult <=< enactTest'
295 | length str >= n = str 295 | length str >= n = str
296 | otherwise = ' ' : pad (n - 1) str 296 | otherwise = ' ' : pad (n - 1) str
297 297
298
299 applyEffect :: (String, TestResult) -> Sh GameState ()
300 applyEffect (test, view rResult -> (Effect (CI.original -> effectDesc) effect)) = void . runMaybeT $ do
301 focusId <- MaybeT $ use gFocus
302 name <- toName focusId
303 let
304 lStats :: Traversal' GameState Stats
305 lStats = gEntities . ix focusId . eStats
306 evalF = MaybeT . focusState lStats . evalFormula' [name]
307 guard =<< askBool ("Apply effects (" ++ effectDesc ++ ")?") True
308 lStats <~ (MaybeT . fmap join . runMaybeT $ evalF effect)
309 lift . outputLogged focusId $ test ++ " effects: " ++ effectDesc
310
298enactTest' :: FormulaM Stats Test -> Sh GameState (Maybe (String, TestResult)) 311enactTest' :: FormulaM Stats Test -> Sh GameState (Maybe (String, TestResult))
299enactTest' test = runMaybeT $ do 312enactTest' test = runMaybeT $ do
300 focusName <- MaybeT (use gFocus) >>= lift . toName 313 focusName <- MaybeT (use gFocus) >>= lift . toName