1 files changed, 18 insertions, 2 deletions

diff --git a/src/Sequence/Contact/Archetypes.hs b/src/Sequence/Contact/Archetypes.hs
index 5f431de..d790917 100644
--- a/src/Sequence/Contact/Archetypes.hs
+++ b/src/Sequence/Contact/Archetypes.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings, OverloadedLists, ViewPatterns, MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings, OverloadedLists, ViewPatterns, MultiParamTypeClasses, RankNTypes #-}
 
 module Sequence.Contact.Archetypes where
 
@@ -18,6 +18,9 @@ import Sequence.Utils
 import Data.Map (Map)
 import qualified Data.Map as Map
 
+import Data.Set (Set)
+import qualified Data.Set as Set
+
 import Data.Default
 import Data.Maybe
 import Data.Ratio
@@ -72,6 +75,19 @@ amputate zone = Effect (CI.mk $ review hitzone zone ++ " ist verloren") . runMay
     sHitzones %= Map.delete zone
     sMaxVitality %= view (mapping . scaled $ 1 - zoneProp)
 
+damageMods :: Set Modifier
+damageMods = [ Modifier "Schmerz" $ damageMod sTotalDamage sPainTolerance
+             , Modifier "Erschöpfung" $ damageMod sFatigue sFatigueTolerance
+             ]
+  where
+    damageMod :: Traversal' Stats Int -> Traversal' Stats (Formula Stats) -> Test -> FormulaM Stats Test
+    damageMod lDmg lTolerance test = fmap (fromMaybe test) . runMaybeT $ do
+      dmg <- MaybeT (preview $ ctx . lDmg)
+      tolerance <- lift =<< MaybeT (preview $ ctx . lTolerance)
+      guard $ dmg > tolerance
+      let mod = dmg - tolerance
+      return $ test & over tMod (+ mod)
+
 human = Humanoid
         { _sAStrength = vStrength
         , _sAEndurance = vEndurance
@@ -192,7 +208,7 @@ human = Humanoid
                                                    ])
 
         , _sExtraSkills = []
-        , _sModifiers = []
+        , _sModifiers = damageMods
         }
   where
     arm zone = def