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 |
