diff options
Diffstat (limited to 'src/Main.hs')
-rw-r--r-- | src/Main.hs | 17 |
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 |
276 | rollTest :: Completable (FormulaM Stats Test) -> Sh GameState () | 276 | rollTest :: Completable (FormulaM Stats Test) -> Sh GameState () |
277 | rollTest = withArg $ maybe (return ()) outputResult <=< enactTest' | 277 | rollTest = 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 | |||
298 | enactTest' :: FormulaM Stats Test -> Sh GameState (Maybe (String, TestResult)) | 311 | enactTest' :: FormulaM Stats Test -> Sh GameState (Maybe (String, TestResult)) |
299 | enactTest' test = runMaybeT $ do | 312 | enactTest' test = runMaybeT $ do |
300 | focusName <- MaybeT (use gFocus) >>= lift . toName | 313 | focusName <- MaybeT (use gFocus) >>= lift . toName |