fix temporary insanity

1 files changed, 11 insertions, 28 deletions

diff --git a/src/Main.hs b/src/Main.hs
index de97603..e8e0a49 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ViewPatterns, RecordWildCards, OverloadedStrings, FlexibleContexts #-}
+{-# LANGUAGE ViewPatterns, RecordWildCards, OverloadedStrings, FlexibleContexts, RankNTypes #-}
 
 import Control.Monad
 
@@ -251,15 +251,14 @@ delay = withFocus $ \focusId -> () <$ runMaybeT (delay' focusId)
 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 -> do
+doShock :: Int -> Traversal' Stats ShockEffect -> Sh GameState ()
+doShock dmg efLens = withFocus $ \focusId -> 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
+    cripple <- MaybeT . preuse $ lStats . efLens
     let evalF formula = do
           stats <- MaybeT $ preuse lStats
           (nStats, x) <- (evalFormula name :: Stats -> FormulaM Stats a -> MaybeT (Sh GameState) (Stats, a)) stats formula
@@ -276,30 +275,14 @@ takeHit dmg = withArg $ \zones -> withFocus $ \focusId -> forM_ zones $ \zone ->
     lStats <~ (MaybeT . fmap join . runMaybeT $ evalF effect)
     lift $ shellPutStrLn effectName
     lift . addNote $ "Effect: " ++ effectName
+
+takeHit :: Int -> Completable (Set Hitzone) -> Sh GameState ()
+takeHit dmg = withArg $ \zones -> withFocus $ \focusId -> forM_ zones $ \zone -> do
+  gEntities . ix focusId . eStats . sDamage . ix zone += dmg
+  doShock dmg (sCripple . ix zone)
+  doShock dmg sPainShock
     
 takeFatigue :: Int -> Sh GameState ()
 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
-    
+  doShock dmg sFatigueShock