From fb065aeac90ce0766a3f74b84c34547cd087da77 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sat, 11 Jun 2016 01:34:07 +0200 Subject: trigger effects on taking damage --- src/Main.hs | 53 ++++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 50 insertions(+), 3 deletions(-) (limited to 'src/Main.hs') diff --git a/src/Main.hs b/src/Main.hs index e239bec..de97603 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -252,7 +252,54 @@ addNote :: String -> Sh GameState () addNote note = withFocus $ \focusId -> gEntities . ix focusId . eNotes %= (note :) takeHit :: Int -> Completable (Set Hitzone) -> Sh GameState () -takeHit dmg = withArg $ \zones -> withFocus $ \focusId -> forM_ zones $ \zone -> gEntities . ix focusId . eStats . sDamage . ix zone += dmg - +takeHit dmg = withArg $ \zones -> withFocus $ \focusId -> forM_ zones $ \zone -> do + let + lStats :: Traversal' GameState Stats + lStats = gEntities . ix focusId . eStats + lStats . sDamage . ix zone += dmg + name <- toName focusId + void . runMaybeT $ do + cripple <- MaybeT . preuse $ lStats . sCripple . ix zone + let evalF formula = do + stats <- MaybeT $ preuse lStats + (nStats, x) <- (evalFormula name :: Stats -> FormulaM Stats a -> MaybeT (Sh GameState) (Stats, a)) stats formula + lStats .= nStats + return x + cVar cLens = evalF =<< MaybeT (preuse $ lStats . (cripple ^. cLens)) + bar <- cVar seBar + val <- cVar seVal + reBar <- cVar seReBar + if cripple ^. seApplied + then guard $ dmg >= reBar + else guard $ val >= bar + (CI.original -> effectName, effect) <- view _Effect <$> (evalF . table $ cripple ^. seEffect) + lStats <~ (MaybeT . fmap join . runMaybeT $ evalF effect) + lift $ shellPutStrLn effectName + lift . addNote $ "Effect: " ++ effectName + takeFatigue :: Int -> Sh GameState () -takeFatigue dmg = withFocus $ \focusId -> gEntities . ix focusId . eStats . sFatigue += dmg +takeFatigue dmg = withFocus $ \focusId -> do + let + lStats :: Traversal' GameState Stats + lStats = gEntities . ix focusId . eStats + gEntities . ix focusId . eStats . sFatigue += dmg + name <- toName focusId + void . runMaybeT $ do + fShock <- MaybeT . preuse $ lStats . sFatigueShock + let evalF formula = do + stats <- MaybeT $ preuse lStats + (nStats, x) <- (evalFormula name :: Stats -> FormulaM Stats a -> MaybeT (Sh GameState) (Stats, a)) stats formula + lStats .= nStats + return x + fVar cLens = evalF =<< MaybeT (preuse $ lStats . (fShock ^. cLens)) + bar <- fVar seBar + val <- fVar seVal + reBar <- fVar seReBar + if fShock ^. seApplied + then guard $ dmg >= reBar + else guard $ val >= bar + (CI.original -> effectName, effect) <- view _Effect <$> (evalF . table $ fShock ^. seEffect) + lStats <~ (MaybeT . fmap join . runMaybeT $ evalF effect) + lift $ shellPutStrLn effectName + lift . addNote $ "Effect: " ++ effectName + -- cgit v1.2.3