trigger effects on taking damage

1 files changed, 50 insertions, 3 deletions

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
+