summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Main.hs23
1 files changed, 15 insertions, 8 deletions
diff --git a/src/Main.hs b/src/Main.hs
index de90b80..55c0d8b 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -257,9 +257,15 @@ spawnFaction cFaction num cEntity nameTemplate
257 257
258-- Dice rolls 258-- Dice rolls
259rollTest :: Completable (FormulaM Stats Test) -> Sh GameState () 259rollTest :: Completable (FormulaM Stats Test) -> Sh GameState ()
260rollTest = withArg $ enactTest' >=> maybe (return ()) (shellPutStrLn . ppResult) 260rollTest = withArg $ maybe (return ()) outputResult <=< enactTest'
261 where 261 where
262 ppResult result = pad 3 (show $ result^.rWith) ++ ": " ++ setSGRCode (colour result) ++ name result ++ setSGRCode [] ++ " by " ++ pad 2 (show $ result^.rBy) ++ "pp" 262 outputResult :: (String, TestResult) -> Sh GameState ()
263 outputResult (test, ppResult -> result) = do
264 focusId <- use gFocus
265 case focusId of
266 Nothing -> shellPutStrLn result
267 Just id -> outputLogged id $ test ++ ": " ++ result
268 ppResult result = pad 3 (show $ result^.rWith) ++ " → " ++ setSGRCode (colour result) ++ name result ++ setSGRCode [] ++ " by " ++ pad 2 (show $ result^.rBy) ++ "pp"
263 colour CritSuccess{..} = [SetColor Foreground Vivid Green, SetConsoleIntensity BoldIntensity] 269 colour CritSuccess{..} = [SetColor Foreground Vivid Green, SetConsoleIntensity BoldIntensity]
264 colour Success{..} = [SetColor Foreground Dull Green] 270 colour Success{..} = [SetColor Foreground Dull Green]
265 colour Failure{..} = [SetColor Foreground Dull Red] 271 colour Failure{..} = [SetColor Foreground Dull Red]
@@ -272,12 +278,13 @@ rollTest = withArg $ enactTest' >=> maybe (return ()) (shellPutStrLn . ppResult)
272 | length str >= n = str 278 | length str >= n = str
273 | otherwise = ' ' : pad (n - 1) str 279 | otherwise = ' ' : pad (n - 1) str
274 280
275enactTest' :: (FormulaM Stats Test) -> Sh GameState (Maybe TestResult) 281enactTest' :: FormulaM Stats Test -> Sh GameState (Maybe (String, TestResult))
276enactTest' test = withFocus' $ \focus -> do 282enactTest' test = runMaybeT $ do
277 focusName <- use gFocus >>= toName . fromJust 283 focusName <- MaybeT (use gFocus) >>= lift . toName
278 (newFocus, result) <- evalFormula [focusName] focus (enactTest =<< test) 284 let evalF = MaybeT . focusState (gFocus' . eStats) . evalFormula' [focusName]
279 gFocus' .= newFocus 285 test' <- evalF test
280 return result 286 result <- evalF $ enactTest test'
287 return (view (tName . to CI.original) test', result)
281 288
282entitySeqVal :: Sh GameState () 289entitySeqVal :: Sh GameState ()
283entitySeqVal = withFocus entitySeqVal' 290entitySeqVal = withFocus entitySeqVal'